/[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.16 by jmc, Mon Dec 20 01:53:54 2004 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 (levreal,ipoint,undef,qtmp,myThid)
12    
13    C     !DESCRIPTION:
14  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  
15    
16    C     !USES:
17          implicit none
18    #include "EEPARAMS.h"
19  #include "SIZE.h"  #include "SIZE.h"
20  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
21  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
22  #include "diagnostics.h"  CEOP
23    
24        integer    im,jm,nd  #ifdef ALLOW_FIZHI
25        real qdiag(im,jm,nd)  #include "fizhi_SIZE.h"
26    #else
27          integer Nrphys
28          parameter (Nrphys=0)
29    #endif
30    
31    C     INPUT:
32    C     levreal .... Diagnostic LEVEL
33    C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU
34    C     undef  ..... UNDEFINED VALUE
35    C     bi     ..... X-direction process(or) number
36    C     bj     ..... Y-direction process(or) number
37          _RL levreal
38          integer myThid,ipoint
39          _RL undef
40    
41    C     OUTPUT:
42    C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
43          _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
44    
45        integer lev,ipoint        _RL factor
46        integer i,j,ipnt,klev        integer i,j,ipnt,klev
47        real    undef, factor        integer bi,bj
48        real    qtmp(im,jm)        integer lev
49    
50        do j = 1,jm        if (ipoint.ge.1) then
51        do i = 1,im         lev = NINT(levreal)
       qtmp(i,j) = undef  
       enddo  
       enddo  
52    
53        IF (IPOINT.LT.1) GO TO 999         klev = kdiag(ipoint)
54           if (klev.ge.lev) then
55            ipnt = idiag(ipoint) + lev - 1
56            factor = 1.0
57            if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
58    
59            do bj=myByLo(myThid), myByHi(myThid)
60              do bi=myBxLo(myThid), myBxHi(myThid)
61    
62                do j = 1,sNy
63                  do i = 1,sNx
64                    if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
65                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
66                    else
67                      qtmp(i,j,lev,bi,bj) = undef
68                    endif
69                  enddo
70                enddo
71    
72        KLEV = KDIAG(IPOINT)            enddo
73        IF(KLEV.GE.LEV) THEN          enddo
       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  
74    
75   999  RETURN         endif
76          endif
77    
78          RETURN
79        END        END
80    
81        subroutine getdiag2 (qdiag,lev,ipoint,qtmp,im,jm,nd,undef)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
82  C***********************************************************************          CBOP 0
83  C                                                                                C     !ROUTINE: GETDIAG2
84  C  PURPOSE                                                                        
85  C     Retrieve model diagnostic (No Averaging)  C     !INTERFACE:
86  C  INPUT:                                                                              SUBROUTINE GETDIAG2 (levreal,ipoint,undef,qtmp,myThid)
 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  
87    
88    C     !DESCRIPTION:
89    C***********************************************************************
90    C  PURPOSE
91    C     Retrieve averaged model diagnostic
92    C  INPUT:
93    C  levreal .... Diagnostic LEVEL
94    C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU
95    C   undef ..... UNDEFINED VALUE
96    C
97    C  OUTPUT:
98    C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
99    C
100    C***********************************************************************
101    
102    C     !USES:
103          implicit none
104    #include "EEPARAMS.h"
105  #include "SIZE.h"  #include "SIZE.h"
106  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
107  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
108  #include "diagnostics.h"  CEOP
109    
110        integer    im,jm,nd  #ifdef ALLOW_FIZHI
111        real qdiag(im,jm,nd)  #include "fizhi_SIZE.h"
112    #else
113           integer Nrphys
114           parameter (Nrphys=0)
115    #endif
116    
117          _RL levreal
118          integer myThid,ipoint
119          _RL undef
120          _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
121    
       integer lev,ipoint  
122        integer i,j,ipnt,klev        integer i,j,ipnt,klev
123        real    undef, factor        integer bi,bj
124        real    qtmp(im,jm)        integer lev
125    
126        do j = 1,jm        if (ipoint.ge.1) then
127        do i = 1,im         lev = NINT(levreal)
       qtmp(i,j) = undef  
       enddo  
       enddo  
128    
129        IF (IPOINT.LT.1) GO TO 999         klev = kdiag(ipoint)
130           if (klev.ge.lev) then
131            ipnt = idiag(ipoint) + lev - 1
132    
133            do bj=myByLo(myThid), myByHi(myThid)
134              do bi=myBxLo(myThid), myBxHi(myThid)
135    
136                do j = 1,sNy
137                  do i = 1,sNx
138                    if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
139                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)
140                    else
141                      qtmp(i,j,lev,bi,bj) = undef
142                    endif
143                  enddo
144                enddo
145    
146        KLEV = KDIAG(IPOINT)            enddo
147        IF(KLEV.GE.LEV) THEN          enddo
       IPNT = IDIAG(IPOINT) + LEV - 1  
       do j = 1,jm  
       do i = 1,im  
       qtmp(i,j) = qdiag(i,j,ipnt)  
       enddo  
       enddo  
       ENDIF  
