/[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.6 by jmc, Wed Jun 15 13:44:43 2011 UTC revision 1.7 by jmc, Tue Jun 21 18:00:15 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*10 gcode        CHARACTER*10 gcode
53          CHARACTER*18 tmpMsg
54        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
55    
   
56  C **********************************************************************  C **********************************************************************
57  C ****                SET POINTERS FOR DIAGNOSTIC ndId              ****  C ****                SET POINTERS FOR DIAGNOSTIC ndId              ****
58  C **********************************************************************  C **********************************************************************
59    
       gcode   = gdiag(ndId)(1:10)  
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)  C     do it recursively on Post-Processed diag dependance (=mate)
68       &          .AND. averageFreq(l) .EQ.averageFreq(listId)  C     until we find either one already set or a non Post-Processed diag
69       &          .AND. averagePhase(l).EQ.averagePhase(listId)        flagD = .TRUE.
70       &          .AND. averageCycle(l).EQ.averageCycle(listId) ) THEN        flagP = .TRUE.
71          DO k=1,MIN(nActive(l),numperlist)        nn = ndId
72           IF (flag .AND. jdiag(k,l).GT.0) THEN        DO WHILE ( flagP )
73            IF ( cdiag(ndId).EQ.cdiag(jdiag(k,l)) ) THEN          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            WRITE(msgBuf,'(2(A,I6,1X,A))')
99         &    'SETDIAG: Diag #', ndId, cdiag(ndId),
100         &    ' 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          idiag(mId,listId) = ndiagmx + 1          idiag(mId,listId) = ndiagmx + 1
106          ndiagmx = ndiagmx + kdiag(ndId)*averageCycle(listId)          IF ( diagIsPP ) THEN
107    C-      Also add "nn" to the Active list
108              k = nActive(listId) + 1
109              IF ( k.LE.numperList ) THEN
110                jdiag(k,listId) = nn
111                idiag(k,listId) = ndiagmx + 1
112                flds (k,listId) = cdiag(nn)
113              ENDIF
114              nActive(listId) = k
115            ENDIF
116            ndiagmx = ndiagmx + kdiag(nn)*averageCycle(listId)
117          IF ( ndiagmx.GT.numDiags ) THEN          IF ( ndiagmx.GT.numDiags ) THEN
118           WRITE(msgBuf,'(A,I6,1X,A)')           WRITE(msgBuf,'(A,I6,1X,A)')
119       &    'SETDIAG: Not enough space for Diagnostic #',ndId,cdiag(ndId)       &    'SETDIAG: Not enough space for Diagnostic #',nn,cdiag(nn)
120           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
121          ELSE          ELSE
122           WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',           WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',
123       &                   kdiag(ndId), ' x', averageCycle(listId),       &                   kdiag(nn), ' x', averageCycle(listId),
124       &                ' Levels for Diagnostic #', ndId, cdiag(ndId)       &                ' Levels for Diagnostic #', nn, cdiag(nn)
125           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
126          ENDIF          ENDIF
127        ELSE        ELSE
128          WRITE(msgBuf,'(A,I6,1X,2A)')          WRITE(msgBuf,'(A,I6,1X,2A)') '- NOTE - SETDIAG: Diagnostic #',
129       &    '- NOTE - SETDIAG: Diagnostic #', ndId, cdiag(ndId),       &        nn, cdiag(nn), ' is already set'
      &    ' has already been set'  
