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