/[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.6 by cnh, Mon Jun 8 21:43:00 1998 UTC revision 1.11 by adcroft, Mon Mar 22 15:54:03 1999 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    
3  #include "CPP_EEOPTIONS.h"  #include "CPP_OPTIONS.h"
4    
5  CStartOfInterFace  CStartOfInterFace
6        SUBROUTINE CALC_COMMON_FACTORS(        SUBROUTINE CALC_COMMON_FACTORS(
7       I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,       I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
8       O        xA,yA,uTrans,vTrans,wTrans,wVel,maskC,maskUp,       O        xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp,
9       I        myThid)       I        myThid)
10    
11  C     /==========================================================\  C     /==========================================================\
# Line 18  C     | that are used at various points Line 18  C     | that are used at various points
18  C     | This reduces the amount of total work, total memory      |  C     | This reduces the amount of total work, total memory      |
19  C     | and therefore execution time and is generally a good     |  C     | and therefore execution time and is generally a good     |
20  C     | idea.                                                    |  C     | idea.                                                    |
 C     | We also think lower taxes are a good idea but we doubt   |  
 C     | whether we'll ever get them.                             |  
21  C     \==========================================================/  C     \==========================================================/
22        IMPLICIT NONE        IMPLICIT NONE
23    
# Line 29  C     == GLobal variables == Line 27  C     == GLobal variables ==
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "PARAMS.h"  #include "PARAMS.h"
29  #include "GRID.h"  #include "GRID.h"
30    #ifdef ALLOW_NONHYDROSTATIC
31    #include "GW.h"
32    #endif
33    
34  C     == Routine arguments ==  C     == Routine arguments ==
35  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 38  C     xA      - Tracer cell face area no
38  C     yA      - Tracer cell face area normal to X  C     yA      - Tracer cell face area normal to X
39  C     uTrans  - Zonal volume transport through cell face  C     uTrans  - Zonal volume transport through cell face
40  C     vTrans  - Meridional volume transport through cell face  C     vTrans  - Meridional volume transport through cell face
41  C     wTrans  - Vertical volume transport through cell face  C     rTrans  - R-direction volume transport through cell face
42  C     wVel    - Vertical velocity at cell upper and lower faces  C     rVel    - R-direction velocity at cell upper and lower faces
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 48  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        _RL wVel  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL rVel  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
54        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56  C  C
# Line 66  C                         into fluxUD. Line 67  C                         into fluxUD.
67    
68        TOP_LAYER = K .EQ. 1        TOP_LAYER = K .EQ. 1
69    
70    C--   Calculate mask for tracer cells  (0 => land, 1 => water)
71          DO j=jMin,jMax
72           DO i=iMin,iMax
73            maskC(i,j) = 1.
74            IF (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.
75            maskUp(i,j) = 1.
76            IF (_hFacC(i,j,k,bi,bj).eq.0. .OR. TOP_LAYER )
77         &    maskUp(i,j)=0.
78           ENDDO
79          ENDDO
80    
81  C--   Calculate tracer cell face open areas  C--   Calculate tracer cell face open areas
82        DO j=jMin,jMax        DO j=jMin,jMax
83         DO i=iMin,iMax         DO i=iMin,iMax
84          xA(i,j) = _dyG(i,j,bi,bj)*dzF(k)*_hFacW(i,j,k,bi,bj)          xA(i,j) = _dyG(i,j,bi,bj)
85          yA(i,j) = _dxG(i,j,bi,bj)*dzF(k)*_hFacS(i,j,k,bi,bj)       &   *drF(k)*_hFacW(i,j,k,bi,bj)
86            yA(i,j) = _dxG(i,j,bi,bj)
87         &   *drF(k)*_hFacS(i,j,k,bi,bj)
88         ENDDO         ENDDO
89        ENDDO        ENDDO
90    
# Line 85  C--   tracer cell faces. Line 99  C--   tracer cell faces.
99    
100  C--   Calculate vertical "volume transport" through  C--   Calculate vertical "volume transport" through
101  C--   tracer cell face *above* this level.  C--   tracer cell face *above* this level.
102        DO j=jMin,jMax        IF (TOP_LAYER .AND. rigidLid) THEN
103         DO i=iMin,iMax         DO j=jMin,jMax
104          wTrans(i,j) = uTrans(i,j)-uTrans(i+1,j)          DO i=iMin,iMax
105       &               +vTrans(i,j)-vTrans(i,j+1)           rTrans(i,j) = 0.
106       &               +wTrans(i,j)          ENDDO
107         ENDDO         ENDDO
108        ENDDO        ELSE
109           DO j=jMin,jMax
110            DO i=iMin,iMax
111             rTrans(i,j) =
112         &    uTrans(i,j)*recip_rkFac-uTrans(i+1,j)*recip_rkFac
113         &   +vTrans(i,j)*recip_rkFac-vTrans(i,j+1)*recip_rkFac
114         &   +rTrans(i,j)
115            ENDDO
116           ENDDO
117          ENDIF
118    
119  C--   Vertical velocity at upper face  C--   Vertical velocity at upper face
120        DO j=jMin,jMax        DO j=jMin,jMax
121         DO i=iMin,iMax         DO i=iMin,iMax
122          wVel(i,j,kUp) = wTrans(i,j)/_zA(i,j,bi,bj)          rVel(i,j,kUp) = rTrans(i,j)/_rA(i,j,bi,bj)
123         ENDDO         ENDDO
124        ENDDO        ENDDO
125    
126  C--    Calculate mask for tracer cells  (0 => land, 1 => water)  #ifdef ALLOW_NONHYDROSTATIC
127        DO j=jMin,jMax  C--   Vertical velocity at upper face
128         DO i=iMin,iMax  C     IF ( nonHydrostatic ) THEN
129          maskC(i,j) = 1.          DO j=jMin,jMax
130          if (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.           DO i=iMin,iMax
131          maskUp(i,j) = 1.            wVel(i,j,k,bi,bj)=rVel(i,j,kUp)
132          if (_hFacC(i,j,k,bi,bj).eq.0. .or. TOP_LAYER ) maskUp(i,j)=0.           ENDDO
133         ENDDO          ENDDO
134        ENDDO  C     ENDIF
135    #endif
136    
137        RETURN        RETURN
138        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22