/[MITgcm]/MITgcm/model/src/calc_common_factors.F
ViewVC logotype

Diff of /MITgcm/model/src/calc_common_factors.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by cnh, Wed May 27 21:01:47 1998 UTC revision 1.18 by cnh, Wed Sep 26 18:09:13 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6  CStartOfInterFace  CBOP
7    C     !ROUTINE: CALC_COMMON_FACTORS
8    C     !INTERFACE:
9        SUBROUTINE CALC_COMMON_FACTORS(        SUBROUTINE CALC_COMMON_FACTORS(
10       I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,       I        bi,bj,iMin,iMax,jMin,jMax,k,
11       O        xA,yA,uTrans,vTrans,wTrans,maskC,maskUp,       O        xA,yA,uTrans,vTrans,rTrans,maskUp,
12       I        myThid)       I        myThid)
13    C     !DESCRIPTION: \bv
14    C     *==========================================================*
15    C     | SUBROUTINE CALC_COMMON_FACTORS                            
16    C     | o Calculate common data (such as volume flux) for use    
17    C     |   by "Right hand side" subroutines.                      
18    C     *==========================================================*
19    C     | Here, we calculate terms or spatially varying factors    
20    C     | that are used at various points in the "RHS" subroutines.
21    C     | This reduces the amount of total work, total memory      
22    C     | and therefore execution time and is generally a good      
23    C     | idea.                                                    
24    C     *==========================================================*
25    C     \ev
26    
27  C     /==========================================================\  C     !USES:
 C     | SUBROUTINE CALC_COMMON_FACTORS                           |  
 C     | o Calculate common data (such as volume flux) for use    |  
 C     |   by "Right hand side" subroutines.                      |  
 C     |==========================================================|  
 C     | Here, we calculate terms or spatially varying factors    |  
 C     | that are used at various points in the "RHS" subroutines.|  
 C     | This reduces the amount of total work, total memory      |  
 C     | and therefore execution time and is generally a good     |  
 C     | idea.                                                    |  
 C     | We also think lower taxes are a good idea but we doubt   |  
 C     | whether we'll ever get them.                             |  
 C     \==========================================================/  
28        IMPLICIT NONE        IMPLICIT NONE
   
29  C     == GLobal variables ==  C     == GLobal variables ==
30  #include "SIZE.h"  #include "SIZE.h"
31  #include "DYNVARS.h"  #include "DYNVARS.h"
32  #include "EEPARAMS.h"  #include "EEPARAMS.h"
33  #include "PARAMS.h"  #include "PARAMS.h"
34  #include "GRID.h"  #include "GRID.h"
35    #ifdef ALLOW_NONHYDROSTATIC
36    #include "GW.h"
37    #endif
38    
39    C     !INPUT/OUTPUT PARAMETERS:
40  C     == Routine arguments ==  C     == Routine arguments ==
41  C     bi, bj, iMin, iMax, jMin, jMax - Range of points for which calculation  C     bi, bj, iMin, iMax, jMin, jMax :: Range of points for which calculation
42  C                                      results will be set.  C                                      results will be set.
43  C     xA      - Tracer cell face area normal to X  C     xA      :: Tracer cell face area normal to X
44  C     yA      - Tracer cell face area normal to X  C     yA      :: Tracer cell face area normal to X
45  C     uTrans  - Zonal volume transport through cell face  C     uTrans  :: Zonal volume transport through cell face
46  C     vTrans  - Meridional volume transport through cell face  C     vTrans  :: Meridional volume transport through cell face
47  C     wTrans  - Vertical volume transport through cell face  C     rTrans  :: R-direction volume transport through cell face
48  C     maskC   - land/water mask for tracer points  C     maskUp  :: land/water mask for Wvel points (above tracer level)
49  C     maskUp  - land/water mask for Wvel points (above tracer level)  C     myThid  ::Instance number for this innvocation of CALC_COMMON_FACTORS
 C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS  
