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

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

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

revision 1.2 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.3 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
       CHARACTER*3 mate_index  
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:8)
61        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
62        errUnit = errorMessageUnit        errUnit = errorMessageUnit
63    
# Line 84  C---+----1----+----2----+----3----+----4 Line 83  C---+----1----+----2----+----3----+----4
83    
84        IF ( flag ) THEN        IF ( flag ) THEN
85          IF (ndiagmx+kdiag(ndId).GT.diagSt_size) THEN          IF (ndiagmx+kdiag(ndId).GT.diagSt_size) THEN
86           WRITE(msgBuf,'(A,I4,1X,A)')           WRITE(msgBuf,'(A,I6,1X,A)')
87       &    'SETDIAG: Not enough space for Stats-Diag #',ndId,cdiag(ndId)       &    'SETDIAG: Not enough space for Stats-Diag #',ndId,cdiag(ndId)
88           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
89          ELSE          ELSE
90           WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',           WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
91       &    kdiag(ndId), ' Levels for Stats-Diag #', ndId, cdiag(ndId)       &    kdiag(ndId), ' Levels for Stats-Diag #', ndId, cdiag(ndId)
92           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
93          ENDIF          ENDIF
94          iSdiag(mId,listId) = ndiagmx + 1          iSdiag(mId,listId) = ndiagmx + 1
95          ndiagmx = ndiagmx + kdiag(ndId)          ndiagmx = ndiagmx + kdiag(ndId)
96        ELSE        ELSE
97          WRITE(msgBuf,'(A,I4,1X,2A)')          WRITE(msgBuf,'(A,I6,1X,2A)')
98       &    '- WARNING - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),       &    '- WARNING - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),
99       &    ' has already been set'       &    ' has already been set'
100          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
# Line 106  C---+----1----+----2----+----3----+----4 Line 105  C---+----1----+----2----+----3----+----4
105  c Check for Counter Diagnostic  c Check for Counter Diagnostic
106  c ----------------------------  c ----------------------------
107        mate = 0        mate = 0
108        IF ( parms1(5:5).EQ.'C') THEN        IF ( gcode(5:5).EQ.'C') THEN
109          mate_index = parms1(6:8)          mate = hdiag(ndId)
         READ (mate_index,'(I3)') mate  
110    
111  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
112          flag = .TRUE.          flag = .TRUE.
# Line 129  C-    diagnostics already set ; use the Line 127  C-    diagnostics already set ; use the
127    
128          IF ( flag ) THEN          IF ( flag ) THEN
129            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
130             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I6,1X,A)')
131       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
132       &      mate, cdiag(mate)       &      mate, cdiag(mate)
133             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
134            ELSE            ELSE
135             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
136       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
137             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
138            ENDIF            ENDIF
139            mSdiag(mId,listId) = ndiagmx + 1            mSdiag(mId,listId) = ndiagmx + 1
140            ndiagmx = ndiagmx + kdiag(mate)            ndiagmx = ndiagmx + kdiag(mate)
141          ELSE          ELSE
142            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I6,1X,2A)')
143       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
144       &    ' has already been set'       &    ' has already been set'
145            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22