/[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.10 by edhill, Wed Jul 7 03:47:05 2004 UTC revision 1.12 by edhill, Thu Jul 8 00:30:45 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5    
6        subroutine getdiag (myThid,lev,ipoint,undef,qtmp)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7  C***********************************************************************          CBOP 0
8  C  PURPOSE                                                                        C     !ROUTINE: GETDIAG
9  C     Retrieve averaged model diagnostic  
10  C  INPUT:                                                                        C     !INTERFACE:
11  C     lev ..... Diagnostic LEVEL        SUBROUTINE GETDIAG (myThid,lev,ipoint,undef,qtmp)
12  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      
13  C   undef ..... UNDEFINED VALUE                                                  C     !DESCRIPTION:
14  C      bi ..... X-direction process(or) number        Retrieve averaged model diagnostic
15  C      bj ..... Y-direction process(or) number        
16  C                                                                                C     !USES:
 C  OUTPUT:                                                                        
 C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  
 C                                                                                
 C***********************************************************************          
17        implicit none        implicit none
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
19  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
20  #include "SIZE.h"  #include "SIZE.h"
21    CEOP
22    
23  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
24  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
# Line 32  C*************************************** Line 29  C***************************************
29    
30  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
31  #include "diagnostics.h"  #include "diagnostics.h"
32          
33    C     INPUT:
34    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,lev,ipoint        integer myThid,lev,ipoint
40        _RL undef        _RL undef
       _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)  
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    
46        _RL factor        _RL factor
47        integer i,j,ipnt,klev        integer i,j,ipnt,klev
48        integer bi,bj        integer bi,bj
49          
50        if (ipoint.lt.1) go to 999        if (ipoint.lt.1) go to 999
51          
52        klev = kdiag(ipoint)        klev = kdiag(ipoint)
53        if(klev.ge.lev) then        if (klev.ge.lev) then
54          ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
55          factor = 1.0          factor = 1.0
56          if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)          if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
57    
58          do bj=myByLo(myThid), myByHi(myThid)          do bj=myByLo(myThid), myByHi(myThid)
59            do bi=myBxLo(myThid), myBxHi(myThid)            do bi=myBxLo(myThid), myBxHi(myThid)
60                            
61              do j = 1,sNy              do j = 1,sNy
62                do i = 1,sNx                do i = 1,sNx
63                  if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
64                    qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor                    qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
65                  else                  else
66                    qtmp(i,j,lev,bi,bj) = undef                    qtmp(i,j,lev,bi,bj) = undef
# Line 64  C*************************************** Line 70  C***************************************
70                            
71            enddo            enddo
72          enddo          enddo
73            
74        endif        endif
75    
76   999  return   999  return
77        end        end
78    
79        subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
80    CBOP 0
81    C     !ROUTINE: GETDIAG2
82    
83    C     !INTERFACE:
84          SUBROUTINE GETDIAG2 (myThid,lev,ipoint,undef,qtmp)
85    
86    C     !DESCRIPTION:
87  C***********************************************************************          C***********************************************************************        
88  C  PURPOSE                                                                        C  PURPOSE                                                                      
89  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 83  C  OUTPUT: Line 96  C  OUTPUT:
96  C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
97  C                                                                                C                                                                              
98  C***********************************************************************          C***********************************************************************        
99          
100    C     !USES:
101        implicit none        implicit none
   
