/[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.1 by molod, Thu Feb 12 15:56:38 2004 UTC revision 1.19 by jmc, Thu Feb 17 00:00:47 2005 UTC
# Line 1  Line 1 
1        subroutine getdiag (qdiag,lev,ipoint,qtmp,im,jm,nd,undef)  C $Header$
2  C***********************************************************************          C $Name$
 C                                                                                
 C  PURPOSE                                                                        
 C     Retrieve averaged model diagnostic  
 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 ..... AVERAGED DIAGNOSTIC QUANTITY                                              
 C                                                                                
 C***********************************************************************          
       implicit none  
3    
4  #include "SIZE.h"  #include "DIAG_OPTIONS.h"
 #include "fizhi_SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
   
       integer    im,jm,nd  
       real qdiag(im,jm,nd)  
   
       integer lev,ipoint  
       integer i,j,ipnt,klev  
       real    undef, factor  
       real    qtmp(im,jm)  
   
       do j = 1,jm  
       do i = 1,im  
       qtmp(i,j) = undef  
       enddo  
       enddo  
   
       IF (IPOINT.LT.1) GO TO 999  
   
       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 j = 1,jm  
       do i = 1,im  
       if( qdiag(i,j,ipnt).ne.undef ) qtmp(i,j) = qdiag(i,j,ipnt)*factor  
       enddo  
       enddo  
       ENDIF  
5    
6   999  RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7        END  CBOP 0
8    C     !ROUTINE: GETDIAG
9    
10    C     !INTERFACE:
11          SUBROUTINE GETDIAG(
12         I                    levreal, undef,
13         O                    qtmp,
14         I                    ipoint, mate, bi, bj, myThid )
15    
16        subroutine getdiag2 (qdiag,lev,ipoint,qtmp,im,jm,nd,undef)  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    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"  
   
       integer    im,jm,nd  
       real qdiag(im,jm,nd)  
   
       integer lev,ipoint  
       integer i,j,ipnt,klev  
       real    undef, factor  
       real    qtmp(im,jm)  
   
       do j = 1,jm  
       do i = 1,im  
       qtmp(i,j) = undef  
       enddo  
       enddo  
25    
26        IF (IPOINT.LT.1) GO TO 999  C     !INPUT PARAMETERS:
27    C     levreal .... Diagnostic LEVEL
28    C     undef  ..... UNDEFINED VALUE
29    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
36          INTEGER ipoint, mate
37          INTEGER bi,bj, myThid
38    
39    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,jm  
       do i = 1,im  
       qtmp(i,j) = qdiag(i,j,ipnt)  
       enddo  
       enddo  
92        ENDIF        ENDIF
93    
94   999  RETURN        RETURN
95        END        END
96        subroutine  clrindx ( diag,indxlist )  
97    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
103  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST
104  C  C
105  C  ARGUMENT DESCRIPTION  C  ARGUMENT DESCRIPTION
106  C     INDXLIST.. INTEGER DIAGNOSTIC INDEX LIST  C     listnum ....  diagnostics list number
107  C  C
108  C***********************************************************************  C***********************************************************************
109    
110        implicit none        implicit none
111    #include "EEPARAMS.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"  
   
       integer indxlist (ndiagt)  
       integer index, n  
   
       character*8 parms1  
       character*1 parse1(8)  
       character*3 mate_index  
       integer     mate  
115    
116        equivalence (     parms1 , parse1(1) )        integer myThid, listnum
       equivalence ( mate_index , parse1(6) )  
117    
118        DO  INDEX=1,NDIAGT        integer m, n
119        N = INDXLIST (index)        character*8 parms1
120          character*3 mate_index
121          integer mate
122    
123        IF( N.NE.0 .AND. IDIAG(N).NE.0 ) THEN        do n=1,nfields(listnum)
124        call clrdiag (diag,n)         do m=1,ndiagt
125            if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then
126             call clrdiag (m, myThid)
127    
128  c Check for Counter Diagnostic  c Check for Counter Diagnostic
129  c ----------------------------  c ----------------------------
130        parms1 =  gdiag(n)           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 (diag,mate)            read (mate_index,'(I3)') mate
134        endif            call clrdiag (mate, myThid)
135             endif
136            endif
137           enddo
138          enddo
139    
140        ENDIF                RETURN
141        ENDDO        END
                     
   100 format(i3)  
       RETURN        
       END            
142    
143    
144        subroutine clrdiag (diag,n)        subroutine clrdiag (index, myThid)
145  C***********************************************************************          C***********************************************************************
146  C                                                                                C  PURPOSE
147  C  PURPOSE                                                                        C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS
148  C     INITIALIZE MODEL DIAGNOSTIC QUANTITIES                                      C***********************************************************************
149  C                                                                                
 C***********************************************************************          
                                                                                   
150        implicit none        implicit none
151    #include "EEPARAMS.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"
155  #include "diagnostics.h"  
156          integer myThid, index
157    
158        integer n        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        IF( IDIAG(N).NE.0 ) THEN                                                          do bj=myByLo(myThid), myByHi(myThid)
166           do bi=myBxLo(myThid), myBxHi(myThid)
167          do k=1,kdiag(n)          do k = 1,kdiag(index)
168          do j=1,sNx           do j = 1-OLy,sNy+OLy
169          do i=1,sNy            do i = 1-OLx,sNx+OLx
170          qdiag(i,j,idiag(n)+k-1) = 0.0             qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0
171          enddo            enddo
172          enddo           enddo
173          enddo          enddo
174           enddo
175          enddo
176    
177          ndiag(index) = 0
178    
179        NDIAG(N) = 0                                                                  RETURN
180        ENDIF                                                                            END
181                                                                                    
182        RETURN                                                                      C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
183        END                                                                        
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
272    C     !ROUTINE: DIAGNOSTICS_IS_ON
273    
274    C     !INTERFACE:
275          LOGICAL FUNCTION DIAGNOSTICS_IS_ON( diagName, myThid )
276    
277    C     !DESCRIPTION:
278    C     *==========================================================*
279    C     | FUNCTION DIAGNOSTIC_IS_ON
280    C     | o Return TRUE if diagnostics "diagName" is Active
281    C     *==========================================================*
282    
283    C     !USES:
284          IMPLICIT NONE
285    #include "EEPARAMS.h"
286    #include "SIZE.h"
287    #include "DIAGNOSTICS_SIZE.h"
288    #include "DIAGNOSTICS.h"
289    
290    C     !INPUT PARAMETERS:
291    C     diagName   ::  diagnostic identificator name (8 characters long)
292    C     myThid     ::  my thread Id number
293          CHARACTER*8  diagName
294          INTEGER      myThid
295    CEOP
296    
297    C     !LOCAL VARIABLES:
298          INTEGER j,n,m
299    
300          DIAGNOSTICS_IS_ON = .FALSE.
301          DO n=1,nlists
302           DO m=1,nActive(n)
303            IF ( diagName.EQ.flds(m,n) ) THEN
304              j = jdiag(m,n)    
305              IF ( idiag(j).NE.0 .AND. ndiag(j).GE.0 )
306         &         DIAGNOSTICS_IS_ON = .TRUE.
307            ENDIF
308           ENDDO
309          ENDDO
310    
311          RETURN
312          END
313    
314    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
315    
316    CBOP 0
317    C     !ROUTINE: DIAGS_MK_UNITS
318    
319    C     !INTERFACE:
320          CHARACTER*16 FUNCTION DIAGS_MK_UNITS(
321         I                            diagUnitsInPieces, myThid )
322    
323    C     !DESCRIPTION:
324    C     *==========================================================*
325    C     | FUNCTION DIAGS_MK_UNITS
326    C     | o Return the diagnostic units string (16c) removing
327    C     |   blanks from the input string
328    C     *==========================================================*
329    
330    C     !USES:
331          IMPLICIT NONE
332    #include "EEPARAMS.h"
333    
334    C     !INPUT PARAMETERS:
335    C     diagUnitsInPieces :: string for diagnostic units: in several
336    C                          pieces, with blanks in between
337    C     myThid            ::  my thread Id number
338          CHARACTER*(*) diagUnitsInPieces
339          INTEGER      myThid
340    CEOP
341    
342    C     !LOCAL VARIABLES:
343          CHARACTER*(MAX_LEN_MBUF) msgBuf
344          INTEGER i,j,n
345    
346          DIAGS_MK_UNITS = '          '
347          n = LEN(diagUnitsInPieces)
348          
349          j = 0
350          DO i=1,n
351           IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN
352             j = j+1
353             IF ( j.LE.16 ) DIAGS_MK_UNITS(j:j) = diagUnitsInPieces(i:i)
354           ENDIF
355          ENDDO
356    
357          IF ( j.GT.16 ) THEN
358             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
359         &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'
360            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
361         &       SQUEEZE_RIGHT , myThid)
362             WRITE(msgBuf,'(3A)') '**WARNING** ',
363         &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces
364            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
365         &       SQUEEZE_RIGHT , myThid)
366          ENDIF
367    
368          RETURN
369          END

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.19

  ViewVC Help
Powered by ViewVC 1.1.22