/[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.6 by jmc, Mon Jun 5 18:05:48 2006 UTC revision 1.13 by jmc, Mon Jan 11 19:44:07 2010 UTC
# Line 26  C     == Global variables === Line 26  C     == Global variables ===
26    
27  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
28  C     == Routine arguments ==  C     == Routine arguments ==
29  C     myThid - Thread number for this instance of the routine.  C     myThid :: my Thread Id. number
30        INTEGER myThid        INTEGER myThid
31  CEOP  CEOP
32    
33  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
34  C     == Local variables ==  C     == Local variables ==
35        INTEGER ndiagcount        INTEGER ndiagcount, ndCount
36        INTEGER md,ld,nd        INTEGER md,ld,nd
37        INTEGER mate, nActiveMax        INTEGER mate, nActiveMax
38        INTEGER i, j, k, k1, k2, mm, kLev        INTEGER i, j, k, k1, k2, mm, kLev
39        LOGICAL found        LOGICAL found
40        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
41        CHARACTER*3 mate_index        CHARACTER*12 suffix
   
42    
43        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
44    
# Line 71  C        Search all possible model diagn Line 70  C        Search all possible model diagn
70            ENDIF            ENDIF
71           ENDDO           ENDDO
72           IF ( .NOT.found ) THEN           IF ( .NOT.found ) THEN
73             WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',             CALL DIAGNOSTICS_LIST_CHECK(
74         O                      ndCount,
75         I                      ld, md, nlists, nfields, flds, myThid )
76               IF ( ndCount.EQ.0 ) THEN
77                 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
78       &                      flds(md,ld),' is not a Diagnostic'       &                      flds(md,ld),' is not a Diagnostic'
79             CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
80               ENDIF
81             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
82           ENDIF           ENDIF
83           IF ( found .AND. mate.GE.1 ) THEN           IF ( found .AND. mate.GE.1 ) THEN
# Line 90  C        Search all possible model diagn Line 94  C        Search all possible model diagn
94         nActiveMax = MAX(nActive(ld),nActiveMax)         nActiveMax = MAX(nActive(ld),nActiveMax)
95        ENDDO        ENDDO
96    
97        IF (  ndiagcount.LE.numdiags .AND.        IF (  ndiagcount.LE.numDiags .AND.
98       &      nActiveMax.LE.numperlist ) THEN       &      nActiveMax.LE.numperlist ) THEN
99          WRITE(msgBuf,'(A,I6,A)')          WRITE(msgBuf,'(A,I8,A)')
100       &    '  space allocated for all diagnostics:',       &    '  space allocated for all diagnostics:',
101       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
102          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
103       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
104        ELSE        ELSE
105         IF ( ndiagcount.GT.numdiags ) THEN         IF ( ndiagcount.GT.numDiags ) THEN
106           WRITE(msgBuf,'(2A)')           WRITE(msgBuf,'(2A)')
107       &    'DIAGNOSTICS_SET_POINTERS: Not enough space',       &    'DIAGNOSTICS_SET_POINTERS: Not enough space',
108       &    ' for all active diagnostics (from data.diagnostics)'       &    ' for all active diagnostics (from data.diagnostics)'
109           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
110           WRITE(msgBuf,'(A,I6,A,I6)')           WRITE(msgBuf,'(A,I8,A,I8)')
111       &    'DIAGNOSTICS_SET_POINTERS: numdiags=', numdiags,       &    'DIAGNOSTICS_SET_POINTERS: numDiags=', numDiags,
112       &    ' but needs at least', ndiagcount       &    ' but needs at least', ndiagcount
113           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
114         ENDIF         ENDIF
# Line 129  C     and if it exists. Note: for now, o Line 133  C     and if it exists. Note: for now, o
133          IF (mdiag(md,ld).EQ.0 ) THEN          IF (mdiag(md,ld).EQ.0 ) THEN
134    
135           nd = jdiag(md,ld)           nd = jdiag(md,ld)
136           mate_index = gdiag(nd)(6:8)           mate = hdiag(nd)
137           IF ( mate_index.NE.'   ' ) THEN           IF ( mate.GT.0 ) THEN
           READ(mate_index,'(I3)') mate  
