/[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.5 by adcroft, Mon Jun 8 18:45:28 1998 UTC revision 1.15 by jmc, Wed Feb 7 21:48:02 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  CStartOfInterFace
7        SUBROUTINE CALC_COMMON_FACTORS(        SUBROUTINE CALC_COMMON_FACTORS(
8       I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,       I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
9       O        xA,yA,uTrans,vTrans,wTrans,maskC,maskUp,       O        xA,yA,uTrans,vTrans,rTrans,maskC,maskUp,
10       I        myThid)       I        myThid)
11    
12  C     /==========================================================\  C     /==========================================================\
# Line 18  C     | that are used at various points Line 19  C     | that are used at various points
19  C     | This reduces the amount of total work, total memory      |  C     | This reduces the amount of total work, total memory      |
20  C     | and therefore execution time and is generally a good     |  C     | and therefore execution time and is generally a good     |
21  C     | idea.                                                    |  C     | idea.                                                    |
 C     | We also think lower taxes are a good idea but we doubt   |  
 C     | whether we'll ever get them.                             |  
22  C     \==========================================================/  C     \==========================================================/
23        IMPLICIT NONE        IMPLICIT NONE
24    
# Line 29  C     == GLobal variables == Line 28  C     == GLobal variables ==
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
29  #include "PARAMS.h"  #include "PARAMS.h"
30  #include "GRID.h"  #include "GRID.h"
31    #ifdef ALLOW_NONHYDROSTATIC
32    #include "GW.h"
33    #endif
34    
35  C     == Routine arguments ==  C     == Routine arguments ==
36  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
# Line 37  C     xA      - Tracer cell face area no Line 39  C     xA      - Tracer cell face area no
39  C     yA      - Tracer cell face area normal to X  C     yA      - Tracer cell face area normal to X
40  C     uTrans  - Zonal volume transport through cell face  C     uTrans  - Zonal volume transport through cell face
41  C     vTrans  - Meridional volume transport through cell face  C     vTrans  - Meridional volume transport through cell face
42  C     wTrans  - Vertical volume transport through cell face  C     rTrans  - R-direction volume transport through cell face
43  C     maskC   - land/water mask for tracer points  C     maskC   - land/water mask for tracer points
44  C     maskUp  - land/water mask for Wvel points (above tracer level)  C     maskUp  - land/water mask for Wvel points (above tracer level)
45  C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS  C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS
# Line 47  C Line 49  C
49        _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50        _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52        _RL wTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55  C  C
# Line 60  C     kUp, kDown, kM1 - Index for layer Line 62  C     kUp, kDown, kM1 - Index for layer
62  C                         are switched with layer to be the appropriate index  C                         are switched with layer to be the appropriate index
63  C                         into fluxUD.  C                         into fluxUD.
64        INTEGER i,j        INTEGER i,j
65          LOGICAL TOP_LAYER
66    
67  C--    Calculate tracer cell face open areas        TOP_LAYER = K .EQ. 1
68    
69    C--   Calculate mask for tracer cells  (0 => land, 1 => water)
70        DO j=jMin,jMax        DO j=jMin,jMax
71         DO i=iMin,iMax         DO i=iMin,iMax
72          xA(i,j) = _dyG(i,j,bi,bj)*dzF(k)*_hFacW(i,j,k,bi,bj)          maskC(i,j) = 1.
73          yA(i,j) = _dxG(i,j,bi,bj)*dzF(k)*_hFacS(i,j,k,bi,bj)          IF (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.
74            maskUp(i,j) = 1.
75            IF (_hFacC(i,j,k,bi,bj).eq.0. .OR. TOP_LAYER )
76         &    maskUp(i,j)=0.
77         ENDDO         ENDDO
78        ENDDO        ENDDO
79    
80  C--    Calculate velocity field "volume transports" through  C--   Calculate tracer cell face open areas
 C--    tracer cell faces.  
81        DO j=jMin,jMax        DO j=jMin,jMax
82         DO i=iMin,iMax         DO i=iMin,iMax
83          uTrans(i,j) = uVel(i,j,k,bi,bj)*xA(i,j)          xA(i,j) = _dyG(i,j,bi,bj)
84          vTrans(i,j) = vVel(i,j,k,bi,bj)*yA(i,j)       &   *drF(k)*_hFacW(i,j,k,bi,bj)
85            yA(i,j) = _dxG(i,j,bi,bj)
86         &   *drF(k)*_hFacS(i,j,k,bi,bj)
87         ENDDO         ENDDO
88        ENDDO        ENDDO
89    
90  C--    Calculate vertical "volume transport" through  C--   Calculate velocity field "volume transports" through
91  C--    tracer cell face *above* this level.  C--   tracer cell faces.
92        DO j=jMin,jMax        DO j=jMin,jMax
93         DO i=iMin,iMax         DO i=iMin,iMax
94          wTrans(i,j) = uTrans(i,j)-uTrans(i+1,j)          uTrans(i,j) = uVel(i,j,k,bi,bj)*xA(i,j)
95       &               +vTrans(i,j)-vTrans(i,j+1)          vTrans(i,j) = vVel(i,j,k,bi,bj)*yA(i,j)
      &               +wTrans(i,j)  
96         ENDDO         ENDDO
97        ENDDO        ENDDO
98    
99  C--    Calculate mask for tracer cells  (0 => land, 1 => water)  C--   Calculate vertical "volume transport" through
100    C--   tracer cell face *above* this level.
101        DO j=jMin,jMax        DO j=jMin,jMax
102         DO i=iMin,iMax          DO i=iMin,iMax
103          maskC(i,j) = 1.            rTrans(i,j) = wVel(i,j,k,bi,bj)*rA(i,j,bi,bj)
104          if (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.          ENDDO
         maskUp(i,j) = 1.  
         if (_hFacC(i,j,k,bi,bj).eq.0.) maskUp(i,j)=0.  
        ENDDO  
105        ENDDO        ENDDO
106    
107        RETURN        RETURN
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22