/[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.5 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.12 by jmc, Mon Jun 8 14:40:47 2009 UTC
# Line 32  CEOP Line 32  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
       CHARACTER*3 mate_index  
   
41    
42        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
43    
# Line 52  C--   Initialize pointer arrays to zero: Line 50  C--   Initialize pointer arrays to zero:
50         ENDDO         ENDDO
51        ENDDO        ENDDO
52    
53  C--   Calculate pointers for diagnostics set to non-zero frequency  C--   Calculate pointers for diagnostics in active output-stream
54    C                                   (i.e., with defined filename)
55    
56        ndiagcount = 0        ndiagcount = 0
57        nActiveMax = 0        nActiveMax = 0
# Line 70  C        Search all possible model diagn Line 69  C        Search all possible model diagn
69            ENDIF            ENDIF
70           ENDDO           ENDDO
71           IF ( .NOT.found ) THEN           IF ( .NOT.found ) THEN
72             WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',             CALL DIAGNOSTICS_LIST_CHECK(
73         O                      ndCount,
74         I                      ld, md, nlists, nfields, flds, myThid )
75               IF ( ndCount.EQ.0 ) THEN
76                 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
77       &                      flds(md,ld),' is not a Diagnostic'       &                      flds(md,ld),' is not a Diagnostic'
78             CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
79               ENDIF
80             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
81           ENDIF           ENDIF
82           IF ( found .AND. mate.GE.1 ) THEN           IF ( found .AND. mate.GE.1 ) THEN
# Line 89  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 128  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 140  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 156  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 183  C-      set Nb of levels to the minimum Line 196  C-      set Nb of levels to the minimum
196              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
197       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
198            ENDDO            ENDDO
199          ELSE          ELSEIF ( fflags(ld)(2:2).NE.'P' ) THEN
200  C-      Check for levels out of range ( > kdiag)  C-      if no Vert.Interpolation, check for levels out of range ( > kdiag):
201            kLev = 0            kLev = 0
202            DO k=1,nlevels(ld)            DO k=1,nlevels(ld)
203              kLev = MAX(NINT(levs(k,ld)),kLev)              kLev = MAX(NINT(levs(k,ld)),kLev)
# Line 196  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.5  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22