/[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.30 by jmc, Fri Jan 15 18:57:07 2010 UTC revision 1.31 by jmc, Sun Jun 12 19:08:21 2011 UTC
# Line 5  C $Name$ Line 5  C $Name$
5    
6  C--   File diagnostics_utils.F: General purpose support routines  C--   File diagnostics_utils.F: General purpose support routines
7  C--    Contents:  C--    Contents:
 C--    o GETDIAG  
8  C--    o DIAGNOSTICS_COUNT  C--    o DIAGNOSTICS_COUNT
9    C--    o DIAGNOSTICS_GET_DIAG
10  C--    o DIAGNOSTICS_GET_POINTERS  C--    o DIAGNOSTICS_GET_POINTERS
11  C--    o DIAGNOSTICS_SETKLEV  C--    o DIAGNOSTICS_SETKLEV
12  C--    o DIAGS_GET_PARMS_I (Function)  C--    o DIAGS_GET_PARMS_I (Function)
# Line 14  C--    o DIAGS_MK_UNITS (Function) Line 14  C--    o DIAGS_MK_UNITS (Function)
14  C--    o DIAGS_MK_TITLE (Function)  C--    o DIAGS_MK_TITLE (Function)
15    
16  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 CBOP 0  
 C     !ROUTINE: GETDIAG  
   
 C     !INTERFACE:  
       SUBROUTINE GETDIAG(  
      I                    levreal, undef,  
      O                    qtmp,  
      I                    ndId, mate, ip, im, bi, bj, myThid )  
   
 C     !DESCRIPTION:  
 C     Retrieve averaged model diagnostic  
   
 C     !USES:  
       IMPLICIT NONE  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
 C     !INPUT PARAMETERS:  
 C     levreal :: Diagnostic LEVEL  
 C     undef   :: UNDEFINED VALUE  
 C     ndId    :: DIAGNOSTIC NUMBER FROM MENU  
 C     mate    :: counter DIAGNOSTIC NUMBER if any ; 0 otherwise  
 C     ip      :: pointer to storage array location for diag.  
 C     im      :: pointer to storage array location for mate  
 C     bi      :: X-direction tile number  
 C     bj      :: Y-direction tile number  
 C     myThid  :: my thread Id number  
       _RL levreal  
       _RL undef  
       INTEGER ndId, mate, ip, im  
       INTEGER bi,bj, myThid  
   
 C     !OUTPUT PARAMETERS:  
 C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY  
       _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
 CEOP  
   
 C     !LOCAL VARIABLES:  
       _RL factor  
       INTEGER i, j, ipnt,ipCt  
       INTEGER lev, levCt, klev  
   
       IF (ndId.GE.1) THEN  
        lev = NINT(levreal)  
        klev = kdiag(ndId)  
        IF (lev.LE.klev) THEN  
   
         IF ( mate.EQ.0 ) THEN  
 C-      No counter diagnostics => average = Sum / ndiag :  
   
           ipnt = ip + lev - 1  
           factor = FLOAT(ndiag(ip,bi,bj))  
           IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor  
   
 #ifdef ALLOW_FIZHI  
           DO j = 1,sNy+1  
             DO i = 1,sNx+1  
               IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN  
                 qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor  
               ELSE  
                 qtmp(i,j) = undef  
               ENDIF  
             ENDDO  
           ENDDO  
 #else /* ALLOW_FIZHI */  
           DO j = 1,sNy+1  
             DO i = 1,sNx+1  
               qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor  
             ENDDO  
           ENDDO  
 #endif /* ALLOW_FIZHI */  
   
         ELSE  
 C-      With counter diagnostics => average = Sum / counter:  
   
           ipnt = ip + lev - 1  
           levCt= MIN(lev,kdiag(mate))  
           ipCt = im + levCt - 1  
           DO j = 1,sNy+1  
             DO i = 1,sNx+1  
               IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN  
                 qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)  
      &                    / qdiag(i,j,ipCt,bi,bj)  
               ELSE  
                 qtmp(i,j) = undef  
               ENDIF  
             ENDDO  
           ENDDO  
   
         ENDIF  
        ENDIF  
       ENDIF  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
