/[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.4 by jmc, Wed Jun 15 13:44:42 2011 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),       &    '- NOTE - 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, stdUnit, SQUEEZE_RIGHT, myThid)
         mate = 0  
         RETURN  
101        ENDIF        ENDIF
102    
103  c Check for Counter Diagnostic  C---  Check for Counter Diagnostic
104  c ----------------------------  
105        mate = 0        mate = 0
106        IF ( parms1(5:5).EQ.'C') THEN        IF ( gcode(5:5).EQ.'C') THEN
107          mate_index = parms1(6:8)          mate = hdiag(ndId)
         READ (mate_index,'(I3)') mate  
108    
109  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
110          flag = .TRUE.          flag = .TRUE.
# Line 129  C-    diagnostics already set ; use the Line 125  C-    diagnostics already set ; use the
125    
126          IF ( flag ) THEN          IF ( flag ) THEN
127            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
128             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I6,1X,A)')
129       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
130       &      mate, cdiag(mate)       &      mate, cdiag(mate)
131             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
132            ELSE            ELSE
133             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
134       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
135             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
136            ENDIF            ENDIF
137            mSdiag(mId,listId) = ndiagmx + 1            mSdiag(mId,listId) = ndiagmx + 1
138            ndiagmx = ndiagmx + kdiag(mate)            ndiagmx = ndiagmx + kdiag(mate)
139          ELSE          ELSE
140            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I6,1X,2A)')
141       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
142       &    ' has already been set'       &    ' has already been set'
143            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.4
  ViewVC Help
Powered by ViewVC 1.1.22