/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_setdiag.F
ViewVC logotype

Diff of /MITgcm/pkg/diagnostics/diagnostics_setdiag.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by jmc, Mon Jun 5 18:15:53 2006 UTC revision 1.5 by jmc, Tue Feb 5 15:13:01 2008 UTC
# Line 49  C     == Local variables == Line 49  C     == Local variables ==
49        INTEGER k, l        INTEGER k, l
50        LOGICAL flag        LOGICAL flag
51    
52        CHARACTER*8 parms1        CHARACTER*10 gcode
53        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
54    
55    
56  C **********************************************************************  C **********************************************************************
57  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****  C ****                SET POINTERS FOR DIAGNOSTIC ndId              ****
58  C **********************************************************************  C **********************************************************************
59    
60        parms1  = gdiag(ndId)(1:8)        gcode   = gdiag(ndId)(1:10)
61        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
62        errUnit = errorMessageUnit        errUnit = errorMessageUnit
63    
# Line 87  C---+----1----+----2----+----3----+----4 Line 87  C---+----1----+----2----+----3----+----4
87        IF ( flag ) THEN        IF ( flag ) THEN
88          idiag(mId,listId) = ndiagmx + 1          idiag(mId,listId) = ndiagmx + 1
89          ndiagmx = ndiagmx + kdiag(ndId)*averageCycle(listId)          ndiagmx = ndiagmx + kdiag(ndId)*averageCycle(listId)
90          IF ( ndiagmx.GT.numdiags ) THEN          IF ( ndiagmx.GT.numDiags ) THEN
91           WRITE(msgBuf,'(A,I4,1X,A)')           WRITE(msgBuf,'(A,I6,1X,A)')
92       &    'SETDIAG: Not enough space for Diagnostic #',ndId,cdiag(ndId)       &    'SETDIAG: Not enough space for Diagnostic #',ndId,cdiag(ndId)
93           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
94          ELSE          ELSE
95           WRITE(msgBuf,'(A,2(I3,A),I4,1X,A)') 'SETDIAG: Allocate',           WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',
96       &                   kdiag(ndId), ' x', averageCycle(listId),       &                   kdiag(ndId), ' x', averageCycle(listId),
97       &                ' Levels for Diagnostic #', ndId, cdiag(ndId)       &                ' Levels for Diagnostic #', ndId, cdiag(ndId)
98           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
99          ENDIF          ENDIF
100        ELSE        ELSE
101          WRITE(msgBuf,'(A,I4,1X,2A)')          WRITE(msgBuf,'(A,I6,1X,2A)')
102       &    '- WARNING - SETDIAG: Diagnostic #', ndId, cdiag(ndId),       &    '- WARNING - SETDIAG: Diagnostic #', ndId, cdiag(ndId),
103       &    ' has already been set'       &    ' has already been set'
104          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
# Line 109  C---+----1----+----2----+----3----+----4 Line 109  C---+----1----+----2----+----3----+----4
109  c Check for Counter Diagnostic  c Check for Counter Diagnostic
110  c ----------------------------  c ----------------------------
111        mate = 0        mate = 0
112        IF ( parms1(5:5).EQ.'C') THEN        IF ( gcode(5:5).EQ.'C') THEN
113          READ(parms1,'(5X,I3)') mate          mate = hdiag(ndId)
114    
115  C--     Seach for the same diag (with same freq) to see if already set  C--     Seach for the same diag (with same freq) to see if already set
116          flag = .TRUE.          flag = .TRUE.
# Line 135  C-    diagnostics already set ; use the Line 135  C-    diagnostics already set ; use the
135          IF ( flag ) THEN          IF ( flag ) THEN
136            mdiag(mId,listId) = ndiagmx + 1            mdiag(mId,listId) = ndiagmx + 1
137            ndiagmx = ndiagmx + kdiag(mate)*averageCycle(listId)            ndiagmx = ndiagmx + kdiag(mate)*averageCycle(listId)
138            IF ( ndiagmx.GT.numdiags ) THEN            IF ( ndiagmx.GT.numDiags ) THEN
139             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I6,1X,A)')
140       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
141       &      mate, cdiag(mate)       &      mate, cdiag(mate)
142             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
143            ELSE            ELSE
144             WRITE(msgBuf,'(A,2(I3,A),I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',
145       &                     kdiag(mate), ' x', averageCycle(listId),       &                     kdiag(mate), ' x', averageCycle(listId),
146       &                  ' Levels for Count.Diag #', mate, cdiag(mate)       &                  ' Levels for Count.Diag #', mate, cdiag(mate)
147             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
148            ENDIF            ENDIF
149          ELSE          ELSE
150            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I6,1X,2A)')
151       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
152       &    ' has already been set'       &    ' has already been set'
153            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22