17    
18  CBOP 0  CBOP 0
19  C     !ROUTINE: DIAGNOSTICS_COUNT  C     !ROUTINE: DIAGNOSTICS_COUNT
20  C     !INTERFACE:  C     !INTERFACE:
21        SUBROUTINE DIAGNOSTICS_COUNT (chardiag,        SUBROUTINE DIAGNOSTICS_COUNT( diagName,
22       I                              biArg, bjArg, myThid)       I                              biArg, bjArg, myThid )
23    
24  C     !DESCRIPTION:  C     !DESCRIPTION:
25  C***********************************************************************  C***********************************************************************
# Line 137  C     !INPUT PARAMETERS: Line 38  C     !INPUT PARAMETERS:
38  C***********************************************************************  C***********************************************************************
39  C  Arguments Description  C  Arguments Description
40  C  ----------------------  C  ----------------------
41  C     chardiag :: Character expression for diag to increment the counter  C     diagName :: name of diagnostic to increment the counter
42  C     biArg    :: X-direction tile number, or 0 if called outside bi,bj loops  C     biArg    :: X-direction tile number, or 0 if called outside bi,bj loops
43  C     bjArg    :: Y-direction tile number, or 0 if called outside bi,bj loops  C     bjArg    :: Y-direction tile number, or 0 if called outside bi,bj loops
44  C     myThid   :: my thread Id number  C     myThid   :: my thread Id number
45  C***********************************************************************  C***********************************************************************
46        CHARACTER*8 chardiag        CHARACTER*8 diagName
47        INTEGER biArg, bjArg        INTEGER biArg, bjArg
48        INTEGER myThid        INTEGER myThid
49  CEOP  CEOP
# Line 164  c     CHARACTER*(MAX_LEN_MBUF) msgBuf Line 65  c     CHARACTER*(MAX_LEN_MBUF) msgBuf
65    
66  C--   Run through list of active diagnostics to find which counter  C--   Run through list of active diagnostics to find which counter
67  C     to increment (needs to be a valid & active diagnostic-counter)  C     to increment (needs to be a valid & active diagnostic-counter)
68        DO n=1,nlists        DO n=1,nLists
69         DO m=1,nActive(n)         DO m=1,nActive(n)
70          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN          IF ( diagName.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
71           ipt = idiag(m,n)           ipt = idiag(m,n)
72           IF (ndiag(ipt,bi,bj).GE.0) THEN           IF (ndiag(ipt,bi,bj).GE.0) THEN
73            ndId = jdiag(m,n)            ndId = jdiag(m,n)
# Line 193  C-    Increment is done Line 94  C-    Increment is done
94  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
95    
96  CBOP 0  CBOP 0
97    C     !ROUTINE: DIAGNOSTICS_GET_DIAG
98    
99    C     !INTERFACE:
100          SUBROUTINE DIAGNOSTICS_GET_DIAG(
101         I                    kl, undefRL,
102         O                    qtmp,
103         I                    ndId, mate, ip, im, bi, bj, myThid )
104    
105    C     !DESCRIPTION:
106    C     Retrieve time-averaged (or snap-shot) diagnostic field
107    
108    C     !USES:
109          IMPLICIT NONE
110    #include "EEPARAMS.h"
111    #include "SIZE.h"
112    #include "DIAGNOSTICS_SIZE.h"
113    #include "DIAGNOSTICS.h"
114    
115    C     !INPUT PARAMETERS:
116    C     kl      :: level selection: >0 : single selected lev ; =0 : all kdiag levels
117    C     undefRL :: undefined "_RL" type value
118    C     ndId    :: diagnostic Id number (in available diagnostics list)
119    C     mate    :: counter diagnostic number if any ; 0 otherwise
120    C     ip      :: pointer to storage array location for diag.
121    C     im      :: pointer to storage array location for mate
122    C     bi      :: X-direction tile number
123    C     bj      :: Y-direction tile number
124    C     myThid  :: my thread Id number
125          INTEGER kl
126          _RL undefRL
127          INTEGER ndId, mate, ip, im
128          INTEGER bi, bj, myThid
129    
130    C     !OUTPUT PARAMETERS:
131    C     qtmp    :: time-averaged (or snap-shot) diagnostic field
132          _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,*)
133    CEOP
134    
135    C     !LOCAL VARIABLES:
136          _RL factor
137          INTEGER i, j, ipnt, ipCt
138          INTEGER k, kd, km, kLev
139    
140          IF (ndId.GE.1) THEN
141           kLev = kdiag(ndId)
142           IF ( kl.GE.1 .AND. kl.LE.kLev ) THEN
143            kLev = 1
144           ELSEIF ( kl.NE.0 ) THEN
145            kLev = 0
146           ENDIF
147    
148           DO k = 1,kLev
149            kd = k
150            IF ( kl.GE.1 ) kd = kl
151    
152            IF ( mate.EQ.0 ) THEN
153    C-      No counter diagnostics => average = Sum / ndiag :
154    
155              ipnt = ip + kd - 1
156              factor = FLOAT(ndiag(ip,bi,bj))
157              IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor
158    
159    #ifdef ALLOW_FIZHI
160              DO j = 1,sNy+1
161                DO i = 1,sNx+1
162                  IF ( qdiag(i,j,ipnt,bi,bj) .LE. undefRL ) THEN
163                    qtmp(i,j,k) = qdiag(i,j,ipnt,bi,bj)*factor
164                  ELSE
165                    qtmp(i,j,k) = undefRL
166                  ENDIF
167                ENDDO
168              ENDDO
169    #else /* ALLOW_FIZHI */
170              DO j = 1,sNy+1
171                DO i = 1,sNx+1
172                  qtmp(i,j,k) = qdiag(i,j,ipnt,bi,bj)*factor
173                ENDDO
174              ENDDO
175    #endif /* ALLOW_FIZHI */
176    
177            ELSE
178    C-      With counter diagnostics => average = Sum / counter:
179    
180              ipnt = ip + kd - 1
181              km = MIN(kd,kdiag(mate))
182              ipCt = im + km - 1
183              DO j = 1,sNy+1
184                DO i = 1,sNx+1
185                  IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN
186                    qtmp(i,j,k) = qdiag(i,j,ipnt,bi,bj)
187         &                      / qdiag(i,j,ipCt,bi,bj)
188                  ELSE
189                    qtmp(i,j,k) = undefRL
190                  ENDIF
191                ENDDO
192              ENDDO
193    
194            ENDIF
195           ENDDO
196          ENDIF
197    
198          RETURN
199          END
200    
201    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
202    
203    CBOP 0
204  C     !ROUTINE: DIAGNOSTICS_GET_POINTERS  C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
205  C     !INTERFACE:  C     !INTERFACE:
206        SUBROUTINE DIAGNOSTICS_GET_POINTERS(        SUBROUTINE DIAGNOSTICS_GET_POINTERS(
# Line 247  C     !LOCAL VARIABLES: Line 255  C     !LOCAL VARIABLES:
255  C--   select the 1rst one which name matches:  C--   select the 1rst one which name matches:
256    
257  C-    search for this diag. in the active 2D/3D diagnostics list  C-    search for this diag. in the active 2D/3D diagnostics list
258          DO n=1,nlists          DO n=1,nLists
259           DO m=1,nActive(n)           DO m=1,nActive(n)
260             IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)             IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
261       &                  .AND. idiag(m,n).NE.0 ) THEN       &                  .AND. idiag(m,n).NE.0 ) THEN
# Line 257  C-    search for this diag. in the activ Line 265  C-    search for this diag. in the activ
265           ENDDO           ENDDO
266          ENDDO          ENDDO
267    
268        ELSEIF ( listId.LE.nlists ) THEN        ELSEIF ( listId.LE.nLists ) THEN
269  C--   select the unique diagnostic with output-time identical to listId  C--   select the unique diagnostic with output-time identical to listId
270    
271  C-    search for this diag. in the active 2D/3D diagnostics list  C-    search for this diag. in the active 2D/3D diagnostics list
272          DO n=1,nlists          DO n=1,nLists
273           IF ( ip.EQ.0           IF ( ip.EQ.0
274       &        .AND. freq(n) .EQ. freq(listId)       &        .AND. freq(n) .EQ. freq(listId)
275       &        .AND. phase(n).EQ.phase(listId)       &        .AND. phase(n).EQ.phase(listId)
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.31
  ViewVC Help
Powered by ViewVC 1.1.22