/[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.2 by molod, Thu Feb 26 02:21:18 2004 UTC revision 1.20 by jmc, Thu May 19 01:18:31 2005 UTC
# Line 1  Line 1 
1        subroutine getdiag (lev,ipoint,bi,bj,undef,qtmp)  C $Header$
2  C***********************************************************************          C $Name$
 C  PURPOSE                                                                        
 C     Retrieve averaged model diagnostic  
 C  INPUT:                                                                        
 C     lev ..... Diagnostic LEVEL  
 C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      
 C   undef ..... UNDEFINED VALUE                                                  
 C      bi ..... X-direction process(or) number  
 C      bj ..... Y-direction process(or) number  
 C                                                                                
 C  OUTPUT:                                                                        
 C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  
 C                                                                                
 C***********************************************************************          
       implicit none  
   
 #include "CPP_OPTIONS.h"  
 #include "SIZE.h"  
 #include "fizhi_SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
   
       integer bi,bj  
       integer lev,ipoint  
       integer i,j,ipnt,klev  
       _RL undef, factor  
       _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
   
       do j = 1,sNy  
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = undef  
       enddo  
       enddo  
3    
4        IF (IPOINT.LT.1) GO TO 999  #include "DIAG_OPTIONS.h"
5    
6        KLEV = KDIAG(IPOINT)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7        IF(KLEV.GE.LEV) THEN  CBOP 0
8        IPNT = IDIAG(IPOINT) + LEV - 1  C     !ROUTINE: GETDIAG
9                                  FACTOR = 1.0  
10        IF( NDIAG(IPOINT).NE.0 )  FACTOR = 1.0   / NDIAG(IPOINT)  C     !INTERFACE:
11        do j = 1,sNy        SUBROUTINE GETDIAG(
12        do i = 1,sNx       I                    levreal, undef,
13        if( qdiag(i,j,ipnt,bi,bj).ne.undef )       O                    qtmp,
14       .     qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor       I                    ipoint, mate, bi, bj, myThid )
       enddo  
       enddo  
       ENDIF  
   
  999  RETURN  
       END  
15    
16        subroutine getdiag2 (lev,ipoint,bi,bj,undef,qtmp)  C     !DESCRIPTION:
17  C***********************************************************************          C     Retrieve averaged model diagnostic
 C                                                                                
 C  PURPOSE                                                                        
 C     Retrieve model diagnostic (No Averaging)  
 C  INPUT:                                                                        
 C     lev ..... Model LEVEL                                                      
 C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      
 C   undef ..... UNDEFINED VALUE                                                  
 C      im ..... X-DIMENSION  
 C      jm ..... Y-DIMENSION  
 C      nd ..... Number of 2-D Diagnostics  
 C                                                                                
 C  OUTPUT:                                                                        
 C    qtmp ..... DIAGNOSTIC QUANTITY                                              
 C                                                                                
 C***********************************************************************          
       implicit none  
18    
19  #include "CPP_OPTIONS.h"  C     !USES:
20          IMPLICIT NONE
21    #include "EEPARAMS.h"
22  #include "SIZE.h"  #include "SIZE.h"
23  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
24  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
 #include "diagnostics.h"  
25    
26        integer bi,bj  C     !INPUT PARAMETERS:
27    C     levreal .... Diagnostic LEVEL
28        integer lev,ipoint  C     undef  ..... UNDEFINED VALUE
29        integer i,j,ipnt,klev  C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU
30    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
35        _RL undef        _RL undef
36        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)        INTEGER ipoint, mate
37          INTEGER bi,bj, myThid
       do j = 1,sNy  
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = undef  
       enddo  
       enddo  
38    
39        IF (IPOINT.LT.1) GO TO 999  C     !OUTPUT PARAMETERS:
40    C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
41          _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
42    CEOP
43    
44    C     !LOCAL VARIABLES:
45          _RL factor
46          INTEGER i, j, ipnt,ipCt
47          INTEGER lev, levCt, klev
48    
49          IF (ipoint.GE.1) THEN
50           lev = NINT(levreal)
51           klev = kdiag(ipoint)
52           IF (lev.LE.klev) THEN
53    
54            IF ( mate.EQ.0 ) THEN
55    C-      No counter diagnostics => average = Sum / ndiag :
56    
57              ipnt = idiag(ipoint) + lev - 1
58    c         factor = 1.0
59    c         if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
60              factor = FLOAT(ndiag(ipoint))
61              IF (ndiag(ipoint).NE.0) factor = 1. _d 0 / factor
62    
63              DO j = 1,sNy+1
64                DO i = 1,sNx+1
65                  IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
66                    qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
67                  ELSE
68                    qtmp(i,j) = undef
69                  ENDIF
70                ENDDO
71              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        KLEV = KDIAG(IPOINT)          ENDIF
91        IF(KLEV.GE.LEV) THEN         ENDIF
       IPNT = IDIAG(IPOINT) + LEV - 1  
       do j = 1,sNy  
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj)  
       enddo  
       enddo  