50  C  C
51        INTEGER bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown        INTEGER bi,bj,iMin,iMax,jMin,jMax,k
52        _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53        _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54        _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56        _RL wTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
57        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
58  C  C
59        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
60    
61    C     !LOCAL VARIABLES:
62  C     == Local variables ==  C     == Local variables ==
63  C     I, J, K - Loop counters  C     I, J :: Loop counters
 C     kUp, kDown, kM1 - Index for layer above and below. K_UP and K_DOWN  
 C                         are switched with layer to be the appropriate index  
 C                         into fluxUD.  
64        INTEGER i,j        INTEGER i,j
65    CEOP
66    
67  C--    Calculate tracer cell face open areas  C--   Initialisation
68        DO j=jMin,jMax        DO j=1-OLy,sNy+OLy
69         DO i=iMin,iMax         DO i=1-OLx,sNx+OLx
70          xA(i,j) = _dyG(i,j,bi,bj)*dzF(k)*_hFacW(i,j,k,bi,bj)          xA(i,j)      = 0. _d 0
71          yA(i,j) = _dxG(i,j,bi,bj)*dzF(k)*_hFacS(i,j,k,bi,bj)          yA(i,j)      = 0. _d 0
72            uTrans(i,j)  = 0. _d 0
73            vTrans(i,j)  = 0. _d 0
74            rTrans(i,j)  = 0. _d 0
75         ENDDO         ENDDO
76        ENDDO        ENDDO      
77    
78    C--   Calculate mask for tracer cells  (0 => land, 1 => water)
79          IF (K .EQ. 1) THEN
80            DO j=jMin,jMax
81             DO i=iMin,iMax
82              maskUp(i,j) = 0.
83             ENDDO
84            ENDDO
85          ELSE
86            DO j=jMin,jMax
87             DO i=iMin,iMax
88              maskUp(i,j) = maskC(i,j,k-1,bi,bj)*maskC(i,j,k,bi,bj)
89             ENDDO
90            ENDDO
91          ENDIF
92    
93  C--    Calculate velocity field "volume transports" through  C--   Calculate tracer cell face open areas
 C--    tracer cell faces.  
94        DO j=jMin,jMax        DO j=jMin,jMax
95         DO i=iMin,iMax         DO i=iMin,iMax
96          uTrans(i,j) = uVel(i,j,k,bi,bj)*xA(i,j)          xA(i,j) = _dyG(i,j,bi,bj)
97          vTrans(i,j) = vVel(i,j,k,bi,bj)*yA(i,j)       &   *drF(k)*_hFacW(i,j,k,bi,bj)
98            yA(i,j) = _dxG(i,j,bi,bj)
99         &   *drF(k)*_hFacS(i,j,k,bi,bj)
100         ENDDO         ENDDO
101        ENDDO        ENDDO
102    
103  C--    Calculate vertical "volume transport" through  C--   Calculate velocity field "volume transports" through
104  C--    tracer cell face *above* this level.  C--   tracer cell faces.
105        DO j=jMin,jMax        DO j=jMin,jMax
106         DO i=iMin,iMax         DO i=iMin,iMax
107          wTrans(i,j) = uTrans(i,j)-uTrans(i+1,j)          uTrans(i,j) = uVel(i,j,k,bi,bj)*xA(i,j)
108       &               +vTrans(i,j)-vTrans(i,j+1)          vTrans(i,j) = vVel(i,j,k,bi,bj)*yA(i,j)
      &               +wTrans(i,j)  
109         ENDDO         ENDDO
110        ENDDO        ENDDO
111    
112  C--    Calculate mask for tracer cells  (0 => land, 1 => water)  C--   Calculate vertical "volume transport" through
113    C--   tracer cell face *above* this level.
114        DO j=jMin,jMax        DO j=jMin,jMax
115         DO i=iMin,iMax          DO i=iMin,iMax
116          maskC(i,j) = 1.            rTrans(i,j) = wVel(i,j,k,bi,bj)*rA(i,j,bi,bj)
117          if (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.          ENDDO
         maskUp(i,j) = 1.  
         if (_hFacC(i,j,kM1,bi,bj).eq.0.) maskUp(i,j)=0.  
        ENDDO  
118        ENDDO        ENDDO
119    
120        RETURN        RETURN
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22