/[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.5 by molod, Thu Feb 26 22:20:36 2004 UTC
# Line 1  Line 1 
1        subroutine getdiag (lev,ipoint,bi,bj,undef,qtmp)        subroutine getdiag (myThid,lev,ipoint,undef,qtmp)
2  C***********************************************************************          C***********************************************************************        
3  C  PURPOSE                                                                        C  PURPOSE                                                                      
4  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 15  C Line 15  C
15  C***********************************************************************          C***********************************************************************        
16        implicit none        implicit none
17    
18    #include "EEPARAMS.h"
19  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
20  #include "SIZE.h"  #include "SIZE.h"
21    
22    #ifdef ALLOW_FIZHI
23  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
24    #else
25           integer Nrphys
26           parameter (Nrphys=1)
27    #endif
28    
29  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
30  #include "diagnostics.h"  #include "diagnostics.h"
31    
32        integer bi,bj        integer myThid,lev,ipoint
33        integer lev,ipoint        _RL undef
34          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
35    
36          _RL factor
37        integer i,j,ipnt,klev        integer i,j,ipnt,klev
38        _RL undef, factor        integer bi,bj
39        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
40          if (ipoint.lt.1) go to 999
41    
42          klev = kdiag(ipoint)
43          if(klev.ge.lev) then
44          ipnt = idiag(ipoint) + lev - 1
45          factor = 1.0
46          if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
47    
48          do bj=myByLo(myThid), myByHi(myThid)
49          do bi=myBxLo(myThid), myBxHi(myThid)
50    
51        do j = 1,sNy        do j = 1,sNy
52        do i = 1,sNx        do i = 1,sNx
53         qtmp(i,j,bi,bj) = undef         if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then
54            qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
55           else
56            qtmp(i,j,lev,bi,bj) = undef
57           endif
58        enddo        enddo
59        enddo        enddo
60    
       IF (IPOINT.LT.1) GO TO 999  
   
       KLEV = KDIAG(IPOINT)  
       IF(KLEV.GE.LEV) THEN  
       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  
61        enddo        enddo
62        enddo        enddo
       ENDIF  
63    
64   999  RETURN        endif
65        END  
66     999  return
67          end
68    
69        subroutine getdiag2 (lev,ipoint,bi,bj,undef,qtmp)        subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp)
70  C***********************************************************************          C***********************************************************************        
 C                                                                                
71  C  PURPOSE                                                                        C  PURPOSE                                                                      
72  C     Retrieve model diagnostic (No Averaging)  C     Retrieve averaged model diagnostic
73  C  INPUT:                                                                        C  INPUT:                                                                      
74  C     lev ..... Model LEVEL                                                      C     lev ..... Diagnostic LEVEL
75  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                    
76  C   undef ..... UNDEFINED VALUE                                                  C   undef ..... UNDEFINED VALUE                                                
 C      im ..... X-DIMENSION  
 C      jm ..... Y-DIMENSION  
 C      nd ..... Number of 2-D Diagnostics  
77  C                                                                                C                                                                              
78  C  OUTPUT:                                                                        C  OUTPUT:                                                                      
79  C    qtmp ..... DIAGNOSTIC QUANTITY                                              C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
80  C                                                                                C                                                                              
81  C***********************************************************************          C***********************************************************************        
82        implicit none        implicit none
83    
84    #include "EEPARAMS.h"
85  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
86  #include "SIZE.h"  #include "SIZE.h"
87    
88    #ifdef ALLOW_FIZHI
89  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
90    #else
91           integer Nrphys
92           parameter (Nrphys=1)
93    #endif
94    
95  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
96  #include "diagnostics.h"  #include "diagnostics.h"
97    
98        integer bi,bj        integer myThid,lev,ipoint
99          _RL undef
100          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
101    
       integer lev,ipoint  