92        ENDIF        ENDIF
93    
94   999  RETURN        RETURN
95        END        END
96                                                                                    
97        subroutine clrindx (myThid,listnum)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
98    
99          subroutine clrindx (listnum, myThid)
100  C***********************************************************************  C***********************************************************************
101  C  C
102  C  PURPOSE  C  PURPOSE
# Line 117  C*************************************** Line 109  C***************************************
109    
110        implicit none        implicit none
111  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CPP_OPTIONS.h"  
112  #include "SIZE.h"  #include "SIZE.h"
113  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
114  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
 #include "diagnostics.h"  
115    
116        integer myThid, listnum        integer myThid, listnum
117    
118        integer m, n        integer m, n
119        character*8 parms1        character*8 parms1
       character*1 parse1(8)  
120        character*3 mate_index        character*3 mate_index
121        integer mate        integer mate
122    
       equivalence (     parms1 , parse1(1) )  
       equivalence ( mate_index , parse1(6) )  
   
123        do n=1,nfields(listnum)        do n=1,nfields(listnum)
124         do m=1,ndiagt         do m=1,ndiagt
125          if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then          if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then
126           call clrdiag (myThid,m)           call clrdiag (m, myThid)
127    
128  c Check for Counter Diagnostic  c Check for Counter Diagnostic
129  c ----------------------------  c ----------------------------
130           parms1 =  gdiag(m)           parms1 =  gdiag(m)(1:8)
131           if( parse1(5).eq.'C' ) then           if ( parms1(5:5).eq.'C' ) then
132            read (mate_index,100) mate            mate_index = parms1(6:8)
133            call clrdiag (myThid,mate)            read (mate_index,'(I3)') mate
134              call clrdiag (mate, myThid)
135           endif           endif
136          endif          endif
137         enddo         enddo
138        enddo        enddo
139                      
140    100 format(i3)        RETURN
141        RETURN              END
       END            
142    
143    
144        subroutine clrdiag (myThid,index)        subroutine clrdiag (index, myThid)
145  C***********************************************************************          C***********************************************************************
146  C  PURPOSE                                                                        C  PURPOSE
147  C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS  C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS
148  C***********************************************************************          C***********************************************************************
149                                                                                    
150        implicit none        implicit none
151  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CPP_OPTIONS.h"  
152  #include "SIZE.h"  #include "SIZE.h"
153  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
154  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
 #include "diagnostics.h"  
155    
156        integer myThid, index        integer myThid, index
157    
158        integer bi,bj        integer bi,bj
159        integer i,j,k        integer i,j,k
160    
161  C **********************************************************************          C **********************************************************************
162  C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****          C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****
163  C **********************************************************************          C **********************************************************************
164                                                                                    
165        do bj=myByLo(myThid), myByHi(myThid)        do bj=myByLo(myThid), myByHi(myThid)
166        do bi=myBxLo(myThid), myBxHi(myThid)         do bi=myBxLo(myThid), myBxHi(myThid)
167         do k = 1,kdiag(index)          do k = 1,kdiag(index)
168          do j = 1,sNy           do j = 1-OLy,sNy+OLy
169          do i = 1,sNx            do i = 1-OLx,sNx+OLx
170           qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0             qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0
171          enddo            enddo
172             enddo
173          enddo          enddo
174         enddo         enddo
175        enddo        enddo
       enddo  
176    
177        ndiag(index) = 0        ndiag(index) = 0
178    
179        return        RETURN
180        end        END
181    
182    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
183    
184        subroutine setdiag (myThid,num,ndiagmx)  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***********************************************************************  C***********************************************************************
192  C  C   routine to increment the diagnostic counter only
 C  PURPOSE  
 C     SET POINTER LOCATIONS, NAMES, LEVELS and TITLES FOR DIAGNOSTIC NUM  
 C  
