/[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.8 by jmc, Sun Dec 24 20:20:59 2006 UTC revision 1.12 by jmc, Mon Jun 8 14:40:47 2009 UTC
# Line 38  C     == Local variables == Line 38  C     == Local variables ==
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
       CHARACTER*3 mate_index  
   
41    
42        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
43    
# Line 73  C        Search all possible model diagn Line 71  C        Search all possible model diagn
71           IF ( .NOT.found ) THEN           IF ( .NOT.found ) THEN
72             CALL DIAGNOSTICS_LIST_CHECK(             CALL DIAGNOSTICS_LIST_CHECK(
73       O                      ndCount,       O                      ndCount,
74       I                      ld, md, nfields, flds, myThid )       I                      ld, md, nlists, nfields, flds, myThid )
75             IF ( ndCount.EQ.0 ) THEN             IF ( ndCount.EQ.0 ) THEN
76               WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',               WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
77       &                      flds(md,ld),' is not a Diagnostic'       &                      flds(md,ld),' is not a Diagnostic'
# Line 95  C        Search all possible model diagn Line 93  C        Search all possible model diagn
93         nActiveMax = MAX(nActive(ld),nActiveMax)         nActiveMax = MAX(nActive(ld),nActiveMax)
94        ENDDO        ENDDO
95    
96        IF (  ndiagcount.LE.numdiags .AND.        IF (  ndiagcount.LE.numDiags .AND.
97       &      nActiveMax.LE.numperlist ) THEN       &      nActiveMax.LE.numperlist ) THEN
98          WRITE(msgBuf,'(A,I6,A)')          WRITE(msgBuf,'(A,I8,A)')
99       &    '  space allocated for all diagnostics:',       &    '  space allocated for all diagnostics:',
100       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
101          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
102       &                      SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid)
103        ELSE        ELSE
104         IF ( ndiagcount.GT.numdiags ) THEN         IF ( ndiagcount.GT.numDiags ) THEN
105           WRITE(msgBuf,'(2A)')           WRITE(msgBuf,'(2A)')
106       &    'DIAGNOSTICS_SET_POINTERS: Not enough space',       &    'DIAGNOSTICS_SET_POINTERS: Not enough space',
107       &    ' for all active diagnostics (from data.diagnostics)'       &    ' for all active diagnostics (from data.diagnostics)'
108           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
109           WRITE(msgBuf,'(A,I6,A,I6)')           WRITE(msgBuf,'(A,I8,A,I8)')
110       &    'DIAGNOSTICS_SET_POINTERS: numdiags=', numdiags,       &    'DIAGNOSTICS_SET_POINTERS: numDiags=', numDiags,
111       &    ' but needs at least', ndiagcount       &    ' but needs at least', ndiagcount
112           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
113         ENDIF         ENDIF
# Line 134  C     and if it exists. Note: for now, o Line 132  C     and if it exists. Note: for now, o
132          IF (mdiag(md,ld).EQ.0 ) THEN          IF (mdiag(md,ld).EQ.0 ) THEN
133    
134           nd = jdiag(md,ld)           nd = jdiag(md,ld)
135           mate_index = gdiag(nd)(6:8)           mate = hdiag(nd)
136           IF ( mate_index.NE.'   ' ) THEN           IF ( mate.GT.0 ) THEN
           READ(mate_index,'(I3)') mate  
137            DO j=1,nlists            DO j=1,nlists
138             DO i=1,nActive(j)             DO i=1,nActive(j)
139              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 146  C     and if it exists. Note: for now, o Line 143  C     and if it exists. Note: for now, o
143            ENDDO            ENDDO
144           ENDIF           ENDIF
145           IF ( mdiag(md,ld).NE.0 ) THEN           IF ( mdiag(md,ld).NE.0 ) THEN
146            WRITE(msgBuf,'(A,I4,4A)') '  set mate pointer for diag #',            WRITE(msgBuf,'(A,I6,5A,I6)') '  set mate pointer for diag #',
147       &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)       &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)(1:10),
148         &             ' , mate:', hdiag(nd)
149            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
150       &                        SQUEEZE_RIGHT , myThid)       &                        SQUEEZE_RIGHT , myThid)
151           ENDIF           ENDIF
# Line 162  C--   Set list of levels to write (if no Line 160  C--   Set list of levels to write (if no
160        DO ld=1,nlists        DO ld=1,nlists
161          IF ( nlevels(ld).EQ.-1 ) THEN          IF ( nlevels(ld).EQ.-1 ) THEN
162  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:
163            kLev = numLevels            kLev = numLevels*10
164            DO md=1,nfields(ld)            DO md=1,nfields(ld)
165              nd = jdiag(md,ld)              nd = jdiag(md,ld)
166              kLev = MIN(kdiag(nd),kLev)              kLev = MIN(kdiag(nd),kLev)
167            ENDDO            ENDDO
168            IF ( kLev.LE.0 ) THEN            IF ( kLev.LE.0 ) THEN
169              WRITE(msgBuf,'(2A,I4,2A)')              WRITE(msgBuf,'(2A,I4,2A)')
170       &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in ',       &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in',
171       &      ' setting levs of list l=',ld,', fnames: ', fnames(ld)       &      ' setting levs of list l=',ld,', fnames=', fnames(ld)
172                CALL PRINT_ERROR( msgBuf , myThid )
173                STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
174              ELSEIF ( kLev.GT.numLevels ) THEN
175                WRITE(msgBuf,'(A,2(I6,A))')
176         &      'DIAGNOSTICS_SET_POINTERS: kLev=', kLev,
177         &                  ' >', numLevels, ' =numLevels'
178                CALL PRINT_ERROR( msgBuf , myThid )
179                WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_SET_POINTERS: in',
180         &      ' setting levs of list l=',ld,', fnames=', fnames(ld)
181              CALL PRINT_ERROR( msgBuf , myThid )              CALL PRINT_ERROR( msgBuf , myThid )
182              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
183            ENDIF            ENDIF
# Line 202  C- Note: diagnostics_out take care (in s Line 209  C- Note: diagnostics_out take care (in s
209  C        so that it does not cause "index out-off bounds" error.  C        so that it does not cause "index out-off bounds" error.
210  C        However, the output file looks strange.  C        However, the output file looks strange.
211  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
212               WRITE(msgBuf,'(A,I3,A,I3,2A)')               WRITE(msgBuf,'(A,I4,A,I6,2A)')
213       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
214       &         ' in list l=', ld, ', filename: ', fnames(ld)       &         ' in list l=', ld, ', filename: ', fnames(ld)
215               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
216               WRITE(msgBuf,'(2A,I3,A,I3,2A)')               WRITE(msgBuf,'(2A,I4,A,I6,2A)')
217       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
218       &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)       &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)
219               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22