130          CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
131        ENDIF        ENDIF
132    
133  C     Check for Counter Diagnostic  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
134    
135    C---  Check for Counter Diagnostic
136        mate = 0        mate = 0
137    
138    C-    if Post-Processed diag, activate 2nd components of vector field
139          tmpMsg = ' Vector-mate Diag.'
140          IF ( diagIsPP .AND. gcode(5:5).NE.'P' .AND.
141         &    (gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V') ) mate = hdiag(nn)
142    C-    activate mate if this is a Counter Diagnostic
143        IF ( gcode(5:5).EQ.'C') THEN        IF ( gcode(5:5).EQ.'C') THEN
144          mate = hdiag(ndId)          mate = hdiag(nn)
145            tmpMsg = 'Counter Diagnostic'
146          ENDIF
147    
148          IF ( mate.GT.0 ) THEN
149  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
150          flag = .TRUE.          flagM = .TRUE.
151          DO l=1,listId          DO l=1,listId
152           IF (flag .AND. freq(l) .EQ.freq(listId)           IF (flagM .AND. freq(l) .EQ.freq(listId)
153       &            .AND. phase(l).EQ.phase(listId)       &             .AND. phase(l).EQ.phase(listId)
154       &            .AND. averageFreq(l) .EQ.averageFreq(listId)       &             .AND. averageFreq(l) .EQ.averageFreq(listId)
155       &            .AND. averagePhase(l).EQ.averagePhase(listId)       &             .AND. averagePhase(l).EQ.averagePhase(listId)
156       &            .AND. averageCycle(l).EQ.averageCycle(listId) ) THEN       &             .AND. averageCycle(l).EQ.averageCycle(listId) ) THEN
157            DO k=1,MIN(nActive(l),numperlist)            DO k=1,MIN(nActive(l),numperList)
158             IF (flag .AND. jdiag(k,l).GT.0) THEN             IF (flagM .AND. jdiag(k,l).GT.0) THEN
159              IF (cdiag(mate).EQ.cdiag(jdiag(k,l)) ) THEN              IF (cdiag(mate).EQ.cdiag(jdiag(k,l)) ) THEN
160  C-    diagnostics already set ; use the same slot:  C-    diagnostics already set ; use the same slot:
161               flag = .FALSE.               flagM = .FALSE.
162               mdiag(mId,listId) = ABS(idiag(k,l))               mdiag(mId,listId) = ABS(idiag(k,l))
163              ENDIF              ENDIF
164             ENDIF             ENDIF
# Line 130  C-    diagnostics already set ; use the Line 166  C-    diagnostics already set ; use the
166           ENDIF           ENDIF
167          ENDDO          ENDDO
168    
169          IF ( flag ) THEN  C---  Set pointer if not already set, otherwise just print a message
170            IF ( flagM ) THEN
171            mdiag(mId,listId) = ndiagmx + 1            mdiag(mId,listId) = ndiagmx + 1
172              k = nActive(listId) + 1
173              IF ( k.LE.numperList ) THEN
174    C-      Also add mate to the Active list
175                jdiag(k,listId) = mate
176                idiag(k,listId) = ndiagmx + 1
177                flds (k,listId) = cdiag(mate)
178              ENDIF
179              nActive(listId) = k
180            ndiagmx = ndiagmx + kdiag(mate)*averageCycle(listId)            ndiagmx = ndiagmx + kdiag(mate)*averageCycle(listId)
181            IF ( ndiagmx.GT.numDiags ) THEN            IF ( ndiagmx.GT.numDiags ) THEN
182             WRITE(msgBuf,'(A,I6,1X,A)')             WRITE(msgBuf,'(3A,I6,1X,A)')
183       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for ',tmpMsg,' #',
184       &      mate, cdiag(mate)       &      mate, cdiag(mate)
185             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
186            ELSE            ELSE
187             WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,2(I3,A),I6,1X,A)') 'SETDIAG: Allocate',
188       &                     kdiag(mate), ' x', averageCycle(listId),       &                     kdiag(mate), ' x', averageCycle(listId),
189       &                  ' Levels for Count.Diag #', mate, cdiag(mate)       &                  ' Levels for Mate Diag. #', mate, cdiag(mate)
190             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
191            ENDIF            ENDIF
192          ELSE          ELSE
193            WRITE(msgBuf,'(A,I6,1X,2A)')            WRITE(msgBuf,'(3A,I6,1X,2A)') '- NOTE - SETDIAG: ',tmpMsg,
194       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    ' #', mate, cdiag(mate), ' is already set'
      &    ' has already been set'  
195            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
           mate = 0  
196          ENDIF          ENDIF
197        ENDIF        ENDIF
198    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22