/[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.11 by molod, Wed Jul 7 15:58:17 2004 UTC revision 1.16 by jmc, Mon Dec 20 01:53:54 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    
10    C     !INTERFACE:
11          SUBROUTINE GETDIAG (levreal,ipoint,undef,qtmp,myThid)
12    
13    C     !DESCRIPTION:
14  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
15  C  INPUT:                                                                        
16  C     lev ..... Diagnostic LEVEL  C     !USES:
 C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      
 C   undef ..... UNDEFINED VALUE                                                  
 C      bi ..... X-direction process(or) number  
 C      bj ..... Y-direction process(or) number  
 C                                                                                
 C  OUTPUT:                                                                        
 C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  
 C                                                                                
 C***********************************************************************          
17        implicit none        implicit none
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CPP_OPTIONS.h"  
19  #include "SIZE.h"  #include "SIZE.h"
20    #include "DIAGNOSTICS_SIZE.h"
21    #include "DIAGNOSTICS.h"
22    CEOP
23    
24  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
25  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
26  #else  #else
27         integer Nrphys        integer Nrphys
28         parameter (Nrphys=0)        parameter (Nrphys=0)
29  #endif  #endif
30    
31  #include "diagnostics_SIZE.h"  C     INPUT:
32  #include "diagnostics.h"  C     levreal .... Diagnostic LEVEL
33    C     ipoint ..... DIAGNOSTIC NUMBER FROM MENU
34        integer myThid,lev,ipoint  C     undef  ..... UNDEFINED VALUE
35    C     bi     ..... X-direction process(or) number
36    C     bj     ..... Y-direction process(or) number
37          _RL levreal
38          integer myThid,ipoint
39        _RL undef        _RL undef
40        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)  
41    C     OUTPUT:
42    C     qtmp    ..... AVERAGED DIAGNOSTIC QUANTITY
43          _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
44    
45        _RL factor        _RL factor
46        integer i,j,ipnt,klev        integer i,j,ipnt,klev
47        integer bi,bj        integer bi,bj
48          integer lev
49    
50        if (ipoint.lt.1) go to 999        if (ipoint.ge.1) then
51           lev = NINT(levreal)
52    
53        klev = kdiag(ipoint)         klev = kdiag(ipoint)
54        if(klev.ge.lev) then         if (klev.ge.lev) then
55        ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
56        factor = 1.0          factor = 1.0
57        if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)          if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
58    
59            do bj=myByLo(myThid), myByHi(myThid)
60              do bi=myBxLo(myThid), myBxHi(myThid)
61    
62                do j = 1,sNy
63                  do i = 1,sNx
64                    if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
65                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
66                    else
67                      qtmp(i,j,lev,bi,bj) = undef
68                    endif
69                  enddo
70                enddo
71    
72        do bj=myByLo(myThid), myByHi(myThid)            enddo
73        do bi=myBxLo(myThid), myBxHi(myThid)          enddo
74    
       do j = 1,sNy  
       do i = 1,sNx  
        if( qdiag(i,j,ipnt,bi,bj).ge.undef ) then  
         qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor  
        else  
         qtmp(i,j,lev,bi,bj) = undef  
75         endif         endif
76        enddo        endif
       enddo  
77    
78        enddo        RETURN
79        enddo        END
80    
81        endif  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
82    CBOP 0
83    C     !ROUTINE: GETDIAG2
84    
85   999  return  C     !INTERFACE:
86        end        SUBROUTINE GETDIAG2 (levreal,ipoint,undef,qtmp,myThid)
87    
88        subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp)  C     !DESCRIPTION:
89  C***********************************************************************          C***********************************************************************
90  C  PURPOSE                                                                        C  PURPOSE
91  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
92  C  INPUT:                                                                        C  INPUT:
93  C     lev ..... Diagnostic LEVEL  C  levreal .... Diagnostic LEVEL
94  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU
95  C   undef ..... UNDEFINED VALUE                                                  C   undef ..... UNDEFINED VALUE
96  C                                                                                C
97  C  OUTPUT:                                                                        C  OUTPUT:
98  C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
99  C                                                                                C
100  C***********************************************************************          C***********************************************************************
       implicit none  
101    
102    C     !USES:
103          implicit none
104  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CPP_OPTIONS.h"  
105  #include "SIZE.h"  #include "SIZE.h"
106    #include "DIAGNOSTICS_SIZE.h"
107    #include "DIAGNOSTICS.h"
108    CEOP
109    
110  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
111  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
# Line 96  C*************************************** Line 114  C***************************************
114         parameter (Nrphys=0)         parameter (Nrphys=0)
115  #endif  #endif
116    
117  #include "diagnostics_SIZE.h"        _RL levreal
118  #include "diagnostics.h"        integer myThid,ipoint
   
       integer myThid,lev,ipoint  
