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

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

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

revision 1.25 by jmc, Tue Feb 5 15:31:19 2008 UTC revision 1.28 by jmc, Sun Jan 25 17:00:20 2009 UTC
# Line 7  C--   File diagnostics_utils.F: General Line 7  C--   File diagnostics_utils.F: General
7  C--    Contents:  C--    Contents:
8  C--    o GETDIAG  C--    o GETDIAG
9  C--    o DIAGNOSTICS_COUNT  C--    o DIAGNOSTICS_COUNT
10    C--    o DIAGNOSTICS_GET_POINTERS
11    C--    o DIAGS_GET_PARMS_I (Function)
12  C--    o DIAGS_MK_UNITS (Function)  C--    o DIAGS_MK_UNITS (Function)
13  C--    o DIAGS_MK_TITLE (Function)  C--    o DIAGS_MK_TITLE (Function)
 C--    o DIAGNOSTICS_GET_POINTERS  
14    
15  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
16  CBOP 0  CBOP 0
# Line 68  C-      No counter diagnostics => averag Line 69  C-      No counter diagnostics => averag
69            factor = FLOAT(ndiag(ip,bi,bj))            factor = FLOAT(ndiag(ip,bi,bj))
70            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor
71    
72    #ifdef ALLOW_FIZHI
73            DO j = 1,sNy+1            DO j = 1,sNy+1
74              DO i = 1,sNx+1              DO i = 1,sNx+1
75                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
# Line 77  C-      No counter diagnostics => averag Line 79  C-      No counter diagnostics => averag
79                ENDIF                ENDIF
80              ENDDO              ENDDO
81            ENDDO            ENDDO
82    #else /* ALLOW_FIZHI */
83              DO j = 1,sNy+1
84                DO i = 1,sNx+1
85                  qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
86                ENDDO
87              ENDDO
88    #endif /* ALLOW_FIZHI */
89    
90          ELSE          ELSE
91  C-      With counter diagnostics => average = Sum / counter:  C-      With counter diagnostics => average = Sum / counter:
# Line 141  C     !LOCAL VARIABLES: Line 150  C     !LOCAL VARIABLES:
150  C ===============  C ===============
151        INTEGER m, n        INTEGER m, n
152        INTEGER bi, bj        INTEGER bi, bj
153        INTEGER ipt        INTEGER ipt, ndId
154  c     CHARACTER*(MAX_LEN_MBUF) msgBuf  c     CHARACTER*(MAX_LEN_MBUF) msgBuf
155    
156          IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
157            bi = myBxLo(myThid)
158            bj = myByLo(myThid)
159          ELSE
160            bi = MIN(biArg,nSx)
161            bj = MIN(bjArg,nSy)
162          ENDIF
163    
164  C--   Run through list of active diagnostics to find which counter  C--   Run through list of active diagnostics to find which counter
165  C     to increment (needs to be a valid & active diagnostic-counter)  C     to increment (needs to be a valid & active diagnostic-counter)
166        DO n=1,nlists        DO n=1,nlists
167         DO m=1,nActive(n)         DO m=1,nActive(n)
168          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
169           ipt = idiag(m,n)           ipt = idiag(m,n)
170           IF (ndiag(ipt,1,1).GE.0) THEN           IF (ndiag(ipt,bi,bj).GE.0) THEN
171              ndId = jdiag(m,n)
172              ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
173  C-    Increment the counter for the diagnostic  C-    Increment the counter for the diagnostic
174            IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN            IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
175             DO bj=myByLo(myThid), myByHi(myThid)             DO bj=myByLo(myThid), myByHi(myThid)
# Line 159  C-    Increment the counter for the diag Line 178  C-    Increment the counter for the diag
178              ENDDO              ENDDO
179             ENDDO             ENDDO
180            ELSE            ELSE
              bi = MIN(biArg,nSx)  
              bj = MIN(bjArg,nSy)  