148    
149   999  RETURN         endif
150          endif
151    
152          RETURN
153        END        END
154        subroutine  clrindx ( diag,indxlist )  
155    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
156    
157          subroutine clrindx (listnum, myThid)
158  C***********************************************************************  C***********************************************************************
159  C  C
160  C  PURPOSE  C  PURPOSE
161  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST
162  C  C
163  C  ARGUMENT DESCRIPTION  C  ARGUMENT DESCRIPTION
164  C     INDXLIST.. INTEGER DIAGNOSTIC INDEX LIST  C     listnum ....  diagnostics list number
165  C  C
166  C***********************************************************************  C***********************************************************************
167    
168        implicit none        implicit none
169    #include "EEPARAMS.h"
170  #include "SIZE.h"  #include "SIZE.h"
171  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
172  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
173  #include "diagnostics.h"  
174          integer myThid, listnum
175    
176        integer indxlist (ndiagt)        integer m, n
       integer index, n  
   
177        character*8 parms1        character*8 parms1
       character*1 parse1(8)  
178        character*3 mate_index        character*3 mate_index
179        integer     mate        integer mate
   
       equivalence (     parms1 , parse1(1) )  
       equivalence ( mate_index , parse1(6) )  
   
       DO  INDEX=1,NDIAGT  
       N = INDXLIST (index)  
180    
181        IF( N.NE.0 .AND. IDIAG(N).NE.0 ) THEN        do n=1,nfields(listnum)
182        call clrdiag (diag,n)         do m=1,ndiagt
183            if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then
184             call clrdiag (m, myThid)
185    
186  c Check for Counter Diagnostic  c Check for Counter Diagnostic
187  c ----------------------------  c ----------------------------
188        parms1 =  gdiag(n)           parms1 =  gdiag(m)(1:8)
189        if( parse1(5).eq.'C' ) then           if ( parms1(5:5).eq.'C' ) then
190         read (mate_index,100) mate            mate_index = parms1(6:8)
191         call clrdiag (diag,mate)            read (mate_index,'(I3)') mate
192        endif            call clrdiag (mate, myThid)
193             endif
194            endif
195           enddo
196          enddo
197    
198        ENDIF                RETURN
199        ENDDO        END
                     
   100 format(i3)  
       RETURN        
       END            
200    
201    
202        subroutine clrdiag (diag,n)        subroutine clrdiag (index, myThid)
203  C***********************************************************************          C***********************************************************************
204  C                                                                                C  PURPOSE
205  C  PURPOSE                                                                        C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS
206  C     INITIALIZE MODEL DIAGNOSTIC QUANTITIES                                      C***********************************************************************
207  C                                                                                
 C***********************************************************************          
                                                                                   
208        implicit none        implicit none
209    #include "EEPARAMS.h"
210  #include "SIZE.h"  #include "SIZE.h"
211  #include "fizhi_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
212  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS.h"
213  #include "diagnostics.h"  
214          integer myThid, index
215    
216        integer n        integer bi,bj
217        integer i,j,k        integer i,j,k
218    
219  C **********************************************************************          C **********************************************************************
220  C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****          C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****
221  C **********************************************************************          C **********************************************************************
222                                                                                    
223        IF( IDIAG(N).NE.0 ) THEN                                                          do bj=myByLo(myThid), myByHi(myThid)
224           do bi=myBxLo(myThid), myBxHi(myThid)
225          do k=1,kdiag(n)          do k = 1,kdiag(index)
226          do j=1,sNx           do j = 1-OLy,sNy+OLy
227          do i=1,sNy            do i = 1-OLx,sNx+OLx
228          qdiag(i,j,idiag(n)+k-1) = 0.0             qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0
229          enddo            enddo
230          enddo           enddo
231          enddo          enddo
232           enddo
233          enddo
234    
235          ndiag(index) = 0
236    
237          RETURN
238          END
239    
240        NDIAG(N) = 0                                                            C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
241        ENDIF                                                                      
242                                                                                    CBOP 0
243        RETURN                                                                      C     !ROUTINE: DIAGNOSTICS_IS_ON
244        END                                                                        
245    C     !INTERFACE:
246          LOGICAL FUNCTION DIAGNOSTICS_IS_ON( diagName, myThid )
247    
248    C     !DESCRIPTION:
249    C     *==========================================================*
250    C     | FUNCTION DIAGNOSTIC_IS_ON
251    C     | o Return TRUE if diagnostics "diagName" is Active
252    C     *==========================================================*
253    
254    C     !USES:
255          IMPLICIT NONE
256    #include "EEPARAMS.h"
257    #include "SIZE.h"
258    #include "DIAGNOSTICS_SIZE.h"
259    #include "DIAGNOSTICS.h"
260    
261    C     !INPUT PARAMETERS:
262    C     diagName   ::  diagnostic identificator name (8 characters long)
263    C     myThid     ::  my thread Id number
264          CHARACTER*8  diagName
265          INTEGER      myThid
266    CEOP
267    
268    C     !LOCAL VARIABLES:
269          INTEGER j,n,m
270    
271          DIAGNOSTICS_IS_ON = .FALSE.
272          DO n=1,nlists
273           DO m=1,nActive(n)
274            IF ( diagName.EQ.flds(m,n) ) THEN
275              j = jdiag(m,n)    
276              IF ( idiag(j).NE.0 .AND. ndiag(j).GE.0 )
277         &         DIAGNOSTICS_IS_ON = .TRUE.
278            ENDIF
279           ENDDO
280          ENDDO
281    
282          RETURN
283          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22