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