/[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.4 by molod, Thu Feb 26 19:52:05 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 236  C ************************************** Line 260  C **************************************
260            IDIAG(NUM) = IPOINTER            IDIAG(NUM) = IPOINTER
261            IPOINTER   = IPOINTER + KDIAG(NUM)            IPOINTER   = IPOINTER + KDIAG(NUM)
262            ndiagmx    = ndiagmx  + KDIAG(NUM)            ndiagmx    = ndiagmx  + KDIAG(NUM)
263            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
264          endif          endif
265        ELSE        ELSE
266            if(myThid.eq.0) WRITE(6,3000) NUM, CDIAG(NUM)            if(myThid.eq.1) WRITE(6,3000) NUM, CDIAG(NUM)
267        ENDIF        ENDIF
268    
269  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 254  c ---------------------------- Line 278  c ----------------------------
278          IDIAG(mate) = IPOINTER          IDIAG(mate) = IPOINTER
279          IPOINTER    = IPOINTER + KDIAG(mate)          IPOINTER    = IPOINTER + KDIAG(mate)
280          ndiagmx     = ndiagmx  + KDIAG(mate)          ndiagmx     = ndiagmx  + KDIAG(mate)
281          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
282         endif         endif
283        ELSE        ELSE
284            if(myThid.eq.0) WRITE(6,3000) mate, CDIAG(mate)            if(myThid.eq.1) WRITE(6,3000) mate, CDIAG(mate)
285        ENDIF        ENDIF
286        endif        endif
287    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22