/[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.2 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.9 by jmc, Fri Jul 1 18:26:54 2011 UTC
# Line 46  CEOP Line 46  CEOP
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER stdUnit, errUnit        INTEGER stdUnit, errUnit
49        INTEGER k, l        INTEGER nn, k, l
50        LOGICAL flag        LOGICAL diagIsPP, flagD, flagP, flagM
51    
52        CHARACTER*8 parms1        CHARACTER*10 gcode
53        CHARACTER*3 mate_index        CHARACTER*12 tmpMsg
54        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
55    
   
56  C **********************************************************************  C **********************************************************************
57  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****  C ****                SET POINTERS FOR DIAGNOSTIC ndId              ****
58  C **********************************************************************  C **********************************************************************
59    
       parms1  = gdiag(ndId)(1:8)  
60        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
61        errUnit = errorMessageUnit        errUnit = errorMessageUnit
62    
63  C--   Seach for the same diag (with same freq) to see if already set  C-    Case of Post-Procesed diag, not filled up but computed from other diags:
64        flag = .TRUE.        diagIsPP = gdiag(ndId)(5:5).EQ.'P'
65        DO l=1,listId  
66         IF (flag .AND. freq(l) .EQ. freq(listId)  C---  Seach for the same diag (with same freq) to see if already set
67       &          .AND. phase(l).EQ.phase(listId) ) THEN  C     do it recursively on Post-Processed diag dependance (=mate)
68          DO k=1,MIN(nActive(l),numperlist)  C     until we find either one already set or a non Post-Processed diag
69           IF (flag .AND. jdiag(k,l).GT.0) THEN        flagD = .TRUE.
70            IF ( cdiag(ndId).EQ.cdiag(jdiag(k,l)) ) THEN        flagP = .TRUE.
71          nn = ndId
72          DO WHILE ( flagP )
73            DO l=1,listId
74             IF (flagD .AND. freq(l) .EQ. freq(listId)
75         &             .AND. phase(l).EQ.phase(listId)
76         &             .AND. averageFreq(l) .EQ.averageFreq(listId)
77         &             .AND. averagePhase(l).EQ.averagePhase(listId)
78         &             .AND. averageCycle(l).EQ.averageCycle(listId) ) THEN
79              DO k=1,MIN(nActive(l),numperList)
80               IF (flagD .AND. jdiag(k,l).GT.0) THEN
81                IF ( cdiag(nn).EQ.cdiag(jdiag(k,l)) ) THEN
82  C-    diagnostics already set ; use the same slot:  C-    diagnostics already set ; use the same slot:
83             flag = .FALSE.               flagD = .FALSE.
84             idiag(mId,listId) = -ABS(idiag(k,l))               idiag(mId,listId) = -ABS(idiag(k,l))
85             mdiag(mId,listId) = mdiag(k,l)               mdiag(mId,listId) = mdiag(k,l)
86            ENDIF              ENDIF
87               ENDIF
88              ENDDO
89           ENDIF           ENDIF
90          ENDDO          ENDDO
91         ENDIF          flagP = flagD .AND. gdiag(nn)(5:5).EQ.'P'
92            IF ( flagP ) nn = hdiag(nn)
93        ENDDO        ENDDO
94    
95  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---  Set pointer if not already set, otherwise just print a message
96    
97        IF ( flag ) THEN        IF ( diagIsPP ) THEN
98          IF (ndiagmx+kdiag(ndId).GT.numdiags) THEN          WRITE(msgBuf,'(2(A,I6,1X,A))')
99           WRITE(msgBuf,'(A,I4,1X,A)')       &    'SETDIAG: Diag #', ndId, cdiag(ndId),
100       &    'SETDIAG: Not enough space for Diagnostic #',ndId,cdiag(ndId)       &    ' processed from Diag #',nn,cdiag(nn)
101            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
102          ENDIF
103          gcode   = gdiag(nn)(1:10)
104          IF ( flagD ) THEN
105            IF ( diagIsPP ) THEN
106    C-      Add this diag with negative idiag pointer (since those 2 diags
107    C        share the same pointer and "nn" will get the positive pointer).
108              idiag(mId,listId) = -(ndiagmx+1)
109    C-      Also add "nn" to the Active list
110              k = nActive(listId) + 1
111              IF ( k.LE.numperList ) THEN
112                jdiag(k,listId) = nn
113                idiag(k,listId) = ndiagmx + 1
114                flds (k,listId) = cdiag(nn)
115              ENDIF
116              nActive(listId) = k
117            ELSE
118              idiag(mId,listId) = ndiagmx + 1
119            ENDIF
120            ndiagmx = ndiagmx + kdiag(nn)*averageCycle(listId)
121            IF ( ndiagmx.GT.numDiags ) THEN
122             WRITE(msgBuf,'(A,I6,1X,A)')
123         &    'SETDIAG: Not enough space for Diagnostic #',nn,cdiag(nn)
124           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
125          ELSE          ELSE
126           WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',           WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',
127       &    kdiag(ndId), ' Levels for Diagnostic #', ndId, cdiag(ndId)       &                   kdiag(nn), ' x', averageCycle(listId),
128         &                ' Levels for Diagnostic #', nn, cdiag(nn)
129           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
130          ENDIF          ENDIF
         idiag(mId,listId) = ndiagmx + 1  
         ndiagmx = ndiagmx + kdiag(ndId)  
131        ELSE        ELSE
132          WRITE(msgBuf,'(A,I4,1X,2A)')          tmpMsg = ' Diagnostic '
133       &    '- WARNING - SETDIAG: Diagnostic #', ndId, cdiag(ndId),          WRITE(msgBuf,'(3A,I6,1X,2A)') '- NOTE - SETDIAG: ',tmpMsg,
134       &    ' has already been set'       &           ' #', nn, cdiag(nn), ' is already set'
135          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
         RETURN  
136        ENDIF        ENDIF
137    
138  c Check for Counter Diagnostic  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
139  c ----------------------------  
140    C---  Check for Counter Diagnostic
141        mate = 0        mate = 0
       IF ( parms1(5:5).EQ.'C') THEN  
         mate_index = parms1(6:8)  
         READ (mate_index,'(I3)') mate  
142    
143    C-    if Post-Processed diag, activate 2nd components of vector field
144          tmpMsg = ' Vector-mate'
145          IF ( diagIsPP .AND. gcode(5:5).NE.'P' .AND.
146         &    (gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V') ) mate = hdiag(nn)
147    C-    activate mate if this is a Counter Diagnostic
148          IF ( gcode(5:5).EQ.'C') THEN
149            mate = hdiag(nn)
150            tmpMsg = 'Counter-mate'
151          ENDIF
152    
153          IF ( mate.GT.0 ) THEN
154  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
155          flag = .TRUE.          flagM = .TRUE.
156          DO l=1,listId          DO l=1,listId
157           IF (flag .AND. freq(l).EQ.freq(listId)           IF (flagM .AND. freq(l) .EQ.freq(listId)
158       &            .AND. phase(l).EQ.phase(listId) ) THEN       &             .AND. phase(l).EQ.phase(listId)
159            DO k=1,MIN(nActive(l),numperlist)       &             .AND. averageFreq(l) .EQ.averageFreq(listId)
160             IF (flag .AND. jdiag(k,l).GT.0) THEN       &             .AND. averagePhase(l).EQ.averagePhase(listId)
161         &             .AND. averageCycle(l).EQ.averageCycle(listId) ) THEN
162              DO k=1,MIN(nActive(l),numperList)
163               IF (flagM .AND. jdiag(k,l).GT.0) THEN
164              IF (cdiag(mate).EQ.cdiag(jdiag(k,l)) ) THEN              IF (cdiag(mate).EQ.cdiag(jdiag(k,l)) ) THEN
165  C-    diagnostics already set ; use the same slot:  C-    diagnostics already set ; use the same slot:
166               flag = .FALSE.               flagM = .FALSE.
167               mdiag(mId,listId) = ABS(idiag(k,l))               mdiag(mId,listId) = ABS(idiag(k,l))
168              ENDIF              ENDIF
169             ENDIF             ENDIF
# Line 126  C-    diagnostics already set ; use the Line 171  C-    diagnostics already set ; use the
171           ENDIF           ENDIF
172          ENDDO          ENDDO
173    
174          IF ( flag ) THEN  C---  Set pointer if not already set, otherwise just print a message
175            IF (ndiagmx+kdiag(mate).GT.numdiags) THEN          IF ( flagM ) THEN
176             WRITE(msgBuf,'(A,I4,1X,A)')            mdiag(mId,listId) = ndiagmx + 1
177       &      'SETDIAG: Not enough space for Counter Diagnostic #',            k = nActive(listId) + 1
178              IF ( k.LE.numperList ) THEN
179    C-      Also add mate to the Active list
180                jdiag(k,listId) = mate
181                idiag(k,listId) = ndiagmx + 1
182                flds (k,listId) = cdiag(mate)
183              ENDIF
184              nActive(listId) = k
185              ndiagmx = ndiagmx + kdiag(mate)*averageCycle(listId)
186              IF ( ndiagmx.GT.numDiags ) THEN
187               WRITE(msgBuf,'(3A,I6,1X,A)')
188         &      'SETDIAG: Not enough space for ',tmpMsg,' #',
189       &      mate, cdiag(mate)       &      mate, cdiag(mate)
190             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
191            ELSE            ELSE
192             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',
193       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &                     kdiag(mate), ' x', averageCycle(listId),
194         &                  ' Levels for Mate Diag. #', mate, cdiag(mate)
195             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
196            ENDIF            ENDIF
           mdiag(mId,listId) = ndiagmx + 1  
           ndiagmx = ndiagmx + kdiag(mate)  
197          ELSE          ELSE
198            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(3A,I6,1X,2A)') '- NOTE - SETDIAG: ',tmpMsg,
199       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    ' #', mate, cdiag(mate), ' is already set'
      &    ' has already been set'  
200            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
           mate = 0  
201          ENDIF          ENDIF
202        ENDIF        ENDIF
203    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22