/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_set_pointers.F
ViewVC logotype

Annotation of /MITgcm/pkg/diagnostics/diagnostics_set_pointers.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (hide annotations) (download)
Mon Dec 20 01:52:58 2004 UTC (19 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57d_post, checkpoint57g_post, checkpoint57b_post, checkpoint57c_pre, checkpoint57e_post, checkpoint57g_pre, checkpoint57f_pre, eckpoint57e_pre, checkpoint57f_post, checkpoint57c_post, checkpoint57h_pre, checkpoint57h_post
Changes since 1.2: +72 -8 lines 
only write "meaningfull" levels when this entry is omitted in data.diagnostics
1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_set_pointers.F,v 1.2 2004/12/15 00:18:39 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: DIAGNOSTICS_SET_POINTERS
8     C !INTERFACE:
9     SUBROUTINE DIAGNOSTICS_SET_POINTERS( myThid )
10    
11     C !DESCRIPTION: \bv
12     C *==================================================================
13     C | S/R DIAGNOSTICS_SET_POINTERS
14     C | o set pointers for active diagnostics
15     C *==================================================================
16     C \ev
17    
18     C !USES:
19     IMPLICIT NONE
20    
21     C == Global variables ===
22     #include "EEPARAMS.h"
23     #include "SIZE.h"
24     #include "DIAGNOSTICS_SIZE.h"
25     #include "DIAGNOSTICS.h"
26    
27     C !INPUT/OUTPUT PARAMETERS:
28     C == Routine arguments ==
29     C myThid - Thread number for this instance of the routine.
30     INTEGER myThid
31     CEOP
32    
33     C !LOCAL VARIABLES:
34     C == Local variables ==
35     INTEGER ndiagcount
36     INTEGER m,mm,n
37     INTEGER mate, nActiveMax
38 jmc 1.3 INTEGER l, k, kLev
39 jmc 1.1 LOGICAL found
40     CHARACTER*(MAX_LEN_MBUF) msgBuf
41    
42     C-- Calculate pointers for diagnostics set to non-zero frequency
43    
44     _BEGIN_MASTER( myThid)
45    
46     ndiagcount = 0
47     nActiveMax = 0
48     DO n=1,nlists
49     nActive(n) = nfields(n)
50     DO m=1,nfields(n)
51    
52     found = .FALSE.
53     C Search all possible model diagnostics
54     DO mm=1,ndiagt
55     IF ( flds(m,n).EQ.cdiag(mm) ) THEN
56     CALL DIAGNOSTICS_SETDIAG (mate,ndiagcount,mm,myThid)
57     found = .TRUE.
58     jdiag(m,n) = mm
59     ENDIF
60     ENDDO
61     IF ( .NOT.found ) THEN
62     WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
63     & flds(m,n),' is not a Diagnostic'
64     CALL PRINT_ERROR( msgBuf , myThid )
65     STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
66     ENDIF
67     IF ( found .AND. mate.GE.1 ) THEN
68     nActive(n) = nActive(n) + 1
69     IF ( nActive(n).LE.numperlist ) THEN
70     jdiag(nActive(n),n) = mate
71     flds( nActive(n),n) = cdiag(mate)
72     ENDIF
73     ENDIF
74    
75     ENDDO
76     nActiveMax = MAX(nActive(n),nActiveMax)
77     ENDDO
78    
79     IF ( ndiagcount.LE.numdiags .AND.
80     & nActiveMax.LE.numperlist ) THEN
81 jmc 1.2 WRITE(msgBuf,'(A,I6,A)')
82     & ' space allocated for all diagnostics:',
83 jmc 1.1 & ndiagcount, ' levels'
84     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
85 jmc 1.2 & SQUEEZE_RIGHT , myThid)
86 jmc 1.1 ELSE
87     IF ( ndiagcount.GT.numdiags ) THEN
88     WRITE(msgBuf,'(2A)')
89     & 'DIAGNOSTICS_SET_POINTERS: Not enough space',
90     & ' for all active diagnostics (from data.diagnostics)'
91     CALL PRINT_ERROR( msgBuf , myThid )
92     WRITE(msgBuf,'(A,I6,A,I6)')
93     & 'DIAGNOSTICS_SET_POINTERS: numdiags=', numdiags,
94     & ' but needs at least', ndiagcount
95     CALL PRINT_ERROR( msgBuf , myThid )
96     ENDIF
97     IF ( nActiveMax.GT.numperlist ) THEN
98     WRITE(msgBuf,'(2A)')
99     & 'DIAGNOSTICS_SET_POINTERS: Not enough space',
100     & ' for all active diagnostics (from data.diagnostics)'
101     CALL PRINT_ERROR( msgBuf , myThid )
102     WRITE(msgBuf,'(A,I6,A,I6)')
103     & 'DIAGNOSTICS_SET_POINTERS: numperlist=', numperlist,
104     & ' but needs at least', nActiveMax
105     CALL PRINT_ERROR( msgBuf , myThid )
106     ENDIF
107     STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
108     ENDIF
109    
110 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111     C-- Set list of levels to write (if not specified in data.diagnostics)
112    
113     DO n=1,nlists
114     IF ( nlevels(n).EQ.-1 ) THEN
115     C- set Nb of levels to the minimum size of all diag of this list:
116     kLev = numLevels
117     DO m=1,nfields(n)
118     mm = jdiag(m,n)
119     kLev = MIN(kdiag(mm),kLev)
120     ENDDO
121     IF ( kLev.LE.0 ) THEN
122     WRITE(msgBuf,'(2A,I4,2A)')
123     & 'DIAGNOSTICS_SET_POINTERS: kLev < 1 in ',
124     & ' setting levs of list n=',n,', fnames: ', fnames(n)
125     CALL PRINT_ERROR( msgBuf , myThid )
126     STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
127     ENDIF
128     nlevels(n) = kLev
129     DO k=1,kLev
130     levs(k,n) = k
131     ENDDO
132     WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
133     & 'Set levels for Outp.Stream: ',fnames(n)
134     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
135     & SQUEEZE_RIGHT, myThid)
136     DO l=1,nlevels(n),20
137     m = MIN(nlevels(n),l+19)
138     WRITE(msgBuf,'(A,20F5.0)')' Levels: ',(levs(k,n),k=l,m)
139     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
140     & SQUEEZE_RIGHT, myThid)
141     ENDDO
142     ELSE
143     C- Check for levels out of range ( > kdiag)
144     kLev = 0
145     DO k=1,nlevels(n)
146     kLev = MAX(NINT(levs(k,n)),kLev)
147     ENDDO
148     DO m=1,nfields(n)
149     mm = jdiag(m,n)
150     IF ( kLev.GT.kdiag(mm) ) THEN
151     C- Note: diagnostics_out take care (in some way) of this case
152     C so that it does not cause "index out-off bounds" error.
153     C However, the output file looks strange.
154     C- For now, choose to stop, but could change it to just a warning
155     WRITE(msgBuf,'(A,I3,A,I3,2A)')
156     & 'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
157     & ' in list n=', n, ', filename: ', fnames(n)
158     CALL PRINT_ERROR( msgBuf , myThid )
159     WRITE(msgBuf,'(2A,I3,A,I3,2A)')
160     & 'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
161     & '(=',kdiag(mm),') for Diag. #', mm, ' : ',cdiag(mm)
162     CALL PRINT_ERROR( msgBuf , myThid )
163     WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_SET_POINTERS: ',
164     & ' parsing code >>',gdiag(mm),'<<'
165     CALL PRINT_ERROR( msgBuf , myThid )
166     STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
167     ENDIF
168     ENDDO
169     ENDIF
170     ENDDO
171    
172     WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_POINTERS: done'
173     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
174     & SQUEEZE_RIGHT , myThid)
175     WRITE(msgBuf,'(2A)')
176     & '------------------------------------------------------------'
177     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
178     & SQUEEZE_RIGHT , myThid)
179    
180 jmc 1.1 _END_MASTER( myThid )
181    
182     RETURN
183     END
  ViewVC Help
Powered by ViewVC 1.1.22