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

Contents of /MITgcm/model/src/calc_adv_flow.F

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


Revision 1.1 - (show annotations) (download)
Tue Nov 19 16:47:53 2013 UTC (10 years, 7 months ago) by jmc
Branch: MAIN
new routine (to replace calc_common_factors.F) to compute
 mass transport from velocity + lateral grid cell area

1 C $Header: /u/gcmpack/MITgcm/model/src/calc_common_factors.F,v 1.22 2006/12/05 05:25:08 jmc Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: CALC_ADV_FLOW
8 C !INTERFACE:
9 SUBROUTINE CALC_ADV_FLOW(
10 I uFld, vFld, wFld,
11 U rTrans,
12 O uTrans, vTrans, rTransKp,
13 O maskUp, xA, yA,
14 I k, bi, bj, myThid )
15 C !DESCRIPTION: \bv
16 C *==========================================================*
17 C | SUBROUTINE CALC_ADV_FLOW
18 C | o Calculate common data (such as volume flux) for use
19 C | by "Right hand side" subroutines.
20 C *==========================================================*
21 C | Here, we calculate terms or spatially varying factors
22 C | that are used at various points in the "RHS" subroutines.
23 C | This reduces the amount of total work, total memory
24 C | and therefore execution time and is generally a good
25 C | idea.
26 C *==========================================================*
27 C \ev
28
29 C !USES:
30 IMPLICIT NONE
31 C == GLobal variables ==
32 #include "SIZE.h"
33 #include "EEPARAMS.h"
34 #include "PARAMS.h"
35 #include "GRID.h"
36
37 C !INPUT/OUTPUT PARAMETERS:
38 C == Routine arguments ==
39 C uFld :: 3-D local copy of horizontal velocity, zonal component
40 C vFld :: 3-D local copy of horizontal velocity, merid. component
41 C wFld :: 3-D local copy of vertical velocity
42 C rTrans :: Vertical volume transport through interface k
43 C uTrans :: Zonal volume transport through cell face
44 C vTrans :: Meridional volume transport through cell face
45 C rTransKp :: Vertical volume transport through interface k+1
46 C maskUp :: Land/water mask for Wvel points (interface k)
47 C xA :: Tracer cell face area normal to X
48 C yA :: Tracer cell face area normal to X
49 C k,bi,bj :: vertical & tile indices for this calculation
50 C myThid :: my Thread Id. number
51
52 _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
53 _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
54 _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
55 _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56 _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
57 _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
58 _RL rTransKp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
59 _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60 _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61 _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62 INTEGER k,bi,bj
63 INTEGER myThid
64
65 C !LOCAL VARIABLES:
66 C == Local variables ==
67 C i, j :: Loop counters
68 INTEGER i,j
69 CEOP
70
71 C-- Calculate tracer cell face open areas
72 DO j=1-OLy,sNy+OLy
73 DO i=1-OLx,sNx+OLx
74 xA(i,j) = _dyG(i,j,bi,bj)*deepFacC(k)
75 & *drF(k)*_hFacW(i,j,k,bi,bj)
76 yA(i,j) = _dxG(i,j,bi,bj)*deepFacC(k)
77 & *drF(k)*_hFacS(i,j,k,bi,bj)
78 ENDDO
79 ENDDO
80
81 C-- copy previous rTrans (input) to output array rTransKp
82 IF ( k.EQ.Nr ) THEN
83 DO j=1-OLy,sNy+OLy
84 DO i=1-OLx,sNx+OLx
85 rTransKp(i,j) = 0. _d 0
86 ENDDO
87 ENDDO
88 ELSE
89 DO j=1-OLy,sNy+OLy
90 DO i=1-OLx,sNx+OLx
91 rTransKp(i,j) = rTrans(i,j)
92 ENDDO
93 ENDDO
94 ENDIF
95
96 C-- Calculate "volume transports" through tracer cell faces.
97 C anelastic: scaled by rhoFacC (~ mass transport)
98 DO j=1-OLy,sNy+OLy
99 DO i=1-OLx,sNx+OLx
100 uTrans(i,j) = uFld(i,j,k)*xA(i,j)*rhoFacC(k)
101 vTrans(i,j) = vFld(i,j,k)*yA(i,j)*rhoFacC(k)
102 ENDDO
103 ENDDO
104
105 C-- Calculate vertical "volume transport" through tracer cell face
106 IF (k.EQ.1) THEN
107 C- Surface interface :
108 DO j=1-OLy,sNy+OLy
109 DO i=1-OLx,sNx+OLx
110 maskUp(i,j) = 0. _d 0
111 rTrans(i,j) = 0. _d 0
112 ENDDO
113 ENDDO
114 ELSE
115 C- Interior interface :
116 C anelastic: rTrans is scaled by rhoFacF (~ mass transport)
117 DO j=1-OLy,sNy+OLy
118 DO i=1-OLx,sNx+OLx
119 maskUp(i,j) = maskC(i,j,k-1,bi,bj)*maskC(i,j,k,bi,bj)
120 rTrans(i,j) = wFld(i,j,k)*rA(i,j,bi,bj)*maskUp(i,j)
121 & *deepFac2F(k)*rhoFacF(k)
122 ENDDO
123 ENDDO
124 ENDIF
125
126 RETURN
127 END

  ViewVC Help
Powered by ViewVC 1.1.22