/[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.20 by jmc, Thu May 19 01:18:31 2005 UTC revision 1.21 by jmc, Sun Jun 26 16:51:49 2005 UTC
# Line 11  C     !INTERFACE: Line 11  C     !INTERFACE:
11        SUBROUTINE GETDIAG(        SUBROUTINE GETDIAG(
12       I                    levreal, undef,       I                    levreal, undef,
13       O                    qtmp,       O                    qtmp,
14       I                    ipoint, mate, bi, bj, myThid )       I                    ndId, mate, ip, im, bi, bj, myThid )
15    
16  C     !DESCRIPTION:  C     !DESCRIPTION:
17  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 24  C     !USES: Line 24  C     !USES:
24  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
25    
26  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
27  C     levreal .... Diagnostic LEVEL  C     levreal :: Diagnostic LEVEL
28  C     undef  ..... UNDEFINED VALUE  C     undef   :: UNDEFINED VALUE
29  C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU  C     ndId    :: DIAGNOSTIC NUMBER FROM MENU
30  C     mate   ..... counter DIAGNOSTIC NUMBER if any ; 0 otherwise  C     mate    :: counter DIAGNOSTIC NUMBER if any ; 0 otherwise
31  C     bi     ..... X-direction tile number  C     ip      :: pointer to storage array location for diag.
32  C     bj     ..... Y-direction tile number  C     im      :: pointer to storage array location for mate
33  C     myThid ..... my thread Id number  C     bi      :: X-direction tile number
34    C     bj      :: Y-direction tile number
35    C     myThid  :: my thread Id number
36        _RL levreal        _RL levreal
37        _RL undef        _RL undef
38        INTEGER ipoint, mate        INTEGER ndId, mate, ip, im
39        INTEGER bi,bj, myThid        INTEGER bi,bj, myThid
40    
41  C     !OUTPUT PARAMETERS:  C     !OUTPUT PARAMETERS:
# Line 46  C     !LOCAL VARIABLES: Line 48  C     !LOCAL VARIABLES:
48        INTEGER i, j, ipnt,ipCt        INTEGER i, j, ipnt,ipCt
49        INTEGER lev, levCt, klev        INTEGER lev, levCt, klev
50    
51        IF (ipoint.GE.1) THEN        IF (ndId.GE.1) THEN
52         lev = NINT(levreal)         lev = NINT(levreal)
53         klev = kdiag(ipoint)         klev = kdiag(ndId)
54         IF (lev.LE.klev) THEN         IF (lev.LE.klev) THEN
55    
56          IF ( mate.EQ.0 ) THEN          IF ( mate.EQ.0 ) THEN
57  C-      No counter diagnostics => average = Sum / ndiag :  C-      No counter diagnostics => average = Sum / ndiag :
58    
59            ipnt = idiag(ipoint) + lev - 1            ipnt = ip + lev - 1
60  c         factor = 1.0            factor = FLOAT(ndiag(ip,bi,bj))
61  c         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor
           factor = FLOAT(ndiag(ipoint))  
           IF (ndiag(ipoint).NE.0) factor = 1. _d 0 / factor  
62    
63            DO j = 1,sNy+1            DO j = 1,sNy+1
64              DO i = 1,sNx+1              DO i = 1,sNx+1
# Line 73  c         if (ndiag(ipoint).ne.0) factor Line 73  c         if (ndiag(ipoint).ne.0) factor
73          ELSE          ELSE
74  C-      With counter diagnostics => average = Sum / counter:  C-      With counter diagnostics => average = Sum / counter:
75    
76            ipnt = idiag(ipoint) + lev - 1            ipnt = ip + lev - 1
77            levCt= MIN(lev,kdiag(mate))            levCt= MIN(lev,kdiag(mate))
78            ipCt = idiag(mate) + levCt - 1            ipCt = im + levCt - 1
79            DO j = 1,sNy+1            DO j = 1,sNy+1
80              DO i = 1,sNx+1              DO i = 1,sNx+1
81                IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN                IF ( qdiag(i,j,ipCt,bi,bj) .NE. 0. ) THEN
# Line 96  C-      With counter diagnostics => aver Line 96  C-      With counter diagnostics => aver
96    
97  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
98    
       subroutine clrindx (listnum, myThid)  
 C***********************************************************************  
 C  
 C  PURPOSE  
 C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST  
 C  
 C  ARGUMENT DESCRIPTION  
 C     listnum ....  diagnostics list number  
 C  
 C***********************************************************************  
   
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
       integer myThid, listnum  
   
       integer m, n  
       character*8 parms1  
       character*3 mate_index  
       integer mate  
   
       do n=1,nfields(listnum)  
        do m=1,ndiagt  
         if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then  
          call clrdiag (m, myThid)  
   
 c Check for Counter Diagnostic  
 c ----------------------------  
          parms1 =  gdiag(m)(1:8)  
          if ( parms1(5:5).eq.'C' ) then  
           mate_index = parms1(6:8)  
           read (mate_index,'(I3)') mate  
           call clrdiag (mate, myThid)  
          endif  
         endif  
        enddo  
       enddo  
   
       RETURN  
       END  
   
   
       subroutine clrdiag (index, myThid)  
 C***********************************************************************  
 C  PURPOSE  
 C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS  
 C***********************************************************************  
   
       implicit none  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
       integer myThid, index  
   
       integer bi,bj  
       integer i,j,k  
   
 C **********************************************************************  
 C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****  
 C **********************************************************************  
   
       do bj=myByLo(myThid), myByHi(myThid)  
        do bi=myBxLo(myThid), myBxHi(myThid)  
         do k = 1,kdiag(index)  
          do j = 1-OLy,sNy+OLy  
           do i = 1-OLx,sNx+OLx  
            qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0  
           enddo  
          enddo  
         enddo  
        enddo  
       enddo  
   
       ndiag(index) = 0  
   
       RETURN  
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
99  CBOP 0  CBOP 0
100  C     !ROUTINE: DIAGNOSTICS_COUNT  C     !ROUTINE: DIAGNOSTICS_COUNT
101  C     !INTERFACE:  C     !INTERFACE:
102        SUBROUTINE DIAGNOSTICS_COUNT (chardiag,        SUBROUTINE DIAGNOSTICS_COUNT (chardiag,
103       I                              biArg, bjArg, myThid)       I                              biArg, bjArg, myThid)
104    
105  C     !DESCRIPTION:  C     !DESCRIPTION:
106  C***********************************************************************  C***********************************************************************
# Line 216  CEOP Line 131  CEOP
131    
132  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
133  C ===============  C ===============
134        INTEGER m, n        INTEGER m, n
135        INTEGER ndiagnum, ipointer        INTEGER bi, bj
136  c     INTEGER bi, bj        INTEGER ipt
137  c     CHARACTER*(MAX_LEN_MBUF) msgBuf  c     CHARACTER*(MAX_LEN_MBUF) msgBuf
138    
139  C Run through list of active diagnostics to make sure  C--   Run through list of active diagnostics to find which counter
140  C we are trying to increment a valid diagnostic-counter  C     to increment (needs to be a valid & active diagnostic-counter)
   
       ndiagnum = 0  
       ipointer = 0  
141        DO n=1,nlists        DO n=1,nlists
142         DO m=1,nActive(n)         DO m=1,nActive(n)
143          IF ( chardiag.EQ.flds(m,n) ) THEN          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
144           ndiagnum = jdiag(m,n)           ipt = idiag(m,n)
145           IF (ndiag(ndiagnum).GE.0) ipointer = idiag(ndiagnum)           IF (ndiag(ipt,1,1).GE.0) THEN
146    C-    Increment the counter for the diagnostic
147              IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
148               DO bj=myByLo(myThid), myByHi(myThid)
149                DO bi=myBxLo(myThid), myBxHi(myThid)
150                 ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1
151                ENDDO
152               ENDDO
153              ELSE
154                 bi = MIN(biArg,nSx)
155                 bj = MIN(bjArg,nSy)
156                 ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1
157              ENDIF
158    C-    Increment is done
159             ENDIF
160          ENDIF          ENDIF
161         ENDDO         ENDDO
162        ENDDO        ENDDO
163    
164  C If-sequence to see if we are a valid and an active diagnostic        RETURN
   
       IF ( ndiagnum.NE.0 .AND. ipointer.NE.0 ) THEN  
   
 C Increment the counter for the diagnostic (if we are at bi=bj=myThid=1)  
        _BEGIN_MASTER(myThid)  
         IF ( (biArg.EQ.1 .AND. bjArg.EQ.1) .OR.  
      &       (biArg.EQ.0 .AND. bjArg.EQ.0) )  
      &                     ndiag(ndiagnum) = ndiag(ndiagnum) + 1  
        _END_MASTER(myThid)  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 C-- note: counter could become a tiled array, and then it would be:  
 c       IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN  
 c        DO bj=myByLo(myThid), myByHi(myThid)  
 c         DO bi=myBxLo(myThid), myBxHi(myThid)  
 c          ndiag(ndiagnum,bi,bj) = ndiag(ndiagnum,bi,bj) + 1  
 c         ENDDO  
 c        ENDDO  
 c       ELSE  
 c          bi = MIN(biArg,nSx)  
 c          bj = MIN(bjArg,nSy)  
 c          ndiag(ndiagnum,bi,bj) = ndiag(ndiagnum,bi,bj) + 1  
 c       ENDIF  
   
       ENDIF  
   
       RETURN  
165        END        END
166    
167  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 272  CBOP 0 Line 170  CBOP 0
170  C     !ROUTINE: DIAGS_MK_UNITS  C     !ROUTINE: DIAGS_MK_UNITS
171    
172  C     !INTERFACE:  C     !INTERFACE:
173        CHARACTER*16 FUNCTION DIAGS_MK_UNITS(        CHARACTER*16 FUNCTION DIAGS_MK_UNITS(
174       I                            diagUnitsInPieces, myThid )       I                            diagUnitsInPieces, myThid )
175    
176  C     !DESCRIPTION:  C     !DESCRIPTION:
177  C     *==========================================================*  C     *==========================================================*
178  C     | FUNCTION DIAGS_MK_UNITS  C     | FUNCTION DIAGS_MK_UNITS
179  C     | o Return the diagnostic units string (16c) removing  C     | o Return the diagnostic units string (16c) removing
180  C     |   blanks from the input string  C     |   blanks from the input string
181  C     *==========================================================*  C     *==========================================================*
182    
# Line 287  C     !USES: Line 185  C     !USES:
185  #include "EEPARAMS.h"  #include "EEPARAMS.h"
186    
187  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
188  C     diagUnitsInPieces :: string for diagnostic units: in several  C     diagUnitsInPieces :: string for diagnostic units: in several
189  C                          pieces, with blanks in between  C                          pieces, with blanks in between
190  C     myThid            ::  my thread Id number  C     myThid            ::  my thread Id number
191        CHARACTER*(*) diagUnitsInPieces        CHARACTER*(*) diagUnitsInPieces
# Line 298  C     !LOCAL VARIABLES: Line 196  C     !LOCAL VARIABLES:
196        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
197        INTEGER i,j,n        INTEGER i,j,n
198    
199        DIAGS_MK_UNITS = '          '        DIAGS_MK_UNITS = '          '
200        n = LEN(diagUnitsInPieces)        n = LEN(diagUnitsInPieces)
201          
202        j = 0        j = 0
203        DO i=1,n        DO i=1,n
204         IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN         IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22