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