-
Notifications
You must be signed in to change notification settings - Fork 237
/
dwnslp_calc_flow.F
171 lines (147 loc) · 5.3 KB
/
dwnslp_calc_flow.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
#include "DWNSLP_OPTIONS.h"
CBOP
C !ROUTINE: DWNSLP_CALC_FLOW
C !INTERFACE:
SUBROUTINE DWNSLP_CALC_FLOW(
I bi, bj, kBottom, rho3d,
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | SUBROUTINE DWNSLP_CALC_FLOW
C | o Detect active site of Down-Sloping flow and compute
C | the corresponding volume transport
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DWNSLP_SIZE.h"
#include "DWNSLP_PARAMS.h"
#include "DWNSLP_VARS.h"
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C bi,bj :: Tile indices
C kBottom :: Vertical index of bottom grid cell.
C rho3d :: In-situ density [kg/m3] computed at z=rC ;
C myTime :: Current time in simulation
C myIter :: Current time-step number
C myThid :: my Thread Id number
INTEGER bi, bj
INTEGER kBottom( xySize, nSx,nSy )
_RL rho3d ( xySize, Nr,nSx,nSy )
_RL myTime
INTEGER myIter, myThid
#ifdef ALLOW_DOWN_SLOPE
C !LOCAL VARIABLES:
C === Local variables ===
C msgBuf :: Informational/error message buffer
C ijd :: horiz. index of deep water column receiving dense water flow
C ijs :: horiz. index of shallow water column (e.g. shelf)
C from which dense water flow originates
c CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER k
INTEGER n, ijd, ijr, ijs
INTEGER kdeep, ishelf, jshelf, kshelf
_RL dRhoH
INTEGER downward
#ifdef ALLOW_DIAGNOSTICS
LOGICAL doDiagDwnSlpFlow
INTEGER ij
_RL sgnFac
_RL uFlow( xySize )
_RL vFlow( xySize )
C- Functions:
LOGICAL DIAGNOSTICS_IS_ON
EXTERNAL DIAGNOSTICS_IS_ON
#endif /* ALLOW_DIAGNOSTICS */
CEOP
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
c downward = rkSign*NINT(gravitySign)
downward = 1
IF ( usingPCoords ) downward = -1
#ifdef ALLOW_DIAGNOSTICS
IF ( useDiagnostics ) THEN
doDiagDwnSlpFlow = DIAGNOSTICS_IS_ON( 'DSLPuFlw', myThid )
& .OR. DIAGNOSTICS_IS_ON( 'DSLPvFlw', myThid )
IF ( doDiagDwnSlpFlow ) THEN
DO ij=1,xySize
uFlow(ij) = 0. _d 0
vFlow(ij) = 0. _d 0
ENDDO
ENDIF
ELSE
doDiagDwnSlpFlow = .FALSE.
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
DO n=1,DWNSLP_NbSite(bi,bj)
DWNSLP_deepK(n,bi,bj) = 0
C- detect density gradient along the slope => Downsloping flow
ijd = DWNSLP_ijDeep(n,bi,bj)
ijr = DWNSLP_shVsD(n,bi,bj)
ijs = ijd + ijr
kshelf = kBottom(ijs,bi,bj)
dRhoH = rho3d(ijs,kshelf,bi,bj)
& -rho3d(ijd,kshelf,bi,bj)
c IF ( dRhoH.GT.0. _d 0 ) THEN
IF ( rho3d(ijs,kshelf+1,bi,bj).GT.rho3d(ijd,kshelf+1,bi,bj)
& .AND. dRhoH.GT.0. _d 0 ) THEN
C- search for deepest level where Rho_shelf > Rho_deep
kdeep = kshelf
DO k=kshelf+1,kBottom(ijd,bi,bj),downward
IF ( rho3d(ijs,k,bi,bj).GT.rho3d(ijd,k,bi,bj) ) kdeep = k
ENDDO
DWNSLP_deepK(n,bi,bj) = kdeep
C- Compute the Volume Transport :
C- same formulation as described in the paper:
c downslpFlow = DWNSLP_gamma/mu *gravity*dRhoH*recip_rhoConst
C with DWNSLP_Gamma = slope * effective cross-section area
DWNSLP_Transp(n,bi,bj) = DWNSLP_Gamma(n,bi,bj)
& *DWNSLP_rec_mu*gravity*dRhoH*recip_rhoConst
#ifdef ALLOW_DIAGNOSTICS
IF ( doDiagDwnSlpFlow ) THEN
ij = MAX( ijd, ijs )
sgnFac = SIGN(1,-ijr)
IF ( ABS(ijr).EQ.1 ) THEN
uFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
ELSE
vFlow(ij) = sgnFac*DWNSLP_Transp(n,bi,bj)
ENDIF
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
ENDIF
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
ENDDO
IF ( DWNSLP_ioUnit.GT.0 ) THEN
_BEGIN_MASTER(myThid)
WRITE(DWNSLP_ioUnit,'(A,I8,2I4)')
& ' DWNSLP_CALC_FLOW: iter,bi,bj=',myIter,bi,bj
WRITE(DWNSLP_ioUnit,'(A)')
& ' bi bj n : ijd ijr is js ; ks kd-s Transp :'
DO n=1,DWNSLP_NbSite(bi,bj)
IF (DWNSLP_deepK(n,bi,bj).NE.0) THEN
ijs = DWNSLP_ijDeep(n,bi,bj) + DWNSLP_shVsD(n,bi,bj)
ishelf = 1-OLx + mod(ijs-1,xSize)
jshelf = 1-OLy + (ijs-1)/xSize
kshelf = kBottom(ijs,bi,bj)
WRITE(DWNSLP_ioUnit,'(2I4,I6,A,I8,I6,2I4,A,2I4,1PE14.6)')
& bi,bj,n,' :', DWNSLP_ijDeep(n,bi,bj),
& DWNSLP_shVsD(n,bi,bj), ishelf,jshelf,
& ' ;', kshelf, DWNSLP_deepK(n,bi,bj)-kshelf,
& DWNSLP_Transp(n,bi,bj)
ENDIF
ENDDO
WRITE(DWNSLP_ioUnit,*)
_END_MASTER(myThid)
ENDIF
#ifdef ALLOW_DIAGNOSTICS
IF ( doDiagDwnSlpFlow ) THEN
CALL DIAGNOSTICS_FILL( uFlow, 'DSLPuFlw', 0,1,2,bi,bj,myThid )
CALL DIAGNOSTICS_FILL( vFlow, 'DSLPvFlw', 0,1,2,bi,bj,myThid )
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
#endif /* ALLOW_DOWN_SLOPE */
RETURN
END