/[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.4 by jmc, Mon May 16 15:07:45 2005 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    
 C--   Calculate pointers for diagnostics set to non-zero frequency  
42    
43        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
44    
45    C--   Initialize pointer arrays to zero:
46          DO n=1,ndiagMax
47            idiag(n) = 0
48          ENDDO
49    
50    C--   Calculate pointers for diagnostics set to non-zero frequency
51    
52        ndiagcount = 0        ndiagcount = 0
53        nActiveMax = 0        nActiveMax = 0
54        DO n=1,nlists        DO n=1,nlists
# Line 77  C        Search all possible model diagn Line 84  C        Search all possible model diagn
84    
85        IF (  ndiagcount.LE.numdiags .AND.        IF (  ndiagcount.LE.numdiags .AND.
86       &      nActiveMax.LE.numperlist ) THEN       &      nActiveMax.LE.numperlist ) THEN
         WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_POINTERS: done'  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT , myThid)  
87          WRITE(msgBuf,'(A,I6,A)')          WRITE(msgBuf,'(A,I6,A)')
88       &    '  space allocated for all diagnostics:',       &    '  space allocated for all diagnostics:',
89       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
90          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
91       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
         WRITE(msgBuf,'(2A)')  
      &   '------------------------------------------------------------'  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT , myThid)  
92        ELSE        ELSE
93         IF ( ndiagcount.GT.numdiags ) THEN         IF ( ndiagcount.GT.numdiags ) THEN
94           WRITE(msgBuf,'(2A)')           WRITE(msgBuf,'(2A)')
# Line 113  C        Search all possible model diagn Line 113  C        Search all possible model diagn
113         STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'         STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
114        ENDIF        ENDIF
115    
116    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
117    C--   Set list of levels to write (if not specified in data.diagnostics)
118    
119          DO n=1,nlists
120            IF ( nlevels(n).EQ.-1 ) THEN
121    C-      set Nb of levels to the minimum size of all diag of this list:
122              kLev = numLevels
123              DO m=1,nfields(n)
124                mm = jdiag(m,n)
125                kLev = MIN(kdiag(mm),kLev)
126              ENDDO
127              IF ( kLev.LE.0 ) THEN
128                WRITE(msgBuf,'(2A,I4,2A)')
129         &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in ',
130         &      ' setting levs of list n=',n,', fnames: ', fnames(n)
131                CALL PRINT_ERROR( msgBuf , myThid )
132                STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
133              ENDIF
134              nlevels(n) = kLev
135              DO k=1,kLev
136               levs(k,n) = k
137              ENDDO
138              WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
139         &      'Set levels for Outp.Stream: ',fnames(n)
140              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
141         &                        SQUEEZE_RIGHT, myThid)
142              DO l=1,nlevels(n),20
143                m = MIN(nlevels(n),l+19)
144                WRITE(msgBuf,'(A,20F5.0)')' Levels:    ',(levs(k,n),k=l,m)
145                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
146         &                          SQUEEZE_RIGHT, myThid)
147              ENDDO
148            ELSE
149    C-      Check for levels out of range ( > kdiag)
150              kLev = 0
151              DO k=1,nlevels(n)
152                kLev = MAX(NINT(levs(k,n)),kLev)
153              ENDDO
154              DO m=1,nfields(n)
155                mm = jdiag(m,n)
156                IF ( kLev.GT.kdiag(mm) ) THEN
157    C- Note: diagnostics_out take care (in some way) of this case
158    C        so that it does not cause "index out-off bounds" error.
159    C        However, the output file looks strange.
160    C- For now, choose to stop, but could change it to just a warning
161                 WRITE(msgBuf,'(A,I3,A,I3,2A)')
162         &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
163         &         ' in list n=', n, ', filename: ', fnames(n)
164                 CALL PRINT_ERROR( msgBuf , myThid )
165                 WRITE(msgBuf,'(2A,I3,A,I3,2A)')
166         &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
167         &       '(=',kdiag(mm),') for Diag. #', mm, ' : ',cdiag(mm)
168                 CALL PRINT_ERROR( msgBuf , myThid )
169                 WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_SET_POINTERS: ',
170         &       ' parsing code >>',gdiag(mm),'<<'
171                 CALL PRINT_ERROR( msgBuf , myThid )
172                 STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
173                ENDIF
174              ENDDO
175            ENDIF
176          ENDDO
177    
178            WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_POINTERS: done'
179            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
180         &                      SQUEEZE_RIGHT , myThid)
181            WRITE(msgBuf,'(2A)')
182         &   '------------------------------------------------------------'
183            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
184         &                      SQUEEZE_RIGHT , myThid)
185    
186        _END_MASTER( myThid )        _END_MASTER( myThid )
187    
188        RETURN        RETURN
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22