/[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.10 by jmc, Tue Feb 5 15:13:01 2008 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, 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 162  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 183  C-      set Nb of levels to the minimum Line 187  C-      set Nb of levels to the minimum
187              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
188       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
189            ENDDO            ENDDO
190          ELSE          ELSEIF ( fflags(ld)(2:2).NE.'P' ) THEN
191  C-      Check for levels out of range ( > kdiag)  C-      if no Vert.Interpolation, check for levels out of range ( > kdiag):
192            kLev = 0            kLev = 0
193            DO k=1,nlevels(ld)            DO k=1,nlevels(ld)
194              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 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.5  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22