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

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

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

revision 1.2 by jmc, Wed Dec 15 00:18:39 2004 UTC revision 1.3 by jmc, Mon Dec 20 01:52:58 2004 UTC
# Line 35  C     == Local variables == Line 35  C     == Local variables ==
35        INTEGER ndiagcount        INTEGER ndiagcount
36        INTEGER m,mm,n        INTEGER m,mm,n
37        INTEGER mate, nActiveMax        INTEGER mate, nActiveMax
38          INTEGER l, k, kLev
39        LOGICAL found        LOGICAL found
40        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
41    
# Line 77  C        Search all possible model diagn Line 78  C        Search all possible model diagn
78    
79        IF (  ndiagcount.LE.numdiags .AND.        IF (  ndiagcount.LE.numdiags .AND.
80       &      nActiveMax.LE.numperlist ) THEN       &      nActiveMax.LE.numperlist ) THEN
         WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_POINTERS: done'  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT , myThid)  
81          WRITE(msgBuf,'(A,I6,A)')          WRITE(msgBuf,'(A,I6,A)')
82       &    '  space allocated for all diagnostics:',       &    '  space allocated for all diagnostics:',
83       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
84          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
85       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
         WRITE(msgBuf,'(2A)')  
      &   '------------------------------------------------------------'  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT , myThid)  
86        ELSE        ELSE
87         IF ( ndiagcount.GT.numdiags ) THEN         IF ( ndiagcount.GT.numdiags ) THEN
88           WRITE(msgBuf,'(2A)')           WRITE(msgBuf,'(2A)')
# Line 113  C        Search all possible model diagn Line 107  C        Search all possible model diagn
107         STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'         STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
108        ENDIF        ENDIF
109    
110    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        _END_MASTER( myThid )        _END_MASTER( myThid )
181    
182        RETURN        RETURN
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22