/[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.14 by molod, Mon Jul 26 21:16:18 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,levreal,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,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          _RL levreal
46    
47          _RL factor
48        integer i,j,ipnt,klev        integer i,j,ipnt,klev
49        _RL undef, factor        integer bi,bj
50        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)        integer lev
51    
52        do j = 1,sNy        lev = levreal
53        do i = 1,sNx        if (ipoint.lt.1) go to 999
        qtmp(i,j,bi,bj) = undef  
       enddo  
       enddo  
54    
55        IF (IPOINT.LT.1) GO TO 999        klev = kdiag(ipoint)
56          if (klev.ge.lev) then
57            ipnt = idiag(ipoint) + lev - 1
58            factor = 1.0
59            if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
60    
61            do bj=myByLo(myThid), myByHi(myThid)
62              do bi=myBxLo(myThid), myBxHi(myThid)
63                
64                do j = 1,sNy
65                  do i = 1,sNx
66                    if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
67                      qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
68                    else
69                      qtmp(i,j,lev,bi,bj) = undef
70                    endif
71                  enddo
72                enddo
73                
74              enddo
75            enddo
76            
77          endif
78    
79        KLEV = KDIAG(IPOINT)   999  return
80        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  
81    
82   999  RETURN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83        END  CBOP 0
84    C     !ROUTINE: GETDIAG2
85    
86        subroutine getdiag2 (lev,ipoint,bi,bj,undef,qtmp)  C     !INTERFACE:
87          SUBROUTINE GETDIAG2 (myThid,lev,ipoint,undef,qtmp)
88    
89    C     !DESCRIPTION:
90  C***********************************************************************          C***********************************************************************        
 C                                                                                
91  C  PURPOSE                                                                        C  PURPOSE                                                                      
92  C     Retrieve model diagnostic (No Averaging)  C     Retrieve averaged model diagnostic
93  C  INPUT:                                                                        C  INPUT:                                                                      
94  C     lev ..... Model LEVEL                                                      C     lev ..... Diagnostic LEVEL
95  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                    
96  C   undef ..... UNDEFINED VALUE                                                  C   undef ..... UNDEFINED VALUE                                                
 C      im ..... X-DIMENSION  
 C      jm ..... Y-DIMENSION  
 C      nd ..... Number of 2-D Diagnostics  
97  C                                                                                C                                                                              
98  C  OUTPUT:                                                                        C  OUTPUT:                                                                      
99  C    qtmp ..... DIAGNOSTIC QUANTITY                                              C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
100  C                                                                                C                                                                              
101  C***********************************************************************          C***********************************************************************        
102          
103    C     !USES:
104        implicit none        implicit none
105    #include "EEPARAMS.h"
106  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
107  #include "SIZE.h"  #include "SIZE.h"
108    CEOP
109    
110    #ifdef ALLOW_FIZHI
111  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
112    #else
113           integer Nrphys
114           parameter (Nrphys=0)
115    #endif
116    
117  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
118  #include "diagnostics.h"  #include "diagnostics.h"
119    
120        integer bi,bj        integer myThid,lev,ipoint
121          _RL undef
122          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
123    
       integer lev,ipoint  
124        integer i,j,ipnt,klev        integer i,j,ipnt,klev
125        _RL undef        integer bi,bj
       _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
126    
127        do j = 1,sNy        if (ipoint.lt.1) go to 999
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = undef  
       enddo  
       enddo  
128    
129        IF (IPOINT.LT.1) GO TO 999        klev = kdiag(ipoint)
130          if (klev.ge.lev) then
131            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              enddo
147            enddo
148            
149          endif
150    
151        KLEV = KDIAG(IPOINT)   999  return
152        IF(KLEV.GE.LEV) THEN        end
153        IPNT = IDIAG(IPOINT) + LEV - 1  
154        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  
155    
  999  RETURN  
       END  
                                                                                   
156        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
157  C***********************************************************************  C***********************************************************************
158  C  C
# Line 119  C*************************************** Line 168  C***************************************
168  #include "EEPARAMS.h"  #include "EEPARAMS.h"
169  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
170  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
171  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
172  #include "diagnostics.h"  #include "diagnostics.h"
173    
# Line 165  C*************************************** Line 213  C***************************************
213  #include "EEPARAMS.h"  #include "EEPARAMS.h"
214  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
215  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
216  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
217  #include "diagnostics.h"  #include "diagnostics.h"
218    
# Line 206  C*************************************** Line 253  C***************************************
253        implicit none        implicit none
254  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
255  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
256  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
257  #include "diagnostics.h"  #include "diagnostics.h"
258    
# Line 236  C ************************************** Line 282  C **************************************
282            IDIAG(NUM) = IPOINTER            IDIAG(NUM) = IPOINTER
283            IPOINTER   = IPOINTER + KDIAG(NUM)            IPOINTER   = IPOINTER + KDIAG(NUM)
284            ndiagmx    = ndiagmx  + KDIAG(NUM)            ndiagmx    = ndiagmx  + KDIAG(NUM)
285            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
286          endif          endif
287        ELSE        ELSE
288            if(myThid.eq.0) WRITE(6,3000) NUM, CDIAG(NUM)            if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
289        ENDIF        ENDIF
290    
291  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 254  c ---------------------------- Line 300  c ----------------------------
300          IDIAG(mate) = IPOINTER          IDIAG(mate) = IPOINTER
301          IPOINTER    = IPOINTER + KDIAG(mate)          IPOINTER    = IPOINTER + KDIAG(mate)
302          ndiagmx     = ndiagmx  + KDIAG(mate)          ndiagmx     = ndiagmx  + KDIAG(mate)
303          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
304         endif         endif
305        ELSE        ELSE
306            if(myThid.eq.0) WRITE(6,3000) mate, CDIAG(mate)            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
307        ENDIF        ENDIF
308        endif        endif
309    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22