/[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.21 by jmc, Sun Jun 26 16:51:49 2005 UTC
# Line 1  Line 1 
1        subroutine getdiag (qdiag,lev,ipoint,qtmp,im,jm,nd,undef)  C $Header$
2  C***********************************************************************          C $Name$
3  C                                                                                
4  C  PURPOSE                                                                        #include "DIAG_OPTIONS.h"
5    
6    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    CBOP 0
8    C     !ROUTINE: GETDIAG
9    
10    C     !INTERFACE:
11          SUBROUTINE GETDIAG(
12         I                    levreal, undef,
13         O                    qtmp,
14         I                    ndId, mate, ip, im, bi, bj, myThid )
15    
16    C     !DESCRIPTION:
17  C     Retrieve averaged model diagnostic  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  
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"
25  #include "diagnostics.h"  
26    C     !INPUT PARAMETERS:
27        integer    im,jm,nd  C     levreal :: Diagnostic LEVEL
28        real qdiag(im,jm,nd)  C     undef   :: UNDEFINED VALUE
29    C     ndId    :: DIAGNOSTIC NUMBER FROM MENU
30        integer lev,ipoint  C     mate    :: counter DIAGNOSTIC NUMBER if any ; 0 otherwise
31        integer i,j,ipnt,klev  C     ip      :: pointer to storage array location for diag.
32        real    undef, factor  C     im      :: pointer to storage array location for mate
33        real    qtmp(im,jm)  C     bi      :: X-direction tile number
34    C     bj      :: Y-direction tile number
35        do j = 1,jm  C     myThid  :: my thread Id number
36        do i = 1,im        _RL levreal
37        qtmp(i,j) = undef        _RL undef
38        enddo        INTEGER ndId, mate, ip, im
39        enddo        INTEGER bi,bj, myThid
40    
41        IF (IPOINT.LT.1) GO TO 999  C     !OUTPUT PARAMETERS:
42    C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
43        KLEV = KDIAG(IPOINT)        _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
44        IF(KLEV.GE.LEV) THEN  CEOP
45        IPNT = IDIAG(IPOINT) + LEV - 1  
46                                  FACTOR = 1.0  C     !LOCAL VARIABLES:
47        IF( NDIAG(IPOINT).NE.0 )  FACTOR = 1.0   / NDIAG(IPOINT)        _RL factor
48        do j = 1,jm        INTEGER i, j, ipnt,ipCt
49        do i = 1,im        INTEGER lev, levCt, klev
50        if( qdiag(i,j,ipnt).ne.undef ) qtmp(i,j) = qdiag(i,j,ipnt)*factor  
51        enddo        IF (ndId.GE.1) THEN
52        enddo         lev = NINT(levreal)
53           klev = kdiag(ndId)
54           IF (lev.LE.klev) THEN
55    
56            IF ( mate.EQ.0 ) THEN
57    C-      No counter diagnostics => average = Sum / ndiag :
58    
59              ipnt = ip + lev - 1
60              factor = FLOAT(ndiag(ip,bi,bj))
61              IF (ndiag(ip,bi,bj).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 = ip + lev - 1
77              levCt= MIN(lev,kdiag(mate))
78              ipCt = im + 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        ENDIF
93    
94   999  RETURN        RETURN
95        END        END
96    
97        subroutine getdiag2 (qdiag,lev,ipoint,qtmp,im,jm,nd,undef)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
98  C***********************************************************************          
99  C                                                                                CBOP 0
100  C  PURPOSE                                                                        C     !ROUTINE: DIAGNOSTICS_COUNT
101  C     Retrieve model diagnostic (No Averaging)  C     !INTERFACE:
102  C  INPUT:                                                                              SUBROUTINE DIAGNOSTICS_COUNT (chardiag,
103  C     lev ..... Model LEVEL                                                           I                              biArg, bjArg, myThid)
104  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      
105  C   undef ..... UNDEFINED VALUE                                                  C     !DESCRIPTION:
106  C      im ..... X-DIMENSION  C***********************************************************************
107  C      jm ..... Y-DIMENSION  C   routine to increment the diagnostic counter only
108  C      nd ..... Number of 2-D Diagnostics  C***********************************************************************
109  C                                                                                C     !USES:
110  C  OUTPUT:                                                                              IMPLICIT NONE
 C    qtmp ..... DIAGNOSTIC QUANTITY                                              
 C                                                                                
 C***********************************************************************          
                                                                                   
       implicit none  
111    
112    C     == Global variables ===
113    #include "EEPARAMS.h"
114  #include "SIZE.h"  #include "SIZE.h"
115  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
116  #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  
   
       IF (IPOINT.LT.1) GO TO 999  
   
       KLEV = KDIAG(IPOINT)  
       IF(KLEV.GE.LEV) THEN  
       IPNT = IDIAG(IPOINT) + LEV - 1  
       do j = 1,jm  
       do i = 1,im  
       qtmp(i,j) = qdiag(i,j,ipnt)  
       enddo  
       enddo  
       ENDIF  
117    
118   999  RETURN  C     !INPUT PARAMETERS:
       END  
       subroutine  clrindx ( diag,indxlist )  
119  C***********************************************************************  C***********************************************************************
120  C  C  Arguments Description
121  C  PURPOSE  C  ----------------------
122  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST  C     chardiag :: Character expression for diag to increment the counter
123  C  C     biArg    :: X-direction tile number, or 0 if called outside bi,bj loops
124  C  ARGUMENT DESCRIPTION  C     bjArg    :: Y-direction tile number, or 0 if called outside bi,bj loops
125  C     INDXLIST.. INTEGER DIAGNOSTIC INDEX LIST  C     myThid   :: my thread Id number
 C  
126  C***********************************************************************  C***********************************************************************
127          CHARACTER*8 chardiag
128          INTEGER biArg, bjArg
129          INTEGER myThid
130    CEOP
131    
132    C     !LOCAL VARIABLES:
133    C ===============
134          INTEGER m, n
135          INTEGER bi, bj
136          INTEGER ipt
137    c     CHARACTER*(MAX_LEN_MBUF) msgBuf
138    
139    C--   Run through list of active diagnostics to find which counter
140    C     to increment (needs to be a valid & active diagnostic-counter)
141          DO n=1,nlists
142           DO m=1,nActive(n)
143            IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
144             ipt = idiag(m,n)
145             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
161           ENDDO
162          ENDDO
163    
164        implicit none        RETURN
165          END
166    
167  #include "SIZE.h"  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 #include "fizhi_SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
   
       integer indxlist (ndiagt)  
       integer index, n  
   
       character*8 parms1  
       character*1 parse1(8)  
       character*3 mate_index  
       integer     mate  
   
       equivalence (     parms1 , parse1(1) )  
       equivalence ( mate_index , parse1(6) )  
   
       DO  INDEX=1,NDIAGT  
       N = INDXLIST (index)  
   
       IF( N.NE.0 .AND. IDIAG(N).NE.0 ) THEN  
       call clrdiag (diag,n)  
   
 c Check for Counter Diagnostic  
 c ----------------------------  
       parms1 =  gdiag(n)  
       if( parse1(5).eq.'C' ) then  
        read (mate_index,100) mate  
        call clrdiag (diag,mate)  
       endif  
168    
169        ENDIF          CBOP 0
170    C     !ROUTINE: DIAGS_MK_UNITS
171    
172    C     !INTERFACE:
173          CHARACTER*16 FUNCTION DIAGS_MK_UNITS(
174         I                            diagUnitsInPieces, myThid )
175    
176    C     !DESCRIPTION:
177    C     *==========================================================*
178    C     | FUNCTION DIAGS_MK_UNITS
179    C     | o Return the diagnostic units string (16c) removing
180    C     |   blanks from the input string
181    C     *==========================================================*
182    
183    C     !USES:
184          IMPLICIT NONE
185    #include "EEPARAMS.h"
186    
187    C     !INPUT PARAMETERS:
188    C     diagUnitsInPieces :: string for diagnostic units: in several
189    C                          pieces, with blanks in between
190    C     myThid            ::  my thread Id number
191          CHARACTER*(*) diagUnitsInPieces
192          INTEGER      myThid
193    CEOP
194    
195    C     !LOCAL VARIABLES:
196          CHARACTER*(MAX_LEN_MBUF) msgBuf
197          INTEGER i,j,n
198    
199          DIAGS_MK_UNITS = '          '
200          n = LEN(diagUnitsInPieces)
201    
202          j = 0
203          DO i=1,n
204           IF (diagUnitsInPieces(i:i) .NE. ' ' ) THEN
205             j = j+1
206             IF ( j.LE.16 ) DIAGS_MK_UNITS(j:j) = diagUnitsInPieces(i:i)
207           ENDIF
208        ENDDO        ENDDO
                     
   100 format(i3)  
       RETURN        
       END            
209    
210          IF ( j.GT.16 ) THEN
211             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
212         &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'
213            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
214         &       SQUEEZE_RIGHT , myThid)
215             WRITE(msgBuf,'(3A)') '**WARNING** ',
216         &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces
217            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
218         &       SQUEEZE_RIGHT , myThid)
219          ENDIF
220    
221        subroutine clrdiag (diag,n)        RETURN
222  C***********************************************************************                END
 C                                                                                
 C  PURPOSE                                                                        
 C     INITIALIZE MODEL DIAGNOSTIC QUANTITIES                                      
 C                                                                                
 C***********************************************************************          
                                                                                   
       implicit none  
 #include "SIZE.h"  
 #include "fizhi_SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
   
       integer n  
       integer i,j,k  
   
 C **********************************************************************          
 C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****          
 C **********************************************************************          
                                                                                   
       IF( IDIAG(N).NE.0 ) THEN                                                    
   
         do k=1,kdiag(n)  
         do j=1,sNx  
         do i=1,sNy  
         qdiag(i,j,idiag(n)+k-1) = 0.0  
         enddo  
         enddo  
         enddo  
   
       NDIAG(N) = 0                                                            
       ENDIF                                                                      
                                                                                   
       RETURN                                                                      
       END                                                                        
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22