model/src/calc_common_factors.F

C $Header: /u/gcmpack/models/MITgcmUV/model/src/calc_common_factors.F,v 1.8 1998/08/22 17:51:07 cnh Exp $

#include "CPP_EEOPTIONS.h"

CStartOfInterFace
      SUBROUTINE CALC_COMMON_FACTORS( 
     I        bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
     O        xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp,
     I        myThid)

C     /==========================================================\
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     \==========================================================/
      IMPLICIT NONE

C     == GLobal variables ==
#include "SIZE.h"
#include "DYNVARS.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"

C     == Routine arguments ==
C     bi, bj, iMin, iMax, jMin, jMax - Range of points for which calculation
C                                      results will be set.
C     xA      - Tracer cell face area normal to X
C     yA      - Tracer cell face area normal to X
C     uTrans  - Zonal volume transport through cell face
C     vTrans  - Meridional volume transport through cell face
C     rTrans  - R-direction volume transport through cell face
C     rVel    - R-direction velocity at cell upper and lower faces
C     maskC   - land/water mask for tracer points
C     maskUp  - land/water mask for Wvel points (above tracer level)
C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS
C
      INTEGER bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown
      _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RS yA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RL rVel  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
      _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
C
      INTEGER myThid
CEndOfInterface

C     == Local variables ==
C     I, J, K - 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.
      INTEGER i,j
      LOGICAL TOP_LAYER

      TOP_LAYER = K .EQ. 1

C--   Calculate tracer cell face open areas
      DO j=jMin,jMax
       DO i=iMin,iMax
        xA(i,j) = _dyG(i,j,bi,bj)
     &   *drF(k)*_hFacW(i,j,k,bi,bj)
        yA(i,j) = _dxG(i,j,bi,bj)
     &   *drF(k)*_hFacS(i,j,k,bi,bj)
       ENDDO
      ENDDO

C--   Calculate velocity field "volume transports" through
C--   tracer cell faces.
      DO j=jMin,jMax
       DO i=iMin,iMax
        uTrans(i,j) = uVel(i,j,k,bi,bj)*xA(i,j)
        vTrans(i,j) = vVel(i,j,k,bi,bj)*yA(i,j)
       ENDDO
      ENDDO

C--   Calculate vertical "volume transport" through
C--   tracer cell face *above* this level.
      DO j=jMin,jMax
       DO i=iMin,iMax
        rTrans(i,j) = 
     &   uTrans(i,j)*recip_rkFac-uTrans(i+1,j)*recip_rkFac
     &  +vTrans(i,j)*recip_rkFac-vTrans(i,j+1)*recip_rkFac
     &  +rTrans(i,j)
       ENDDO
      ENDDO

C--   Vertical velocity at upper face
      DO j=jMin,jMax
       DO i=iMin,iMax
        rVel(i,j,kUp) = rTrans(i,j)/_rA(i,j,bi,bj)
       ENDDO
      ENDDO

