/[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.17 by jmc, Fri Jan 28 01:06:12 2005 UTC revision 1.19 by jmc, Thu Feb 17 00:00:47 2005 UTC
# Line 8  CBOP 0 Line 8  CBOP 0
8  C     !ROUTINE: GETDIAG  C     !ROUTINE: GETDIAG
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE GETDIAG (levreal,ipoint,undef,qtmp,myThid)        SUBROUTINE GETDIAG(
12         I                    levreal, undef,
13         O                    qtmp,
14         I                    ipoint, mate, bi, bj, myThid )
15    
16  C     !DESCRIPTION:  C     !DESCRIPTION:
17  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
18    
19  C     !USES:  C     !USES:
20        implicit none        IMPLICIT NONE
21  #include "EEPARAMS.h"  #include "EEPARAMS.h"
22  #include "SIZE.h"  #include "SIZE.h"
23  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
24  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
 CEOP  
   
 #ifdef ALLOW_FIZHI  
 #include "fizhi_SIZE.h"  
 #else  
       integer Nrphys  
       parameter (Nrphys=0)  
 #endif  
25    
26  C     INPUT:  C     !INPUT PARAMETERS:
27  C     levreal .... Diagnostic LEVEL  C     levreal .... Diagnostic LEVEL
 C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU  
28  C     undef  ..... UNDEFINED VALUE  C     undef  ..... UNDEFINED VALUE
29  C     bi     ..... X-direction process(or) number  C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU
30  C     bj     ..... Y-direction process(or) number  C     mate   ..... counter DIAGNOSTIC NUMBER if any ; 0 otherwise
31    C     bi     ..... X-direction tile number
32    C     bj     ..... Y-direction tile number
33    C     myThid ..... my thread Id number
34        _RL levreal        _RL levreal
       integer myThid,ipoint  
35        _RL undef        _RL undef
36          INTEGER ipoint, mate
37          INTEGER bi,bj, myThid
38    
39  C     OUTPUT:  C     !OUTPUT PARAMETERS:
40  C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY  C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
41        _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)        _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
   
       _RL factor  
       integer i,j,ipnt,klev  
       integer bi,bj  
       integer lev  
   
       if (ipoint.ge.1) then  
        lev = NINT(levreal)  
   
        klev = kdiag(ipoint)  
        if (klev.ge.lev) then  
         ipnt = idiag(ipoint) + lev - 1  
         factor = 1.0  
         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)  
   
         do bj=myByLo(myThid), myByHi(myThid)  
           do bi=myBxLo(myThid), myBxHi(myThid)  
   
             do j = 1,sNy  
               do i = 1,sNx  
                 if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then  
                   qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor  
                 else  
                   qtmp(i,j,lev,bi,bj) = undef  
                 endif  
               enddo  
             enddo  
   
           enddo  
         enddo  
   
        endif  
       endif  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
 CBOP 0  
 C     !ROUTINE: GETDIAG2  
   
 C     !INTERFACE:  
       SUBROUTINE GETDIAG2 (levreal,ipoint,undef,qtmp,myThid)  
   
 C     !DESCRIPTION:  
 C***********************************************************************  
 C  PURPOSE  
 C     Retrieve averaged model diagnostic  
 C  INPUT:  
 C  levreal .... Diagnostic LEVEL  
 C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU  
 C   undef ..... UNDEFINED VALUE  
 C  
 C  OUTPUT:  
 C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  
 C  
 C***********************************************************************  
   
 C     !USES:  
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
42  CEOP  CEOP
43    
44  #ifdef ALLOW_FIZHI  C     !LOCAL VARIABLES:
45  #include "fizhi_SIZE.h"        _RL factor
46  #else        INTEGER i, j, ipnt,ipCt
47         integer Nrphys        INTEGER lev, levCt, klev
        parameter (Nrphys=0)  
 #endif  
   
       _RL levreal  
       integer myThid,ipoint  
       _RL undef  
       _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)  
   
       integer i,j,ipnt,klev  
       integer bi,bj  
       integer lev  
48    
49        if (ipoint.ge.1) then        IF (ipoint.GE.1) THEN
50         lev = NINT(levreal)         lev = NINT(levreal)
   
51         klev = kdiag(ipoint)         klev = kdiag(ipoint)
52         if (klev.ge.lev) then         IF (lev.LE.klev) THEN
         ipnt = idiag(ipoint) + lev - 1  
