/[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.9 by edhill, Tue Jul 6 03:55:53 2004 UTC
# Line 1  Line 1 
1        subroutine getdiag (lev,ipoint,bi,bj,undef,qtmp)  C $Header$
2    C $Name$
3    
4    #include "DIAG_OPTIONS.h"
5    
6          subroutine getdiag (myThid,lev,ipoint,undef,qtmp)
7  C***********************************************************************          C***********************************************************************        
8  C  PURPOSE                                                                        C  PURPOSE                                                                      
9  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 14  C    qtmp ..... AVERAGED DIAGNOSTIC QUAN Line 19  C    qtmp ..... AVERAGED DIAGNOSTIC QUAN
19  C                                                                                C                                                                              
20  C***********************************************************************          C***********************************************************************        
21        implicit none        implicit none
22    #include "EEPARAMS.h"
23  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
24  #include "SIZE.h"  #include "SIZE.h"
25    
26    #ifdef ALLOW_FIZHI
27  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
28    #else
29           integer Nrphys
30           parameter (Nrphys=0)
31    #endif
32    
33  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
34  #include "diagnostics.h"  #include "diagnostics.h"
35    
36        integer bi,bj        integer myThid,lev,ipoint
37        integer lev,ipoint        _RL undef
38          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
39    
40          _RL factor
41        integer i,j,ipnt,klev        integer i,j,ipnt,klev
42        _RL undef, factor        integer bi,bj
43        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
44          if (ipoint.lt.1) go to 999
45    
46          klev = kdiag(ipoint)
47          if(klev.ge.lev) then
48          ipnt = idiag(ipoint) + lev - 1
49          factor = 1.0
50          if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
51    
52          do bj=myByLo(myThid), myByHi(myThid)
53          do bi=myBxLo(myThid), myBxHi(myThid)
54    
55        do j = 1,sNy        do j = 1,sNy
56        do i = 1,sNx        do i = 1,sNx
57         qtmp(i,j,bi,bj) = undef         if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then
58            qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
59           else
60            qtmp(i,j,lev,bi,bj) = undef
61           endif
62        enddo        enddo
63        enddo        enddo
64    
       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  
65        enddo        enddo
66        enddo        enddo
       ENDIF  
67    
68   999  RETURN        endif
69        END  
70     999  return
71          end
72    
73        subroutine getdiag2 (lev,ipoint,bi,bj,undef,qtmp)        subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp)
74  C***********************************************************************          C***********************************************************************        
 C                                                                                
75  C  PURPOSE                                                                        C  PURPOSE                                                                      
76  C     Retrieve model diagnostic (No Averaging)  C     Retrieve averaged model diagnostic
77  C  INPUT:                                                                        C  INPUT:                                                                      
78  C     lev ..... Model LEVEL                                                      C     lev ..... Diagnostic LEVEL
79  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                    
80  C   undef ..... UNDEFINED VALUE                                                  C   undef ..... UNDEFINED VALUE                                                
 C      im ..... X-DIMENSION  
 C      jm ..... Y-DIMENSION  
 C      nd ..... Number of 2-D Diagnostics  
81  C                                                                                C                                                                              
82  C  OUTPUT:                                                                        C  OUTPUT:                                                                      
83  C    qtmp ..... DIAGNOSTIC QUANTITY                                              C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
84  C                                                                                C                                                                              
85  C***********************************************************************          C***********************************************************************        
86        implicit none        implicit none
87    
88    #include "EEPARAMS.h"
89  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
90  #include "SIZE.h"  #include "SIZE.h"
91    
92    #ifdef ALLOW_FIZHI
93  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
94    #else
95           integer Nrphys
96           parameter (Nrphys=0)
97    #endif
98    
99  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
100  #include "diagnostics.h"  #include "diagnostics.h"
101    
102        integer bi,bj        integer myThid,lev,ipoint
103          _RL undef
104          _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
105    
       integer lev,ipoint  
106        integer i,j,ipnt,klev        integer i,j,ipnt,klev
107        _RL undef        integer bi,bj
108        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nsx,Nsy)  
109          if (ipoint.lt.1) go to 999
110    
111          klev = kdiag(ipoint)
112          if(klev.ge.lev) then
113          ipnt = idiag(ipoint) + lev - 1
114    
115          do bj=myByLo(myThid), myByHi(myThid)
116          do bi=myBxLo(myThid), myBxHi(myThid)
117    
118        do j = 1,sNy        do j = 1,sNy
119        do i = 1,sNx        do i = 1,sNx
120         qtmp(i,j,bi,bj) = undef         if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then
121            qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)
122           else
123            qtmp(i,j,lev,bi,bj) = undef
124           endif
125        enddo        enddo
126        enddo        enddo
127    
       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)  
128        enddo        enddo
129        enddo        enddo
       ENDIF  
130    
131   999  RETURN        endif
132        END  
133                                                                                     999  return
134          end
135        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
136  C***********************************************************************  C***********************************************************************
137  C  C
# Line 119  C*************************************** Line 147  C***************************************
147  #include "EEPARAMS.h"  #include "EEPARAMS.h"
148  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
149  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
150  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
151  #include "diagnostics.h"  #include "diagnostics.h"
152    
# Line 165  C*************************************** Line 192  C***************************************
192  #include "EEPARAMS.h"  #include "EEPARAMS.h"
193  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
194  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
195  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
196  #include "diagnostics.h"  #include "diagnostics.h"
197    
# Line 206  C*************************************** Line 232  C***************************************
232        implicit none        implicit none
233  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
234  #include "SIZE.h"  #include "SIZE.h"
 #include "fizhi_SIZE.h"  
235  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
236  #include "diagnostics.h"  #include "diagnostics.h"
237    
# Line 236  C ************************************** Line 261  C **************************************
261            IDIAG(NUM) = IPOINTER            IDIAG(NUM) = IPOINTER
262            IPOINTER   = IPOINTER + KDIAG(NUM)            IPOINTER   = IPOINTER + KDIAG(NUM)
263            ndiagmx    = ndiagmx  + KDIAG(NUM)            ndiagmx    = ndiagmx  + KDIAG(NUM)
264            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
265          endif          endif
266        ELSE        ELSE
267            if(myThid.eq.0) WRITE(6,3000) NUM, CDIAG(NUM)            if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
268        ENDIF        ENDIF
269    
270  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 254  c ---------------------------- Line 279  c ----------------------------
279          IDIAG(mate) = IPOINTER          IDIAG(mate) = IPOINTER
280          IPOINTER    = IPOINTER + KDIAG(mate)          IPOINTER    = IPOINTER + KDIAG(mate)
281          ndiagmx     = ndiagmx  + KDIAG(mate)          ndiagmx     = ndiagmx  + KDIAG(mate)
282          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
283         endif         endif
284        ELSE        ELSE
285            if(myThid.eq.0) WRITE(6,3000) mate, CDIAG(mate)            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
286        ENDIF        ENDIF
287        endif        endif
288    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22