C--    Calculate mask for tracer cells  (0 => land, 1 => water)
      DO j=jMin,jMax
       DO i=iMin,iMax
        maskC(i,j) = 1.
        if (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.
        maskUp(i,j) = 1.
        if (_hFacC(i,j,k,bi,bj).eq.0. .or. TOP_LAYER ) 
     &   maskUp(i,j)=0.
       ENDDO
      ENDDO

      RETURN
      END
1	C $Header: /u/gcmpack/models/MITgcmUV/model/src/calc_common_factors.F,v 1.8 1998/08/22 17:51:07 cnh Exp $
2
3	#include "CPP_EEOPTIONS.h"
4
5	CStartOfInterFace
6	SUBROUTINE CALC_COMMON_FACTORS(
7	I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
8	O xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp,
9	I myThid)
10
11	C /==========================================================\
12	C \| SUBROUTINE CALC_COMMON_FACTORS \|
13	C \| o Calculate common data (such as volume flux) for use \|
14	C \| by "Right hand side" subroutines. \|
15	C \|==========================================================\|
16	C \| Here, we calculate terms or spatially varying factors \|
17	C \| that are used at various points in the "RHS" subroutines.\|
18	C \| This reduces the amount of total work, total memory \|
19	C \| and therefore execution time and is generally a good \|
20	C \| idea. \|
21	C \==========================================================/
22	IMPLICIT NONE
23
24	C == GLobal variables ==
25	#include "SIZE.h"
26	#include "DYNVARS.h"
27	#include "EEPARAMS.h"
28	#include "PARAMS.h"
29	#include "GRID.h"
30
31	C == Routine arguments ==
32	C bi, bj, iMin, iMax, jMin, jMax - Range of points for which calculation
33	C results will be set.
34	C xA - Tracer cell face area normal to X
35	C yA - Tracer cell face area normal to X
36	C uTrans - Zonal volume transport through cell face
37	C vTrans - Meridional volume transport through cell face
38	C rTrans - R-direction volume transport through cell face
39	C rVel - R-direction velocity at cell upper and lower faces
40	C maskC - land/water mask for tracer points
41	C maskUp - land/water mask for Wvel points (above tracer level)
42	C myThid - Instance number for this innvocation of CALC_COMMON_FACTORS
43	C
44	INTEGER bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown
45	_RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
46	_RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47	_RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48	_RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49	_RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50	_RL rVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
51	_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52	_RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
53	C
54	INTEGER myThid
55	CEndOfInterface
56
57	C == Local variables ==
58	C I, J, K - Loop counters
59	C kUp, kDown, kM1 - Index for layer above and below. K_UP and K_DOWN
60	C are switched with layer to be the appropriate index
61	C into fluxUD.
62	INTEGER i,j
63	LOGICAL TOP_LAYER
64
65	TOP_LAYER = K .EQ. 1
66
67	C-- Calculate tracer cell face open areas
68	DO j=jMin,jMax
69	DO i=iMin,iMax
70	xA(i,j) = _dyG(i,j,bi,bj)
71	& drF(k)_hFacW(i,j,k,bi,bj)
72	yA(i,j) = _dxG(i,j,bi,bj)
73	& drF(k)_hFacS(i,j,k,bi,bj)
74	ENDDO
75	ENDDO
76
77	C-- Calculate velocity field "volume transports" through
78	C-- tracer cell faces.
79	DO j=jMin,jMax
80	DO i=iMin,iMax
81	uTrans(i,j) = uVel(i,j,k,bi,bj)*xA(i,j)
82	vTrans(i,j) = vVel(i,j,k,bi,bj)*yA(i,j)
83	ENDDO
84	ENDDO
85
86	C-- Calculate vertical "volume transport" through
87	C-- tracer cell face above this level.
88	DO j=jMin,jMax
89	DO i=iMin,iMax
90	rTrans(i,j) =
91	& uTrans(i,j)recip_rkFac-uTrans(i+1,j)recip_rkFac
92	& +vTrans(i,j)recip_rkFac-vTrans(i,j+1)recip_rkFac
93	& +rTrans(i,j)
94	ENDDO
95	ENDDO
96
97	C-- Vertical velocity at upper face
98	DO j=jMin,jMax
99	DO i=iMin,iMax
100	rVel(i,j,kUp) = rTrans(i,j)/_rA(i,j,bi,bj)
101	ENDDO
102	ENDDO
103
104	C-- Calculate mask for tracer cells (0 => land, 1 => water)
105	DO j=jMin,jMax
106	DO i=iMin,iMax
107	maskC(i,j) = 1.
108	if (_hFacC(i,j,k,bi,bj).eq.0.) maskC(i,j)=0.
109	maskUp(i,j) = 1.
110	if (_hFacC(i,j,k,bi,bj).eq.0. .or. TOP_LAYER )
111	& maskUp(i,j)=0.
112	ENDDO
113	ENDDO
114
115	RETURN
116	END