/[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.6 by molod, Mon Mar 1 20:31:58 2004 UTC revision 1.14 by molod, Mon Jul 26 21:16:18 2004 UTC
# Line 1  Line 1 
1        subroutine getdiag (myThid,lev,ipoint,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"  #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  #ifdef ALLOW_FIZHI
24  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
25  #else  #else
26         integer Nrphys        integer Nrphys
27         parameter (Nrphys=0)        parameter (Nrphys=0)
28  #endif  #endif
29    
30  #include "diagnostics_SIZE.h"  #include "diagnostics_SIZE.h"
31  #include "diagnostics.h"  #include "diagnostics.h"
32    
33        integer myThid,lev,ipoint  C     INPUT:
34    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        _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)        _RL qtmp(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr+Nrphys,Nsx,Nsy)
45          _RL levreal
46    
47        _RL factor        _RL factor
48        integer i,j,ipnt,klev        integer i,j,ipnt,klev
49        integer bi,bj        integer bi,bj
50          integer lev
51    
52          lev = levreal
53        if (ipoint.lt.1) go to 999        if (ipoint.lt.1) go to 999
54    
55        klev = kdiag(ipoint)        klev = kdiag(ipoint)
56        if(klev.ge.lev) then        if (klev.ge.lev) then
57        ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
58        factor = 1.0          factor = 1.0
59        if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)          if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
60    
61        do bj=myByLo(myThid), myByHi(myThid)          do bj=myByLo(myThid), myByHi(myThid)
62        do bi=myBxLo(myThid), myBxHi(myThid)            do bi=myBxLo(myThid), myBxHi(myThid)
63                
64        do j = 1,sNy              do j = 1,sNy
65        do i = 1,sNx                do i = 1,sNx
66         if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
67          qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor                    qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)*factor
68         else                  else
69          qtmp(i,j,lev,bi,bj) = undef                    qtmp(i,j,lev,bi,bj) = undef
70         endif                  endif
71        enddo                enddo
72        enddo              enddo
73                
74        enddo            enddo
75        enddo          enddo
76            
77        endif        endif
78    
79   999  return   999  return
80        end        end
81    
82        subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83    CBOP 0
84    C     !ROUTINE: GETDIAG2
85    
86    C     !INTERFACE:
87          SUBROUTINE GETDIAG2 (myThid,lev,ipoint,undef,qtmp)
88    
89    C     !DESCRIPTION:
90  C***********************************************************************          C***********************************************************************        
91  C  PURPOSE                                                                        C  PURPOSE                                                                      
92  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 79  C  OUTPUT: Line 99  C  OUTPUT:
99  C    qtmp ..... AVERAGED 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"  #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  #ifdef ALLOW_FIZHI
111  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
# Line 105  C*************************************** Line 127  C***************************************
127        if (ipoint.lt.1) go to 999        if (ipoint.lt.1) go to 999
128    
129        klev = kdiag(ipoint)        klev = kdiag(ipoint)
130        if(klev.ge.lev) then        if (klev.ge.lev) then
131        ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
132            
133        do bj=myByLo(myThid), myByHi(myThid)          do bj=myByLo(myThid), myByHi(myThid)
134        do bi=myBxLo(myThid), myBxHi(myThid)            do bi=myBxLo(myThid), myBxHi(myThid)
135                
136        do j = 1,sNy              do j = 1,sNy
137        do i = 1,sNx                do i = 1,sNx
138         if( qdiag(i,j,ipnt,bi,bj).ne.undef ) then                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
139          qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)                    qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)
140         else                  else
141          qtmp(i,j,lev,bi,bj) = undef                    qtmp(i,j,lev,bi,bj) = undef
142         endif                  endif
143        enddo                enddo
144        enddo              enddo
145                
146        enddo            enddo
147        enddo          enddo
148            
149        endif        endif
150    
151   999  return   999  return
152        end        end
153    
154    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
155    
156        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
157  C***********************************************************************  C***********************************************************************
158  C  C
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22