102        integer i,j,ipnt,klev        integer i,j,ipnt,klev
103        _RL undef        integer bi,bj
104        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
105          if (ipoint.lt.1) go to 999
106    
107          klev = kdiag(ipoint)
108          if(klev.ge.lev) then
109          ipnt = idiag(ipoint) + lev - 1
110    
111          do bj=myByLo(myThid), myByHi(myThid)
112          do bi=myBxLo(myThid), myBxHi(myThid)
113    
114        do j = 1,sNy        do j = 1,sNy
115        do i = 1,sNx        do i = 1,sNx
116         qtmp(i,j,bi,bj) = undef         if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then
117            qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)
118           else
119            qtmp(i,j,lev,bi,bj) = undef
120           endif
121        enddo        enddo
122        enddo        enddo
123    
       IF (IPOINT.LT.1) GO TO 999  
   
       KLEV = KDIAG(IPOINT)  
       IF(KLEV.GE.LEV) THEN  
       IPNT = IDIAG(IPOINT) + LEV - 1  
       do j = 1,sNy  
       do i = 1,sNx  
        qtmp(i,j,bi,bj) = qdiag(i,j,ipnt,bi,bj)  
124        enddo        enddo
125        enddo        enddo
       ENDIF  
126    
127   999  RETURN        endif
128        END  
129                                                                                     999  return
130          end
131        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
132  C***********************************************************************  C***********************************************************************
133  C  C
# Line 119  C*************************************** Line 143  C***************************************
143  #include "EEPARAMS.h"  #include "EEPARAMS.h"
144  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
145  #include "SIZE.h"  #include "SIZE.h"
146    
147    #ifdef ALLOW_FIZHI
148  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
149    #else
150           integer Nrphys
151           parameter (Nrphys=1)
152    #endif
153    
154  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
155  #include "diagnostics.h"  #include "diagnostics.h"
156    
# Line 165  C*************************************** Line 196  C***************************************
196  #include "EEPARAMS.h"  #include "EEPARAMS.h"
197  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
198  #include "SIZE.h"  #include "SIZE.h"
199    
200    #ifdef ALLOW_FIZHI
201  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
202    #else
203           integer Nrphys
204           parameter (Nrphys=1)
205    #endif
206    
207  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
208  #include "diagnostics.h"  #include "diagnostics.h"
209    
# Line 206  C*************************************** Line 244  C***************************************
244        implicit none        implicit none
245  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
246  #include "SIZE.h"  #include "SIZE.h"
247    
248    #ifdef ALLOW_FIZHI
249  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
250    #else
251           integer Nrphys
252           parameter (Nrphys=1)
253    #endif
254    
255  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
256  #include "diagnostics.h"  #include "diagnostics.h"
257    
# Line 236  C ************************************** Line 281  C **************************************
281            IDIAG(NUM) = IPOINTER            IDIAG(NUM) = IPOINTER
282            IPOINTER   = IPOINTER + KDIAG(NUM)            IPOINTER   = IPOINTER + KDIAG(NUM)
283            ndiagmx    = ndiagmx  + KDIAG(NUM)            ndiagmx    = ndiagmx  + KDIAG(NUM)
284            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
285          endif          endif
286        ELSE        ELSE
287            if(myThid.eq.0) WRITE(6,3000) NUM, CDIAG(NUM)            if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
288        ENDIF        ENDIF
289    
290  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 254  c ---------------------------- Line 299  c ----------------------------
299          IDIAG(mate) = IPOINTER          IDIAG(mate) = IPOINTER
300          IPOINTER    = IPOINTER + KDIAG(mate)          IPOINTER    = IPOINTER + KDIAG(mate)
301          ndiagmx     = ndiagmx  + KDIAG(mate)          ndiagmx     = ndiagmx  + KDIAG(mate)
302          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
303         endif         endif
304        ELSE        ELSE
305            if(myThid.eq.0) WRITE(6,3000) mate, CDIAG(mate)            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
306        ENDIF        ENDIF
307        endif        endif
308    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22