/[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.14 by molod, Mon Jul 26 21:16:18 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 (myThid,levreal,ipoint,undef,qtmp)
12    
13    C     !DESCRIPTION:
14  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
15  C  INPUT:                                                                              
16  C     lev ..... Model LEVEL                                                      C     !USES:
 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***********************************************************************          
17        implicit none        implicit none
18    #include "EEPARAMS.h"
19    #include "CPP_OPTIONS.h"
20  #include "SIZE.h"  #include "SIZE.h"
21    CEOP
22    
23    #ifdef ALLOW_FIZHI
24  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
25    #else
26          integer Nrphys
27          parameter (Nrphys=0)
28    #endif
29    
30  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
31  #include "diagnostics.h"  #include "diagnostics.h"
32    
33        integer    im,jm,nd  C     INPUT:
34        real qdiag(im,jm,nd)  C     lev    ..... Diagnostic LEVEL
35    C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                    
36    C     undef  ..... UNDEFINED VALUE                                                
37    C     bi     ..... X-direction process(or) number
38    C     bj     ..... Y-direction process(or) number
39          integer myThid,ipoint
40          _RL undef
41          
42    C     OUTPUT:
43    C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
44          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
45          _RL levreal
46    
47        integer lev,ipoint        _RL factor
48        integer i,j,ipnt,klev        integer i,j,ipnt,klev
49        real    undef, factor        integer bi,bj
50        real    qtmp(im,jm)        integer lev
51    
52        do j = 1,jm        lev = levreal
53        do i = 1,im        if (ipoint.lt.1) go to 999
       qtmp(i,j) = undef  
       enddo  
       enddo  
54    
55        IF (IPOINT.LT.1) GO TO 999        klev = kdiag(ipoint)
56          if (klev.ge.lev) then
57            ipnt = idiag(ipoint) + lev - 1
58            factor = 1.0
59            if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
60    
61            do bj=myByLo(myThid), myByHi(myThid)
62              do bi=myBxLo(myThid), myBxHi(myThid)
63                
64                do j = 1,sNy
65                  do i = 1,sNx
66                    if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
67                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
68                    else
69                      qtmp(i,j,lev,bi,bj) = undef
70                    endif
71                  enddo
72                enddo
73                
74              enddo
75            enddo
76            
77          endif
78    
79        KLEV = KDIAG(IPOINT)   999  return
80        IF(KLEV.GE.LEV) THEN        end
       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  
81    
82   999  RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83        END  CBOP 0
84    C     !ROUTINE: GETDIAG2
85    
86    C     !INTERFACE:
87          SUBROUTINE GETDIAG2 (myThid,lev,ipoint,undef,qtmp)
88    
89        subroutine getdiag2 (qdiag,lev,ipoint,qtmp,im,jm,nd,undef)  C     !DESCRIPTION:
90  C***********************************************************************          C***********************************************************************        
 C                                                                                
91  C  PURPOSE                                                                        C  PURPOSE                                                                      
92  C     Retrieve model diagnostic (No Averaging)  C     Retrieve averaged model diagnostic
93  C  INPUT:                                                                        C  INPUT:                                                                      
94  C     lev ..... Model LEVEL                                                      C     lev ..... Diagnostic LEVEL
95  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                    
96  C   undef ..... UNDEFINED VALUE                                                  C   undef ..... UNDEFINED VALUE                                                
 C      im ..... X-DIMENSION  
 C      jm ..... Y-DIMENSION  
 C      nd ..... Number of 2-D Diagnostics  
97  C                                                                                C                                                                              
98  C  OUTPUT:                                                                        C  OUTPUT:                                                                      
99  C    qtmp ..... DIAGNOSTIC QUANTITY                                              C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
100  C                                                                                C                                                                              
101  C***********************************************************************          C***********************************************************************        
102                                                                                          
103    C     !USES:
104        implicit none        implicit none
105    #include "EEPARAMS.h"
106    #include "CPP_OPTIONS.h"
107  #include "SIZE.h"  #include "SIZE.h"
108    CEOP
109    
110    #ifdef ALLOW_FIZHI
111  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
112    #else
113           integer Nrphys
114           parameter (Nrphys=0)
115    #endif
116    
117  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
118  #include "diagnostics.h"  #include "diagnostics.h"
119    
120        integer    im,jm,nd        integer myThid,lev,ipoint
121        real qdiag(im,jm,nd)        _RL undef
122          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
123    
       integer lev,ipoint  
124        integer i,j,ipnt,klev        integer i,j,ipnt,klev
125        real    undef, factor        integer bi,bj
       real    qtmp(im,jm)  
126    
127        do j = 1,jm        if (ipoint.lt.1) go to 999
       do i = 1,im  
       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              enddo
147            enddo
148            
149          endif
150    
151        KLEV = KDIAG(IPOINT)   999  return
152        IF(KLEV.GE.LEV) THEN        end
       IPNT = IDIAG(IPOINT) + LEV - 1  
       do j = 1,jm  
       do i = 1,im  
       qtmp(i,j) = qdiag(i,j,ipnt)  
       enddo  
       enddo  
       ENDIF  
153    
154   999  RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
155        END  
156        subroutine  clrindx ( diag,indxlist )        subroutine clrindx (myThid,listnum)
157  C***********************************************************************  C***********************************************************************
158  C  C
159  C  PURPOSE  C  PURPOSE
160  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST  C     DRIVER TO CLEAR DIAGNOSTICS SPECIFIED IN DIAGNOSTIC INDEX LIST
161  C  C
162  C  ARGUMENT DESCRIPTION  C  ARGUMENT DESCRIPTION
163  C     INDXLIST.. INTEGER DIAGNOSTIC INDEX LIST  C     listnum ....  diagnostics list number
164  C  C
165  C***********************************************************************  C***********************************************************************
166    
167        implicit none        implicit none
168    #include "EEPARAMS.h"
169    #include "CPP_OPTIONS.h"
170  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
171  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
172  #include "diagnostics.h"  #include "diagnostics.h"
173    
174        integer indxlist (ndiagt)        integer myThid, listnum
175        integer index, n  
176          integer m, n
177        character*8 parms1        character*8 parms1
178        character*1 parse1(8)        character*1 parse1(8)
179        character*3 mate_index        character*3 mate_index
180        integer     mate        integer mate
181    
182        equivalence (     parms1 , parse1(1) )        equivalence (     parms1 , parse1(1) )
183        equivalence ( mate_index , parse1(6) )        equivalence ( mate_index , parse1(6) )
184    
185        DO  INDEX=1,NDIAGT        do n=1,nfields(listnum)
186        N = INDXLIST (index)         do m=1,ndiagt
187            if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then
188        IF( N.NE.0 .AND. IDIAG(N).NE.0 ) THEN           call clrdiag (myThid,m)
       call clrdiag (diag,n)  
189    
190  c Check for Counter Diagnostic  c Check for Counter Diagnostic
191  c ----------------------------  c ----------------------------
192        parms1 =  gdiag(n)           parms1 =  gdiag(m)
193        if( parse1(5).eq.'C' ) then           if( parse1(5).eq.'C' ) then
194         read (mate_index,100) mate            read (mate_index,100) mate
195         call clrdiag (diag,mate)            call clrdiag (myThid,mate)
196        endif           endif
197            endif
198        ENDIF                 enddo
199        ENDDO        enddo
200                                        
201    100 format(i3)    100 format(i3)
202        RETURN              RETURN      
203        END                  END          
204    
205    
206        subroutine clrdiag (diag,n)        subroutine clrdiag (myThid,index)
207  C***********************************************************************          C***********************************************************************        
 C                                                                                
208  C  PURPOSE                                                                        C  PURPOSE                                                                      
209  C     INITIALIZE MODEL DIAGNOSTIC QUANTITIES                                      C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS
 C                                                                                
210  C***********************************************************************          C***********************************************************************        
211                                                                                                                                                                    
212        implicit none        implicit none
213    #include "EEPARAMS.h"
214    #include "CPP_OPTIONS.h"
215  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
216  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
217  #include "diagnostics.h"  #include "diagnostics.h"
218    
219        integer n        integer myThid, index
220    
221          integer bi,bj
222        integer i,j,k        integer i,j,k
223    
224  C **********************************************************************          C **********************************************************************        
225  C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****          C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****        
226  C **********************************************************************          C **********************************************************************        
227                                                                                                                                                                    
228        IF( IDIAG(N).NE.0 ) THEN                                                          do bj=myByLo(myThid), myByHi(myThid)
229          do bi=myBxLo(myThid), myBxHi(myThid)
230          do k=1,kdiag(n)         do k = 1,kdiag(index)
231          do j=1,sNx          do j = 1,sNy
232          do i=1,sNy          do i = 1,sNx
233          qdiag(i,j,idiag(n)+k-1) = 0.0           qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0
         enddo  
234          enddo          enddo
235          enddo          enddo
236           enddo
237          enddo
238          enddo
239    
240        NDIAG(N) = 0                                                                  ndiag(index) = 0
241        ENDIF                                                                      
242                                                                                          return
243        RETURN                                                                            end
244        END                                                                        
245          subroutine setdiag (myThid,num,ndiagmx)
246    C***********************************************************************
247    C
248    C  PURPOSE
249    C     SET POINTER LOCATIONS, NAMES, LEVELS and TITLES FOR DIAGNOSTIC NUM
250    C
251    C***********************************************************************
252    
253          implicit none
254    #include "CPP_OPTIONS.h"
255    #include "SIZE.h"
256    #include "diagnostics_SIZE.h"
257    #include "diagnostics.h"
258    
259          integer num,myThid,ndiagmx
260          integer ipointer
261    
262          DATA IPOINTER / 1 /
263    
264          character*8 parms1
265          character*1 parse1(8)
266          character*3 mate_index
267          integer     mate
268    
269          equivalence (     parms1 , parse1(1) )
270          equivalence ( mate_index , parse1(6) )
271    
272    C **********************************************************************
273    C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****
274    C **********************************************************************
275    
276          parms1 = gdiag(num)
277    
278          IF( IDIAG(NUM).EQ.0 ) THEN
279            if(ndiagmx+kdiag(num).gt.numdiags) then
280              write(6,4000)num,cdiag(num)
281            else
282              IDIAG(NUM) = IPOINTER
283              IPOINTER   = IPOINTER + KDIAG(NUM)
284              ndiagmx    = ndiagmx  + KDIAG(NUM)
285              if(myThid.eq.1) WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx
286            endif
287          ELSE
288              if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
289          ENDIF
290    
291    c Check for Counter Diagnostic
292    c ----------------------------
293          if( parse1(5).eq.'C') then
294          read (mate_index,100) mate
295    
296          IF( IDIAG(mate).EQ.0 ) THEN
297           if(ndiagmx+kdiag(num).gt.numdiags) then
298            write(6,5000)num,cdiag(num)
299           else
300            IDIAG(mate) = IPOINTER
301            IPOINTER    = IPOINTER + KDIAG(mate)
302            ndiagmx     = ndiagmx  + KDIAG(mate)
303            if(myThid.eq.1)WRITE(6,2000)KDIAG(mate),mate,CDIAG(mate),ndiagmx
304           endif
305          ELSE
306              if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
307          ENDIF
308          endif
309    
310          RETURN
311    
312      100 format(i3)
313     2000 FORMAT(1X,'Allocating ',I2,' Level(s) for Diagnostic # ',I3,
314         .          ' (',A8,'),  Total Number of Diagnostics: ',I5)
315     3000 FORMAT(1X,'Diagnostic # ',I3,' (',A8,') has already been set')
316     4000 FORMAT(1X,'Unable to allocate space for Diagnostic # ',I3,
317         .                      ' (',A8,')')
318     5000 FORMAT(1X,'Unable to allocate space for Counter Diagnostic # ',
319         .    I3,' (',A8,')',' WARNING - Diag will not accumulate properly')
320          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22