138            DO j=1,nlists            DO j=1,nlists
139             DO i=1,nActive(j)             DO i=1,nActive(j)
140              IF ( mdiag(md,ld).EQ.0 .AND. jdiag(i,j).EQ.mate ) THEN              IF ( mdiag(md,ld).EQ.0 .AND. jdiag(i,j).EQ.mate ) THEN
# Line 141  C     and if it exists. Note: for now, o Line 144  C     and if it exists. Note: for now, o
144            ENDDO            ENDDO
145           ENDIF           ENDIF
146           IF ( mdiag(md,ld).NE.0 ) THEN           IF ( mdiag(md,ld).NE.0 ) THEN
147            WRITE(msgBuf,'(A,I4,4A)') '  set mate pointer for diag #',            WRITE(msgBuf,'(A,I6,5A,I6)') '  set mate pointer for diag #',
148       &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)       &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)(1:10),
149         &             ' , mate:', hdiag(nd)
150            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
151       &                        SQUEEZE_RIGHT , myThid)       &                        SQUEEZE_RIGHT , myThid)
152           ENDIF           ENDIF
# Line 157  C--   Set list of levels to write (if no Line 161  C--   Set list of levels to write (if no
161        DO ld=1,nlists        DO ld=1,nlists
162          IF ( nlevels(ld).EQ.-1 ) THEN          IF ( nlevels(ld).EQ.-1 ) THEN
163  C-      set Nb of levels to the minimum size of all diag of this list:  C-      set Nb of levels to the minimum size of all diag of this list:
164            kLev = numLevels            kLev = numLevels*10
165            DO md=1,nfields(ld)            DO md=1,nfields(ld)
166              nd = jdiag(md,ld)              nd = jdiag(md,ld)
167              kLev = MIN(kdiag(nd),kLev)              kLev = MIN(kdiag(nd),kLev)
168            ENDDO            ENDDO
169            IF ( kLev.LE.0 ) THEN            IF ( kLev.LE.0 ) THEN
170              WRITE(msgBuf,'(2A,I4,2A)')              WRITE(msgBuf,'(2A,I4,2A)')
171       &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in ',       &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in',
172       &      ' setting levs of list l=',ld,', fnames: ', fnames(ld)       &      ' setting levs of list l=',ld,', fnames=', fnames(ld)
173                CALL PRINT_ERROR( msgBuf , myThid )
174                STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
175              ELSEIF ( kLev.GT.numLevels ) THEN
176                WRITE(msgBuf,'(A,2(I6,A))')
177         &      'DIAGNOSTICS_SET_POINTERS: kLev=', kLev,
178         &                  ' >', numLevels, ' =numLevels'
179                CALL PRINT_ERROR( msgBuf , myThid )
180                WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_SET_POINTERS: in',
181         &      ' setting levs of list l=',ld,', fnames=', fnames(ld)
182              CALL PRINT_ERROR( msgBuf , myThid )              CALL PRINT_ERROR( msgBuf , myThid )
183              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
184            ENDIF            ENDIF
# Line 177  C-      set Nb of levels to the minimum Line 190  C-      set Nb of levels to the minimum
190       &      'Set levels for Outp.Stream: ',fnames(ld)       &      'Set levels for Outp.Stream: ',fnames(ld)
191            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
192       &                        SQUEEZE_RIGHT, myThid)       &                        SQUEEZE_RIGHT, myThid)
193              suffix = ' Levels:    '
194              IF ( fflags(ld)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
195            DO k1=1,nlevels(ld),20            DO k1=1,nlevels(ld),20
196              k2 = MIN(nlevels(ld),k1+19)              k2 = MIN(nlevels(ld),k1+19)
197              WRITE(msgBuf,'(A,20F5.0)')              WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,ld),k=k1,k2)
      &         ' Levels:    ', (levs(k,ld),k=k1,k2)  
198              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
199       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
200            ENDDO            ENDDO
201          ELSE          ELSEIF ( fflags(ld)(2:2).NE.'P' ) THEN
202  C-      Check for levels out of range ( > kdiag)  C-      if no Vert.Interpolation, check for levels out of range ( > kdiag):
203            kLev = 0            kLev = 0
204            DO k=1,nlevels(ld)            DO k=1,nlevels(ld)
205              kLev = MAX(NINT(levs(k,ld)),kLev)              kLev = MAX(NINT(levs(k,ld)),kLev)
# Line 197  C- Note: diagnostics_out take care (in s Line 211  C- Note: diagnostics_out take care (in s
211  C        so that it does not cause "index out-off bounds" error.  C        so that it does not cause "index out-off bounds" error.
212  C        However, the output file looks strange.  C        However, the output file looks strange.
213  C- For now, choose to stop, but could change it to just a warning  C- For now, choose to stop, but could change it to just a warning
214               WRITE(msgBuf,'(A,I3,A,I3,2A)')               WRITE(msgBuf,'(A,I4,A,I6,2A)')
215       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
216       &         ' in list l=', ld, ', filename: ', fnames(ld)       &         ' in list l=', ld, ', filename: ', fnames(ld)
217               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
218               WRITE(msgBuf,'(2A,I3,A,I3,2A)')               WRITE(msgBuf,'(2A,I4,A,I6,2A)')
219       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
220       &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)       &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)
221               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22