/[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.9 by jahn, Tue Jan 29 00:35:31 2008 UTC revision 1.10 by jmc, Tue Feb 5 15:13:01 2008 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 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.'   ' .AND. 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 168  C-      set Nb of levels to the minimum Line 166  C-      set Nb of levels to the minimum
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,I6,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 )              CALL PRINT_ERROR( msgBuf , myThid )
# Line 202  C- Note: diagnostics_out take care (in s Line 200  C- Note: diagnostics_out take care (in s
200  C        so that it does not cause "index out-off bounds" error.  C        so that it does not cause "index out-off bounds" error.
201  C        However, the output file looks strange.  C        However, the output file looks strange.
202  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
203               WRITE(msgBuf,'(A,I3,A,I3,2A)')               WRITE(msgBuf,'(A,I4,A,I6,2A)')
204       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
205       &         ' in list l=', ld, ', filename: ', fnames(ld)       &         ' in list l=', ld, ', filename: ', fnames(ld)
206               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
207               WRITE(msgBuf,'(2A,I3,A,I3,2A)')               WRITE(msgBuf,'(2A,I4,A,I6,2A)')
208       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
209       &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)       &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)
210               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22