102  #include "EEPARAMS.h"  #include "EEPARAMS.h"
103  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
104  #include "SIZE.h"  #include "SIZE.h"
105    CEOP
106    
107  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
108  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
# Line 107  C*************************************** Line 122  C***************************************
122        integer bi,bj        integer bi,bj
123    
124        if (ipoint.lt.1) go to 999        if (ipoint.lt.1) go to 999
125          
126        klev = kdiag(ipoint)        klev = kdiag(ipoint)
127        if (klev .ge. lev) then        if (klev.ge.lev) then
128          ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
129                    
130          do bj=myByLo(myThid), myByHi(myThid)          do bj=myByLo(myThid), myByHi(myThid)
# Line 117  C*************************************** Line 132  C***************************************
132                            
133              do j = 1,sNy              do j = 1,sNy
134                do i = 1,sNx                do i = 1,sNx
135                  qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
136                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)
137                    else
138                      qtmp(i,j,lev,bi,bj) = undef
139                    endif
140                enddo                enddo
141              enddo              enddo
142                            
# Line 129  C*************************************** Line 148  C***************************************
148   999  return   999  return
149        end        end
150    
151    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
152    
153        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
154  C***********************************************************************  C***********************************************************************
# Line 159  C*************************************** Line 179  C***************************************
179        equivalence (     parms1 , parse1(1) )        equivalence (     parms1 , parse1(1) )
180        equivalence ( mate_index , parse1(6) )        equivalence ( mate_index , parse1(6) )
181    
182        do n = 1,nfields(listnum)        do n=1,nfields(listnum)
183          do m = 1,ndiagt         do m=1,ndiagt
184            if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then          if( flds(n,listnum).eq.cdiag(m) .and. idiag(m).ne.0 ) then
185              call clrdiag (myThid,m)           call clrdiag (myThid,m)
186    
187  C           Check for Counter Diagnostic  c Check for Counter Diagnostic
188              parms1 =  gdiag(m)  c ----------------------------
189              if ( parse1(5).eq.'C' ) then           parms1 =  gdiag(m)
190                read (mate_index,100) mate           if( parse1(5).eq.'C' ) then
191                call clrdiag (myThid,mate)            read (mate_index,100) mate
192              endif            call clrdiag (myThid,mate)
193            endif           endif
194          enddo          endif
195           enddo
196        enddo        enddo
197                                        
198    100 format(i3)    100 format(i3)
# Line 202  C ****              SET DIAGNOSTIC AND C Line 223  C ****              SET DIAGNOSTIC AND C
223  C **********************************************************************          C **********************************************************************        
224                                                                                                                                                                    
225        do bj=myByLo(myThid), myByHi(myThid)        do bj=myByLo(myThid), myByHi(myThid)
226          do bi=myBxLo(myThid), myBxHi(myThid)        do bi=myBxLo(myThid), myBxHi(myThid)
227            do k = 1,kdiag(index)         do k = 1,kdiag(index)
228              do j = 1,sNy          do j = 1,sNy
229                do i = 1,sNx          do i = 1,sNx
230                  qdiag(i,j,idiag(index)+k-1,bi,bj) = 0. _d 0           qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0
231                enddo          enddo
             enddo  
           enddo  
232          enddo          enddo
233           enddo
234        enddo        enddo
235                enddo
236    
237        ndiag(index) = 0        ndiag(index) = 0
238    
239        return        return
# Line 258  C ************************************** Line 279  C **************************************
279            IDIAG(NUM) = IPOINTER            IDIAG(NUM) = IPOINTER
280            IPOINTER   = IPOINTER + KDIAG(NUM)            IPOINTER   = IPOINTER + KDIAG(NUM)
281            ndiagmx    = ndiagmx  + KDIAG(NUM)            ndiagmx    = ndiagmx  + KDIAG(NUM)
282            if (myThid.eq.1)            if(myThid.eq.1) WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx
      &         WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx  
283          endif          endif
284        ELSE        ELSE
285            if (myThid.eq.1)            if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
      &       WRITE(6,3000) NUM, CDIAG(NUM)  
286        ENDIF        ENDIF
287    
288  C     Check for Counter Diagnostic  c Check for Counter Diagnostic
289        if ( parse1(5).eq.'C') then  c ----------------------------
290          read (mate_index,100) mate        if( parse1(5).eq.'C') then
291          read (mate_index,100) mate
292          IF( IDIAG(mate).EQ.0 ) THEN  
293            if(ndiagmx+kdiag(num).gt.numdiags) then        IF( IDIAG(mate).EQ.0 ) THEN
294              write(6,5000)num,cdiag(num)         if(ndiagmx+kdiag(num).gt.numdiags) then
295            else          write(6,5000)num,cdiag(num)
296              IDIAG(mate) = IPOINTER         else
297              IPOINTER    = IPOINTER + KDIAG(mate)          IDIAG(mate) = IPOINTER
298              ndiagmx     = ndiagmx  + KDIAG(mate)          IPOINTER    = IPOINTER + KDIAG(mate)
299              if (myThid.eq.1)          ndiagmx     = ndiagmx  + KDIAG(mate)
300       &           WRITE(6,2000)KDIAG(mate),mate,CDIAG(mate),ndiagmx          if(myThid.eq.1)WRITE(6,2000)KDIAG(mate),mate,CDIAG(mate),ndiagmx
301            endif         endif
302          ELSE        ELSE
303            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
304          ENDIF        ENDIF
305        endif        endif
306    
307        RETURN        RETURN
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22