/[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.11 by molod, Wed Jul 7 15:58:17 2004 UTC revision 1.12 by edhill, Thu Jul 8 00:30:45 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5    
6        subroutine getdiag (myThid,lev,ipoint,undef,qtmp)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7  C***********************************************************************          CBOP 0
8  C  PURPOSE                                                                        C     !ROUTINE: GETDIAG
9  C     Retrieve averaged model diagnostic  
10  C  INPUT:                                                                        C     !INTERFACE:
11  C     lev ..... Diagnostic LEVEL        SUBROUTINE GETDIAG (myThid,lev,ipoint,undef,qtmp)
12  C  ipoint ..... DIAGNOSTIC NUMBER FROM MENU                                      
13  C   undef ..... UNDEFINED VALUE                                                  C     !DESCRIPTION:
14  C      bi ..... X-direction process(or) number        Retrieve averaged model diagnostic
15  C      bj ..... Y-direction process(or) number        
16  C                                                                                C     !USES:
 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    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,lev,ipoint        integer myThid,lev,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    
46        _RL factor        _RL factor
# Line 44  C*************************************** Line 50  C***************************************
50        if (ipoint.lt.1) go to 999        if (ipoint.lt.1) go to 999
51    
52        klev = kdiag(ipoint)        klev = kdiag(ipoint)
53        if(klev.ge.lev) then        if (klev.ge.lev) then
54        ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
55        factor = 1.0          factor = 1.0
56        if(ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)          if (ndiag(ipoint).ne.0) factor = 1.0/ndiag(ipoint)
57    
58        do bj=myByLo(myThid), myByHi(myThid)          do bj=myByLo(myThid), myByHi(myThid)
59        do bi=myBxLo(myThid), myBxHi(myThid)            do bi=myBxLo(myThid), myBxHi(myThid)
60                
61        do j = 1,sNy              do j = 1,sNy
62        do i = 1,sNx                do i = 1,sNx
63         if( qdiag(i,j,ipnt,bi,bj).ge.undef ) then                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
64          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
65         else                  else
66          qtmp(i,j,lev,bi,bj) = undef                    qtmp(i,j,lev,bi,bj) = undef
67         endif                  endif
68        enddo                enddo
69        enddo              enddo
70                
71        enddo            enddo
72        enddo          enddo
73            
74        endif        endif
75    
76   999  return   999  return
77        end        end
78    
79        subroutine getdiag2 (myThid,lev,ipoint,undef,qtmp)  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
80    CBOP 0
81    C     !ROUTINE: GETDIAG2
82    
83    C     !INTERFACE:
84          SUBROUTINE GETDIAG2 (myThid,lev,ipoint,undef,qtmp)
85    
86    C     !DESCRIPTION:
87  C***********************************************************************          C***********************************************************************        
88  C  PURPOSE                                                                        C  PURPOSE                                                                      
89  C     Retrieve averaged model diagnostic  C     Retrieve averaged model diagnostic
# Line 83  C  OUTPUT: Line 96  C  OUTPUT:
96  C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY  C    qtmp ..... AVERAGED DIAGNOSTIC QUANTITY
97  C                                                                                C                                                                              
98  C***********************************************************************          C***********************************************************************        
99          
100    C     !USES:
101        implicit none        implicit none
   
102  #include "EEPARAMS.h"  #include "EEPARAMS.h"
103  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
104  #include "SIZE.h"  #include "SIZE.h"
105    CEOP
106    
107  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
108  #include "fizhi_SIZE.h"  #include "fizhi_SIZE.h"
# Line 109  C*************************************** Line 124  C***************************************
124        if (ipoint.lt.1) go to 999        if (ipoint.lt.1) go to 999
125    
126        klev = kdiag(ipoint)        klev = kdiag(ipoint)
127        if(klev.ge.lev) then        if (klev.ge.lev) then
128        ipnt = idiag(ipoint) + lev - 1          ipnt = idiag(ipoint) + lev - 1
129            
130        do bj=myByLo(myThid), myByHi(myThid)          do bj=myByLo(myThid), myByHi(myThid)
131        do bi=myBxLo(myThid), myBxHi(myThid)            do bi=myBxLo(myThid), myBxHi(myThid)
132                
133        do j = 1,sNy              do j = 1,sNy
134        do i = 1,sNx                do i = 1,sNx
135         if( qdiag(i,j,ipnt,bi,bj).ge.undef ) then                  if ( qdiag(i,j,ipnt,bi,bj) .le. undef ) then
136          qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)                    qtmp(i,j,lev,bi,bj) = qdiag(i,j,ipnt,bi,bj)
137         else                  else
138          qtmp(i,j,lev,bi,bj) = undef                    qtmp(i,j,lev,bi,bj) = undef
139         endif                  endif
140        enddo                enddo
141        enddo              enddo
142                
143        enddo            enddo
144        enddo          enddo
145            
146        endif        endif
147    
148   999  return   999  return
149        end        end
150    
151    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
152    
153        subroutine clrindx (myThid,listnum)        subroutine clrindx (myThid,listnum)
154  C***********************************************************************  C***********************************************************************
155  C  C
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22