181               ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1               ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1
182            ENDIF            ENDIF
183  C-    Increment is done  C-    Increment is done
# Line 175  C-    Increment is done Line 192  C-    Increment is done
192  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
193    
194  CBOP 0  CBOP 0
195    C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
196    C     !INTERFACE:
197          SUBROUTINE DIAGNOSTICS_GET_POINTERS(
198         I                       diagName, listId,
199         O                       ndId, ip,
200         I                       myThid )
201    
202    C     !DESCRIPTION:
203    C     *================================================================*
204    C     | o Returns the diagnostic Id number and diagnostic
205    C     |   pointer to storage array for a specified diagnostic.
206    C     *================================================================*
207    C     | Note: A diagnostics field can be stored multiple times
208    C     |       (for different output frequency,phase, ...).
209    C     | operates in 2 ways:
210    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
211    C     | o listId >0 => find the unique diagnostic Id & pointer with
212    C     |      the right name and same output time as "listId" output-list
213    C     | o return ip=0 if did not find the right diagnostic;
214    C     |   (ndId <>0 if diagnostic exist but output time does not match)
215    C     *================================================================*
216    
217    C     !USES:
218          IMPLICIT NONE
219    #include "EEPARAMS.h"
220    #include "SIZE.h"
221    #include "DIAGNOSTICS_SIZE.h"
222    #include "DIAGNOSTICS.h"
223    
224    C     !INPUT PARAMETERS:
225    C     diagName :: diagnostic identificator name (8 characters long)
226    C     listId   :: list number that specify the output frequency
227    C     myThid   :: my Thread Id number
228    C     !OUTPUT PARAMETERS:
229    C     ndId     :: diagnostics  Id number (in available diagnostics list)
230    C     ip       :: diagnostics  pointer to storage array
231    
232    
233          CHARACTER*8 diagName
234          INTEGER listId
235          INTEGER ndId, ip
236          INTEGER myThid
237    CEOP
238    
239    C     !LOCAL VARIABLES:
240          INTEGER n,m
241    
242          ip   = 0
243          ndId = 0
244    
245          IF ( listId.LE.0 ) THEN
246    C--   select the 1rst one which name matches:
247    
248    C-    search for this diag. in the active 2D/3D diagnostics list
249            DO n=1,nlists
250             DO m=1,nActive(n)
251               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
252         &                  .AND. idiag(m,n).NE.0 ) THEN
253                ip   = ABS(idiag(m,n))
254                ndId = jdiag(m,n)
255               ENDIF
256             ENDDO
257            ENDDO
258    
259          ELSEIF ( listId.LE.nlists ) THEN
260    C--   select the unique diagnostic with output-time identical to listId
261    
262    C-    search for this diag. in the active 2D/3D diagnostics list
263            DO n=1,nlists
264             IF ( ip.EQ.0
265         &        .AND. freq(n) .EQ. freq(listId)
266         &        .AND. phase(n).EQ.phase(listId)
267         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
268         &        .AND. averagePhase(n).EQ.averagePhase(listId)
269         &        .AND. averageCycle(n).EQ.averageCycle(listId)
270         &      ) THEN
271              DO m=1,nActive(n)
272               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
273         &                  .AND. idiag(m,n).NE.0 ) THEN
274                ip   = ABS(idiag(m,n))
275                ndId = jdiag(m,n)
276               ENDIF
277              ENDDO
278             ELSEIF ( ip.EQ.0 ) THEN
279              DO m=1,nActive(n)
280               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
281         &                  .AND. idiag(m,n).NE.0 ) THEN
282                ndId = jdiag(m,n)
283               ENDIF
284              ENDDO
285             ENDIF
286            ENDDO
287    
288          ELSE
289            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
290          ENDIF
291    
292          RETURN
293          END
294    
295    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
296    
297    CBOP 0
298    C     !ROUTINE: DIAGS_GET_PARMS_I
299    
300    C     !INTERFACE:
301          INTEGER FUNCTION DIAGS_GET_PARMS_I(
302         I                            parName, myThid )
303    
304    C     !DESCRIPTION:
305    C     *==========================================================*
306    C     | FUNCTION DIAGS_GET_PARMS_I
307    C     | o Return the value of integer parameter
308    C     |   from one of the DIAGNOSTICS.h common blocs
309    C     *==========================================================*
310    
311    C     !USES:
312          IMPLICIT NONE
313    #include "EEPARAMS.h"
314    #include "SIZE.h"
315    #include "DIAGNOSTICS_SIZE.h"
316    #include "DIAGNOSTICS.h"
317    
318    C     !INPUT PARAMETERS:
319    C     parName   :: string used to identify which parameter to get
320    C     myThid    :: my Thread Id number
321          CHARACTER*(*) parName
322          INTEGER myThid
323    CEOP
324    
325    C     !LOCAL VARIABLES:
326          CHARACTER*(MAX_LEN_MBUF) msgBuf
327          INTEGER n
328    
329    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
330    
331          n = LEN(parName)
332    c     write(0,'(3A,I4)')
333    c    &  'DIAGS_GET_PARMS_I: parName="',parName,'" , length=',n
334    
335          IF ( parName.EQ.'LAST_DIAG_ID' ) THEN
336             DIAGS_GET_PARMS_I = ndiagt
337          ELSE
338             WRITE(msgBuf,'(4A)') 'DIAGS_GET_PARMS_I: ',
339         &    ' parName="', parName, '" not known.'
340             CALL PRINT_ERROR( msgBuf, myThid )
341             STOP 'ABNORMAL END: S/R DIAGS_GET_PARMS_I'
342          ENDIF
343    
344          RETURN
345          END
346    
347    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
348    
349    CBOP 0
350  C     !ROUTINE: DIAGS_MK_UNITS  C     !ROUTINE: DIAGS_MK_UNITS
351    
352  C     !INTERFACE:  C     !INTERFACE:
# Line 296  C---+----1----+----2----+----3----+----4 Line 468  C---+----1----+----2----+----3----+----4
468        ENDIF        ENDIF
469    
470        RETURN        RETURN
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP 0  
 C     !ROUTINE: DIAGNOSTICS_GET_POINTERS  
 C     !INTERFACE:  
       SUBROUTINE DIAGNOSTICS_GET_POINTERS(  
      I                       diagName, listId,  
      O                       ndId, ip,  
      I                       myThid )  
   
 C     !DESCRIPTION:  
 C     *================================================================*  
 C     | o Returns the diagnostic Id number and diagnostic  
 C     |   pointer to storage array for a specified diagnostic.  
 C     *================================================================*  
 C     | Note: A diagnostics field can be stored multiple times  
 C     |       (for different output frequency,phase, ...).  
 C     | operates in 2 ways:  
 C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.  
 C     | o listId >0 => find the unique diagnostic Id & pointer with  
 C     |      the right name and same output time as "listId" output-list  
 C     | o return ip=0 if did not find the right diagnostic;  
 C     |   (ndId <>0 if diagnostic exist but output time does not match)  
 C     *================================================================*  
   
 C     !USES:  
       IMPLICIT NONE  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
 C     !INPUT PARAMETERS:  
 C     diagName :: diagnostic identificator name (8 characters long)  
 C     listId   :: list number that specify the output frequency  
 C     myThid   :: my Thread Id number  
 C     !OUTPUT PARAMETERS:  
 C     ndId     :: diagnostics  Id number (in available diagnostics list)  
 C     ip       :: diagnostics  pointer to storage array  
   
   
       CHARACTER*8 diagName  
       INTEGER listId  
       INTEGER ndId, ip  
       INTEGER myThid  
 CEOP  
   
 C     !LOCAL VARIABLES:  
       INTEGER n,m  
   
       ip   = 0  
       ndId = 0  
   
       IF ( listId.LE.0 ) THEN  
 C--   select the 1rst one which name matches:  
   
 C-    search for this diag. in the active 2D/3D diagnostics list  
         DO n=1,nlists  
          DO m=1,nActive(n)  
            IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)  
      &                  .AND. idiag(m,n).NE.0 ) THEN  
             ip   = ABS(idiag(m,n))  
             ndId = jdiag(m,n)  
            ENDIF  
          ENDDO  
         ENDDO  
   
       ELSEIF ( listId.LE.nlists ) THEN  
 C--   select the unique diagnostic with output-time identical to listId  
   
 C-    search for this diag. in the active 2D/3D diagnostics list  
         DO n=1,nlists  
          IF ( ip.EQ.0  
      &        .AND. freq(n) .EQ. freq(listId)  
      &        .AND. phase(n).EQ.phase(listId)  
      &        .AND. averageFreq(n) .EQ.averageFreq(listId)  
      &        .AND. averagePhase(n).EQ.averagePhase(listId)  
      &        .AND. averageCycle(n).EQ.averageCycle(listId)  
      &      ) THEN  
           DO m=1,nActive(n)  
            IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)  
      &                  .AND. idiag(m,n).NE.0 ) THEN  
             ip   = ABS(idiag(m,n))  
             ndId = jdiag(m,n)  
            ENDIF  
           ENDDO  
          ELSEIF ( ip.EQ.0 ) THEN  
           DO m=1,nActive(n)  
            IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)  
      &                  .AND. idiag(m,n).NE.0 ) THEN  
             ndId = jdiag(m,n)  
            ENDIF  
           ENDDO  
          ENDIF  
         ENDDO  
   
       ELSE  
         STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'  
       ENDIF  
   
       RETURN  
471        END        END
Legend:
Removed from v.1.25  
changed lines
  Added in v.1.28
  ViewVC Help
Powered by ViewVC 1.1.22