193  C***********************************************************************  C***********************************************************************
194    C     !USES:
195          IMPLICIT NONE
196    
197        implicit none  C     == Global variables ===
198  #include "CPP_OPTIONS.h"  #include "EEPARAMS.h"
199  #include "SIZE.h"  #include "SIZE.h"
200  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
201  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
 #include "diagnostics.h"  
202    
203        integer num,myThid,ndiagmx  C     !INPUT PARAMETERS:
204        integer ipointer  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        DATA IPOINTER / 1 /        ENDIF
265    
266        character*8 parms1        RETURN
267        character*1 parse1(8)        END
       character*3 mate_index  
       integer     mate  
268    
269        equivalence (     parms1 , parse1(1) )  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
       equivalence ( mate_index , parse1(6) )  
270    
271  C **********************************************************************  CBOP 0
272  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****  C     !ROUTINE: DIAGS_MK_UNITS
 C **********************************************************************  
273    
274        parms1 = gdiag(num)  C     !INTERFACE:
275          CHARACTER*16 FUNCTION DIAGS_MK_UNITS(
276         I                            diagUnitsInPieces, myThid )
277    
278    C     !DESCRIPTION:
279    C     *==========================================================*
280    C     | FUNCTION DIAGS_MK_UNITS
281    C     | o Return the diagnostic units string (16c) removing
282    C     |   blanks from the input string
283    C     *==========================================================*
284    
285        IF( IDIAG(NUM).EQ.0 ) THEN  C     !USES:
286          if(ndiagmx+kdiag(num).gt.numdiags) then        IMPLICIT NONE
287            write(6,4000)num,cdiag(num)  #include "EEPARAMS.h"
         else  
           IDIAG(NUM) = IPOINTER  
           IPOINTER   = IPOINTER + KDIAG(NUM)  
           ndiagmx    = ndiagmx  + KDIAG(NUM)  
           if(myThid.eq.0) WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx  
         endif  
       ELSE  
           if(myThid.eq.0) WRITE(6,3000) NUM, CDIAG(NUM)  
       ENDIF  
   
 c Check for Counter Diagnostic  
 c ----------------------------  
       if( parse1(5).eq.'C') then  
       read (mate_index,100) mate  
288    
289        IF( IDIAG(mate).EQ.0 ) THEN  C     !INPUT PARAMETERS:
290         if(ndiagmx+kdiag(num).gt.numdiags) then  C     diagUnitsInPieces :: string for diagnostic units: in several
291          write(6,5000)num,cdiag(num)  C                          pieces, with blanks in between
292         else  C     myThid            ::  my thread Id number
293          IDIAG(mate) = IPOINTER        CHARACTER*(*) diagUnitsInPieces
294          IPOINTER    = IPOINTER + KDIAG(mate)        INTEGER      myThid
295          ndiagmx     = ndiagmx  + KDIAG(mate)  CEOP
296          if(myThid.eq.0)WRITE(6,2000)KDIAG(mate),mate,CDIAG(mate),ndiagmx  
297         endif  C     !LOCAL VARIABLES:
298        ELSE        CHARACTER*(MAX_LEN_MBUF) msgBuf
299            if(myThid.eq.0) WRITE(6,3000) mate, CDIAG(mate)        INTEGER i,j,n
300    
301          DIAGS_MK_UNITS = '          '
302          n = LEN(diagUnitsInPieces)
303          
304          j = 0
305          DO i=1,n
306           IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN
307             j = j+1
308             IF ( j.LE.16 ) DIAGS_MK_UNITS(j:j) = diagUnitsInPieces(i:i)
309           ENDIF
310          ENDDO
311    
312          IF ( j.GT.16 ) THEN
313             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
314         &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'
315            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
316         &       SQUEEZE_RIGHT , myThid)
317             WRITE(msgBuf,'(3A)') '**WARNING** ',
318         &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces
319            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
320         &       SQUEEZE_RIGHT , myThid)
321        ENDIF        ENDIF
       endif  
322    
323        RETURN        RETURN
   
   100 format(i3)  
  2000 FORMAT(1X,'Allocating ',I2,' Level(s) for Diagnostic # ',I3,  
      .          ' (',A8,'),  Total Number of Diagnostics: ',I5)  
  3000 FORMAT(1X,'Diagnostic # ',I3,' (',A8,') has already been set')  
  4000 FORMAT(1X,'Unable to allocate space for Diagnostic # ',I3,  
      .                      ' (',A8,')')  
  5000 FORMAT(1X,'Unable to allocate space for Counter Diagnostic # ',  
      .    I3,' (',A8,')',' WARNING - Diag will not accumulate properly')  
324        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22