53    
54          do bj=myByLo(myThid), myByHi(myThid)          IF ( mate.EQ.0 ) THEN
55            do bi=myBxLo(myThid), myBxHi(myThid)  C-      No counter diagnostics => average = Sum / ndiag :
56    
57              do j = 1,sNy            ipnt = idiag(ipoint) + lev - 1
58                do i = 1,sNx  c         factor = 1.0
59                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then  c         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
60                    qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)            factor = FLOAT(ndiag(ipoint))
61                  else            IF (ndiag(ipoint).NE.0) factor = 1. _d 0 / factor
62                    qtmp(i,j,lev,bi,bj) = undef  
63                  endif            DO j = 1,sNy+1
64                enddo              DO i = 1,sNx+1
65              enddo                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
66                    qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
67            enddo                ELSE
68          enddo                  qtmp(i,j) = undef
69                  ENDIF
70         endif              ENDDO
71        endif            ENDDO
72    
73            ELSE
74    C-      With counter diagnostics => average = Sum / counter:
75    
76              ipnt = idiag(ipoint) + lev - 1
77              levCt= MIN(lev,kdiag(mate))
78              ipCt = idiag(mate) + levCt - 1
79              DO j = 1,sNy+1
80                DO i = 1,sNx+1
81                  IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN
82                    qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)
83         &                    / qdiag(i,j,ipCt,bi,bj)
84                  ELSE
85                    qtmp(i,j) = undef
86                  ENDIF
87                ENDDO
88              ENDDO
89    
90            ENDIF
91           ENDIF
92          ENDIF
93    
94        RETURN        RETURN
95        END        END
# Line 238  C ************************************** Line 180  C **************************************
180        END        END
181    
182  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
183    
184    CBOP 0
185    C     !ROUTINE: DIAGNOSTICS_COUNT
186    C     !INTERFACE:
187          SUBROUTINE DIAGNOSTICS_COUNT (chardiag,
188         I                              biArg, bjArg, myThid)
189    
190    C     !DESCRIPTION:
191    C***********************************************************************
192    C   routine to increment the diagnostic counter only
193    C***********************************************************************
194    C     !USES:
195          IMPLICIT NONE
196    
197    C     == Global variables ===
198    #include "EEPARAMS.h"
199    #include "SIZE.h"
200    #include "DIAGNOSTICS_SIZE.h"
201    #include "DIAGNOSTICS.h"
202    
203    C     !INPUT PARAMETERS:
204    C***********************************************************************
205    C  Arguments Description
206    C  ----------------------
207    C     chardiag :: Character expression for diag to increment the counter
208    C     biArg    :: X-direction tile number, or 0 if called outside bi,bj loops
209    C     bjArg    :: Y-direction tile number, or 0 if called outside bi,bj loops
210    C     myThid   :: my thread Id number
211    C***********************************************************************
212          CHARACTER*8 chardiag
213          INTEGER biArg, bjArg
214          INTEGER myThid
215    CEOP
216    
217    C     !LOCAL VARIABLES:
218    C ===============
219          INTEGER m, n
220          INTEGER ndiagnum, ipointer
221    c     INTEGER bi, bj
222    c     CHARACTER*(MAX_LEN_MBUF) msgBuf
223    
224    C Run through list of active diagnostics to make sure
225    C we are trying to increment a valid diagnostic-counter
226    
227          ndiagnum = 0
228          ipointer = 0
229          DO n=1,nlists
230           DO m=1,nActive(n)
231            IF ( chardiag.EQ.flds(m,n) ) THEN
232             ndiagnum = jdiag(m,n)
233             IF (ndiag(ndiagnum).GE.0) ipointer = idiag(ndiagnum)
234            ENDIF
235           ENDDO
236          ENDDO
237    
238    C If-sequence to see if we are a valid and an active diagnostic
239    
240          IF ( ndiagnum.NE.0 .AND. ipointer.NE.0 ) THEN
241    
242    C Increment the counter for the diagnostic (if we are at bi=bj=myThid=1)
243           _BEGIN_MASTER(myThid)
244            IF ( (biArg.EQ.1 .AND. bjArg.EQ.1) .OR.
245         &       (biArg.EQ.0 .AND. bjArg.EQ.0) )
246         &                     ndiag(ndiagnum) = ndiag(ndiagnum) + 1
247           _END_MASTER(myThid)
248    
249    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
250    
251    C-- note: counter could become a tiled array, and then it would be:
252    c       IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
253    c        DO bj=myByLo(myThid), myByHi(myThid)
254    c         DO bi=myBxLo(myThid), myBxHi(myThid)
255    c          ndiag(ndiagnum,bi,bj) = ndiag(ndiagnum,bi,bj) + 1
256    c         ENDDO
257    c        ENDDO
258    c       ELSE
259    c          bi = MIN(biArg,nSx)
260    c          bj = MIN(bjArg,nSy)
261    c          ndiag(ndiagnum,bi,bj) = ndiag(ndiagnum,bi,bj) + 1
262    c       ENDIF
263    
264          ENDIF
265    
266          RETURN
267          END
268    
269    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
270    
271  CBOP 0  CBOP 0
272  C     !ROUTINE: DIAGNOSTICS_IS_ON  C     !ROUTINE: DIAGNOSTICS_IS_ON
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22