119        _RL undef        _RL undef
120        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)        _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+Nrphys,nSx,nSy)
121    
122        integer i,j,ipnt,klev        integer i,j,ipnt,klev
123        integer bi,bj        integer bi,bj
124          integer lev
125    
126        if (ipoint.lt.1) go to 999        if (ipoint.ge.1) then
127           lev = NINT(levreal)
128    
129        klev = kdiag(ipoint)         klev = kdiag(ipoint)
130        if(klev.ge.lev) then         if (klev.ge.lev) then
131        ipnt = idiag(ipoint) + lev - 1          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        do bj=myByLo(myThid), myByHi(myThid)            enddo
147        do bi=myBxLo(myThid), myBxHi(myThid)          enddo
148    
       do j = 1,sNy  
       do i = 1,sNx  
        if( qdiag(i,j,ipnt,bi,bj).ge.undef ) then  
         qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)  
        else  
         qtmp(i,j,lev,bi,bj) = undef  
149         endif         endif
150        enddo        endif
       enddo  
151    
152        enddo        RETURN
153        enddo        END
154    
155        endif  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
156    
157   999  return        subroutine clrindx (listnum, myThid)
       end  
       subroutine clrindx (myThid,listnum)  
158  C***********************************************************************  C***********************************************************************
159  C  C
160  C  PURPOSE  C  PURPOSE
# Line 145  C*************************************** Line 167  C***************************************
167    
168        implicit none        implicit none
169  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CPP_OPTIONS.h"  
170  #include "SIZE.h"  #include "SIZE.h"
171  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
172  #include "diagnostics.h"  #include "DIAGNOSTICS.h"
173    
174        integer myThid, listnum        integer myThid, listnum
175    
176        integer m, n        integer m, n
177        character*8 parms1        character*8 parms1
       character*1 parse1(8)  
178        character*3 mate_index        character*3 mate_index
179        integer mate        integer mate
180    
       equivalence (     parms1 , parse1(1) )  
       equivalence ( mate_index , parse1(6) )  
   
181        do n=1,nfields(listnum)        do n=1,nfields(listnum)
182         do m=1,ndiagt         do m=1,ndiagt
183          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
184           call clrdiag (myThid,m)           call clrdiag (m, myThid)
185    
186  c Check for Counter Diagnostic  c Check for Counter Diagnostic
187  c ----------------------------  c ----------------------------
188           parms1 =  gdiag(m)           parms1 =  gdiag(m)(1:8)
189           if( parse1(5).eq.'C' ) then           if ( parms1(5:5).eq.'C' ) then
190            read (mate_index,100) mate            mate_index = parms1(6:8)
191            call clrdiag (myThid,mate)            read (mate_index,'(I3)') mate
192              call clrdiag (mate, myThid)
193           endif           endif
194          endif          endif
195         enddo         enddo
196        enddo        enddo
197                      
198    100 format(i3)        RETURN
199        RETURN              END
       END            
200    
201    
202        subroutine clrdiag (myThid,index)        subroutine clrdiag (index, myThid)
203  C***********************************************************************          C***********************************************************************
204  C  PURPOSE                                                                        C  PURPOSE
205  C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS  C     ZERO OUT MODEL DIAGNOSTIC ARRAY ELEMENTS
206  C***********************************************************************          C***********************************************************************
207                                                                                    
208        implicit none        implicit none
209  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CPP_OPTIONS.h"  
210  #include "SIZE.h"  #include "SIZE.h"
211  #include "diagnostics_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
212  #include "diagnostics.h"  #include "DIAGNOSTICS.h"
213    
214        integer myThid, index        integer myThid, index
215    
216        integer bi,bj        integer bi,bj
217        integer i,j,k        integer i,j,k
218    
219  C **********************************************************************          C **********************************************************************
220  C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****          C ****              SET DIAGNOSTIC AND COUNTER TO ZERO              ****
221  C **********************************************************************          C **********************************************************************
222                                                                                    
223        do bj=myByLo(myThid), myByHi(myThid)        do bj=myByLo(myThid), myByHi(myThid)
224        do bi=myBxLo(myThid), myBxHi(myThid)         do bi=myBxLo(myThid), myBxHi(myThid)
225         do k = 1,kdiag(index)          do k = 1,kdiag(index)
226          do j = 1,sNy           do j = 1-OLy,sNy+OLy
227          do i = 1,sNx            do i = 1-OLx,sNx+OLx
228           qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0             qdiag(i,j,idiag(index)+k-1,bi,bj) = 0.0
229          enddo            enddo
230             enddo
231          enddo          enddo
232         enddo         enddo
233        enddo        enddo
       enddo  
