/[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.2 by molod, Thu Feb 26 02:21:18 2004 UTC revision 1.13 by edhill, Thu Jul 8 16:16:09 2004 UTC
# Line 1  Line 1 
1        subroutine getdiag (lev,ipoint,bi,bj,undef,qtmp)  C $Header$
2  C***********************************************************************          C $Name$
3  C  PURPOSE                                                                        
4    #include "DIAG_OPTIONS.h"
5    
6    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    CBOP 0
8    C     !ROUTINE: GETDIAG
9    
10    C     !INTERFACE:
11          SUBROUTINE GETDIAG (myThid,lev,ipoint,undef,qtmp)
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"
19  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
20  #include "SIZE.h"  #include "SIZE.h"
21    CEOP
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 bi,bj  C     INPUT:
34        integer lev,ipoint  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
40          _RL undef
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
47        integer i,j,ipnt,klev        integer i,j,ipnt,klev
48        _RL undef, factor        integer bi,bj
       _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
49    
50        do j = 1,sNy        if (ipoint.lt.1) go to 999
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = undef  
       enddo  
       enddo  
51    
52        IF (IPOINT.LT.1) GO TO 999        klev = kdiag(ipoint)
53          if (klev.ge.lev) then
54            ipnt = idiag(ipoint) + lev - 1
55            factor = 1.0
56            if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
57    
58            do bj=myByLo(myThid), myByHi(myThid)
59              do bi=myBxLo(myThid), myBxHi(myThid)
60                
61                do j = 1,sNy
62                  do i = 1,sNx
63                    if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
64                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
65                    else
66                      qtmp(i,j,lev,bi,bj) = undef
67                    endif
68                  enddo
69                enddo
70                
71              enddo
72            enddo
73            
74          endif
75    
76        KLEV = KDIAG(IPOINT)   999  return
77        IF(KLEV.GE.LEV) THEN        end
       IPNT = IDIAG(IPOINT) + LEV - 1  
                                 FACTOR = 1.0  
       IF( NDIAG(IPOINT).NE.0 )  FACTOR = 1.0   / NDIAG(IPOINT)  
       do j = 1,sNy  
       do i = 1,sNx  
       if( qdiag(i,j,ipnt,bi,bj).ne.undef )  
      .     qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor  
       enddo  
       enddo  
       ENDIF  
78    
79   999  RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
80        END  CBOP 0
81    C     !ROUTINE: GETDIAG2
82    
83        subroutine getdiag2 (lev,ipoint,bi,bj,undef,qtmp)  C     !INTERFACE:
84          SUBROUTINE GETDIAG2 (myThid,lev,ipoint,undef,qtmp)
85    
86    C     !DESCRIPTION:
87  C***********************************************************************          C***********************************************************************        
 C                                                                                
88  C  PURPOSE                                                                        C  PURPOSE                                                                      
89  C     Retrieve model diagnostic (No Averaging)  C     Retrieve averaged model diagnostic
90  C  INPUT:                                                                        C  INPUT:                                                                      
91  C     lev ..... Model LEVEL                                                      C     lev ..... Diagnostic LEVEL
92  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                    
93  C   undef ..... UNDEFINED VALUE                                                  C   undef ..... UNDEFINED VALUE                                                
 C      im ..... X-DIMENSION  
 C      jm ..... Y-DIMENSION  
 C      nd ..... Number of 2-D Diagnostics  
94  C                                                                                C                                                                              
95  C  OUTPUT:                                                                        C  OUTPUT:                                                                      
96  C    qtmp ..... 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"
103  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
104  #include "SIZE.h"  #include "SIZE.h"
105    CEOP
106    
107    #ifdef ALLOW_FIZHI
108  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
109    #else
110           integer Nrphys
111           parameter (Nrphys=0)
112    #endif
113    
114  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
115  #include "diagnostics.h"  #include "diagnostics.h"
116    
117        integer bi,bj        integer myThid,lev,ipoint
118          _RL undef
119          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
120    
       integer lev,ipoint  
121        integer i,j,ipnt,klev        integer i,j,ipnt,klev
122        _RL undef        integer bi,bj
       _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
123    
124        do j = 1,sNy        if (ipoint.lt.1) go to 999
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = undef  
       enddo  
       enddo  
125    
126        IF (IPOINT.LT.1) GO TO 999        klev = kdiag(ipoint)
127          if (klev.ge.lev) then
128            ipnt = idiag(ipoint) + lev - 1
129            
130            do bj=myByLo(myThid), myByHi(myThid)
131              do bi=myBxLo(myThid), myBxHi(myThid)
132                
133                do j = 1,sNy
134                  do i = 1,sNx
135                    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
141                enddo
142                
143              enddo
144            enddo
145            
146          endif
147    
148        KLEV = KDIAG(IPOINT)   999  return
149        IF(KLEV.GE.LEV) THEN        end
150        IPNT = IDIAG(IPOINT) + LEV - 1  
151        do j = 1,sNy  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj)  
       enddo  
       enddo  
       ENDIF  
152    
  999  RETURN  
       END  
                                                                                   
153        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
154  C***********************************************************************  C***********************************************************************
155  C  C
# Line 119  C*************************************** Line 165  C***************************************
165  #include "EEPARAMS.h"  #include "EEPARAMS.h"
166  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
167  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
168  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
169  #include "diagnostics.h"  #include "diagnostics.h"
170    
# Line 165  C*************************************** Line 210  C***************************************
210  #include "EEPARAMS.h"  #include "EEPARAMS.h"
211  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
212  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
213  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
214  #include "diagnostics.h"  #include "diagnostics.h"
215    
# Line 206  C*************************************** Line 250  C***************************************
250        implicit none        implicit none
251  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
252  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
253  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
254  #include "diagnostics.h"  #include "diagnostics.h"
255    
# Line 236  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.0) WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx            if(myThid.eq.1) WRITE(6,2000)KDIAG(NUM),NUM,CDIAG(NUM),ndiagmx
283          endif          endif
284        ELSE        ELSE
285            if(myThid.eq.0) WRITE(6,3000) NUM, CDIAG(NUM)            if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
286        ENDIF        ENDIF
287    
288  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 254  c ---------------------------- Line 297  c ----------------------------
297          IDIAG(mate) = IPOINTER          IDIAG(mate) = IPOINTER
298          IPOINTER    = IPOINTER + KDIAG(mate)          IPOINTER    = IPOINTER + KDIAG(mate)
299          ndiagmx     = ndiagmx  + KDIAG(mate)          ndiagmx     = ndiagmx  + KDIAG(mate)
300          if(myThid.eq.0)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.0) WRITE(6,3000) mate, CDIAG(mate)            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
304        ENDIF        ENDIF
305        endif        endif
306    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22