234    
235        ndiag(index) = 0        ndiag(index) = 0
236    
237        return        RETURN
238        end        END
   
       subroutine setdiag (myThid,num,ndiagmx)  
 C***********************************************************************  
 C  
 C  PURPOSE  
 C     SET POINTER LOCATIONS, NAMES, LEVELS and TITLES FOR DIAGNOSTIC NUM  
 C  
 C***********************************************************************  
   
       implicit none  
 #include "CPP_OPTIONS.h"  
 #include "SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
   
       integer num,myThid,ndiagmx  
       integer ipointer  
   
       DATA IPOINTER / 1 /  
239    
240        character*8 parms1  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
       character*1 parse1(8)  
       character*3 mate_index  
       integer     mate  
241    
242        equivalence (     parms1 , parse1(1) )  CBOP 0
243        equivalence ( mate_index , parse1(6) )  C     !ROUTINE: DIAGNOSTICS_IS_ON
244    
245  C **********************************************************************  C     !INTERFACE:
246  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****        LOGICAL FUNCTION DIAGNOSTICS_IS_ON( diagName, myThid )
 C **********************************************************************  
247    
248        parms1 = gdiag(num)  C     !DESCRIPTION:
249    C     *==========================================================*
250    C     | FUNCTION DIAGNOSTIC_IS_ON
251    C     | o Return TRUE if diagnostics "diagName" is Active
252    C     *==========================================================*
253    
254        IF( IDIAG(NUM).EQ.0 ) THEN  C     !USES:
255          if(ndiagmx+kdiag(num).gt.numdiags) then        IMPLICIT NONE
256            write(6,4000)num,cdiag(num)  #include "EEPARAMS.h"
257          else  #include "SIZE.h"
258            IDIAG(NUM) = IPOINTER  #include "DIAGNOSTICS_SIZE.h"
259            IPOINTER   = IPOINTER + KDIAG(NUM)  #include "DIAGNOSTICS.h"
           ndiagmx    = ndiagmx  + KDIAG(NUM)  
           if(myThid.eq.1) WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx  
         endif  
       ELSE  
           if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)  
       ENDIF  
   
 c Check for Counter Diagnostic  
 c ----------------------------  
       if( parse1(5).eq.'C') then  
       read (mate_index,100) mate  
260    
261        IF( IDIAG(mate).EQ.0 ) THEN  C     !INPUT PARAMETERS:
262         if(ndiagmx+kdiag(num).gt.numdiags) then  C     diagName   ::  diagnostic identificator name (8 characters long)
263          write(6,5000)num,cdiag(num)  C     myThid     ::  my thread Id number
264         else        CHARACTER*8  diagName
265          IDIAG(mate) = IPOINTER        INTEGER      myThid
266          IPOINTER    = IPOINTER + KDIAG(mate)  CEOP
267          ndiagmx     = ndiagmx  + KDIAG(mate)  
268          if(myThid.eq.1)WRITE(6,2000)KDIAG(mate),mate,CDIAG(mate),ndiagmx  C     !LOCAL VARIABLES:
269         endif        INTEGER j,n,m
270        ELSE  
271            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)        DIAGNOSTICS_IS_ON = .FALSE.
272        ENDIF        DO n=1,nlists
273        endif         DO m=1,nActive(n)
274            IF ( diagName.EQ.flds(m,n) ) THEN
275              j = jdiag(m,n)    
276              IF ( idiag(j).NE.0 .AND. ndiag(j).GE.0 )
277         &         DIAGNOSTICS_IS_ON = .TRUE.
278            ENDIF
279           ENDDO
280          ENDDO
281    
282        RETURN        RETURN
   
   100 format(i3)  
  2000 FORMAT(1X,'Allocating ',I2,' Level(s) for Diagnostic # ',I3,  
      .          ' (',A8,'),  Total Number of Diagnostics: ',I5)  
  3000 FORMAT(1X,'Diagnostic # ',I3,' (',A8,') has already been set')  
  4000 FORMAT(1X,'Unable to allocate space for Diagnostic # ',I3,  
      .                      ' (',A8,')')  
  5000 FORMAT(1X,'Unable to allocate space for Counter Diagnostic # ',  
      .    I3,' (',A8,')',' WARNING - Diag will not accumulate properly')  
283        END        END
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22