/[MITgcm]/MITgcm_contrib/dcarroll/highres_darwin/code/shelfice_forcing.F
ViewVC logotype

Contents of /MITgcm_contrib/dcarroll/highres_darwin/code/shelfice_forcing.F

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


Revision 1.1 - (show annotations) (download)
Sun Sep 22 21:23:47 2019 UTC (5 years, 10 months ago) by dcarroll
Branch: MAIN
CVS Tags: HEAD
Initial check in of high resolution Darwin simulation code

1 C $Header: /u/gcmpack/MITgcm/pkg/shelfice/shelfice_forcing.F,v 1.6 2015/04/22 13:12:19 dgoldberg Exp $
2 C $Name: $
3
4 #include "SHELFICE_OPTIONS.h"
5
6 C-- File shelfice_forcing.F:
7 C-- Contents
8 C-- o SHELFICE_FORCING_T
9 C-- o SHELFICE_FORCING_S
10
11 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
12 CBOP
13 C !ROUTINE: SHELFICE_FORCING_T
14 C !INTERFACE:
15 SUBROUTINE SHELFICE_FORCING_T(
16 U gT_arr,
17 I iMin,iMax,jMin,jMax, kLev, bi, bj,
18 I myTime, myIter, myThid )
19
20 C !DESCRIPTION: \bv
21 C *==========================================================*
22 C | S/R SHELFICE_FORCING_T
23 C | o Contains problem specific forcing for temperature.
24 C *==========================================================*
25 C | Adds terms to gT for forcing by shelfice sources
26 C | e.g. heat flux
27 C *==========================================================*
28 C \ev
29
30 C !USES:
31 IMPLICIT NONE
32 C == Global data ==
33 #include "SIZE.h"
34 #include "EEPARAMS.h"
35 #include "PARAMS.h"
36 #include "GRID.h"
37 c#include "DYNVARS.h"
38 c#include "FFIELDS.h"
39 #include "SHELFICE.h"
40
41 C !INPUT/OUTPUT PARAMETERS:
42 C gT_arr :: the tendency array
43 C iMin,iMax :: Working range of x-index for applying forcing.
44 C jMin,jMax :: Working range of y-index for applying forcing.
45 C kLev :: Current vertical level index
46 C bi,bj :: Current tile indices
47 C myTime :: Current time in simulation
48 C myIter :: Current iteration number
49 C myThid :: my Thread Id number
50 _RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51 INTEGER iMin, iMax, jMin, jMax
52 INTEGER kLev, bi, bj
53 _RL myTime
54 INTEGER myIter
55 INTEGER myThid
56
57 #ifdef ALLOW_SHELFICE
58 C !LOCAL VARIABLES:
59 C == Local variables ==
60 C i,j :: Loop counters
61 C kp1,km1 :: index of next/previous level
62 C gTloc :: local tendency in boundary layer
63 C drLoc :: fractional cell width of boundary layer in (k+/-1)th layer
64 INTEGER i, j
65 INTEGER Kp1, Km1
66 _RS drLoc
67 _RL gTloc
68 CEOP
69
70 C-- Forcing term
71 IF ( SHELFICEboundaryLayer ) THEN
72 DO j=1,sNy
73 DO i=1,sNx
74 IF ( kLev .LT. Nr .AND. kLev .EQ. kTopC(I,J,bi,bj) ) THEN
75 kp1 = MIN(kLev+1,Nr)
76 drLoc = drF(kLev)*( 1. _d 0 - _hFacC(I,J,kLev,bi,bj) )
77 drLoc = MIN( drLoc, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) )
78 drLoc = MAX( drLoc, 0. _d 0)
79 gTloc = shelficeForcingT(i,j,bi,bj)
80 & /( drF(kLev)*_hFacC(I,J,kLev,bi,bj)+drLoc )
81 gT_arr(i,j) = gT_arr(i,j) + gTloc
82 ELSEIF ( kLev .GT. 1 .AND. kLev-1 .EQ. kTopC(I,J,bi,bj) ) THEN
83 km1 = MAX(kLev-1,1)
84 drLoc = drF(km1)*( 1. _d 0 - _hFacC(I,J,km1,bi,bj) )
85 drLoc = MIN( drLoc, drF(kLev) * _hFacC(I,J,kLev,bi,bj) )
86 drLoc = MAX( drLoc, 0. _d 0)
87 gTloc = shelficeForcingT(i,j,bi,bj)
88 & /( drF(km1)*_hFacC(I,J,km1,bi,bj)+drLoc )
89 C The following is shorthand for the averaged tendency:
90 C gT(k+1) = gT(k+1) + { gTloc * [drF(k)*(1-hFacC(k))]
91 C + 0 * [drF(k+1) - drF(k)*(1-hFacC(k))]
92 C }/[drF(k+1)*hFacC(k+1)]
93 gT_arr(i,j) = gT_arr(i,j) + gTloc
94 & * drLoc*recip_drF(kLev)* _recip_hFacC(i,j,kLev,bi,bj)
95 ENDIF
96 ENDDO
97 ENDDO
98 ENDIF
99
100 #ifdef shelfice_new_thermo
101 DO j=1,sNy
102 DO i=1,sNx
103 C-- TENDENCY FROM ICE FRONT
104 gT_arr(i,j) = gT_arr(i,j) + iceFrontForcingT(i,j,kLev,bi,bj)
105
106 C-- TENDENCY FROM ICE SHELF
107 IF ( kLev .EQ. kTopC(I,J,bi,bj) ) THEN
108 gT_arr(i,j) = gT_arr(i,j) + shelficeForcingT(i,j,bi,bj)
109 ENDIF
110 ENDDO
111 ENDDO
112 #endif /* shelfice_new_thermo */
113
114 #endif /* ALLOW_SHELFICE */
115 RETURN
116 END
117
118 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
119 CBOP
120 C !ROUTINE: SHELFICE_FORCING_S
121 C !INTERFACE:
122 SUBROUTINE SHELFICE_FORCING_S(
123 U gS_arr,
124 I iMin,iMax,jMin,jMax, kLev, bi, bj,
125 I myTime, myIter, myThid )
126
127 C !DESCRIPTION: \bv
128 C *==========================================================*
129 C | S/R SHELFICE_FORCING_S
130 C | o Contains problem specific forcing for merid velocity.
131 C *==========================================================*
132 C | Adds terms to gS for forcing by shelfice sources
133 C | e.g. fresh-water flux (virtual salt flux).
134 C *==========================================================*
135 C \ev
136
137 C !USES:
138 IMPLICIT NONE
139 C == Global data ==
140 #include "SIZE.h"
141 #include "EEPARAMS.h"
142 #include "PARAMS.h"
143 #include "GRID.h"
144 c#include "DYNVARS.h"
145 c#include "FFIELDS.h"
146 #include "SHELFICE.h"
147
148 C !INPUT/OUTPUT PARAMETERS:
149 C gS_arr :: the tendency array
150 C iMin,iMax :: Working range of x-index for applying forcing.
151 C jMin,jMax :: Working range of y-index for applying forcing.
152 C kLev :: Current vertical level index
153 C bi,bj :: Current tile indices
154 C myTime :: Current time in simulation
155 C myIter :: Current iteration number
156 C myThid :: my Thread Id number
157 _RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
158 INTEGER iMin, iMax, jMin, jMax
159 INTEGER kLev, bi, bj
160 _RL myTime
161 INTEGER myIter
162 INTEGER myThid
163
164 #ifdef ALLOW_SHELFICE
165 C !LOCAL VARIABLES:
166 C i,j :: Loop counters
167 C kp/m1 :: index of next/previous level
168 C gTloc :: local tendency in boundary layer
169 C drLoc :: fractional cell width of boundary layer
170 INTEGER i, j
171 INTEGER Kp1, Km1
172 _RS drLoc
173 _RL gSloc
174 CEOP
175
176 C-- Forcing term
177 IF ( SHELFICEboundaryLayer ) THEN
178 DO j=1,sNy
179 DO i=1,sNx
180 IF ( kLev .LT. Nr .AND. kLev .EQ. kTopC(I,J,bi,bj) ) THEN
181 kp1 = MIN(kLev+1,Nr)
182 drLoc = drF(kLev)*( 1. _d 0 - _hFacC(I,J,kLev,bi,bj) )
183 drLoc = MIN( drLoc, drF(Kp1) * _hFacC(I,J,Kp1,bi,bj) )
184 drLoc = MAX( drLoc, 0. _d 0)
185 gSloc = shelficeForcingS(i,j,bi,bj)
186 & /( drF(kLev)*_hFacC(I,J,kLev,bi,bj)+drLoc )
187 gS_arr(i,j) = gS_arr(i,j) + gSloc
188 ELSEIF ( kLev .GT. 1 .AND. kLev-1 .EQ. kTopC(I,J,bi,bj) ) THEN
189 km1 = MAX(kLev-1,1)
190 drLoc = drF(km1)*( 1. _d 0 - _hFacC(I,J,km1,bi,bj) )
191 drLoc = MIN( drLoc, drF(kLev) * _hFacC(I,J,kLev,bi,bj) )
192 drLoc = MAX( drLoc, 0. _d 0)
193 gSloc = shelficeForcingS(i,j,bi,bj)
194 & /( drF(km1)*_hFacC(I,J,km1,bi,bj)+drLoc )
195 C The following is shorthand for the averaged tendency:
196 C gS(k+1) = gS(k+1) + { gSloc * [drF(k)*(1-hFacC(k))]
197 C + 0 * [drF(k+1) - drF(k)*(1-hFacC(k))]
198 C }/[drF(k+1)*hFacC(k+1)]
199 gS_arr(i,j) = gS_arr(i,j) + gSloc
200 & * drLoc*recip_drF(kLev)* _recip_hFacC(i,j,kLev,bi,bj)
201 ENDIF
202 ENDDO
203 ENDDO
204 ENDIF
205
206 #ifdef shelfice_new_thermo
207 DO j=1,sNy
208 DO i=1,sNx
209 C-- TENDENCY FROM ICE FRONT
210 gS_arr(i,j) = gS_arr(i,j) + iceFrontForcingS(i,j,kLev,bi,bj)
211 C-- TENDENCY FROM ICE SHELF
212 IF ( kLev .EQ. kTopC(I,J,bi,bj) ) THEN
213 gS_arr(i,j) = gS_arr(i,j) + shelficeForcingS(i,j,bi,bj)
214 ENDIF
215 ENDDO
216 ENDDO
217 #endif /* shelfice_new_thermo */
218
219 #endif /* ALLOW_SHELFICE */
220 RETURN
221 END
222 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
223 CBOP
224 C !ROUTINE: SHELFICE_FORCING_TR
225 C !INTERFACE:
226 SUBROUTINE SHELFICE_FORCING_TR(
227 O gTR_arr,
228 I ptracerFlag,
229 I iMin,iMax,jMin,jMax, kLev, bi, bj,
230 I myTime, myIter, myThid )
231
232 C !DESCRIPTION: \bv
233 C *==========================================================*
234 C | S/R SHELFICE_FORCING_TR
235 C | o Contains problem specific forcing for merid velocity.
236 C *==========================================================*
237 C | Adds terms to ptracers for forcing by shelfice sources
238 C *==========================================================*
239 C \ev
240
241 C !USES:
242 IMPLICIT NONE
243 C == Global data ==
244 #include "SIZE.h"
245 #include "EEPARAMS.h"
246 #include "PARAMS.h"
247 #include "GRID.h"
248 c#include "DYNVARS.h"
249 c#include "FFIELDS.h"
250 #include "SHELFICE.h"
251
252 C !INPUT/OUTPUT PARAMETERS:
253 C gT_arr :: the tendency array
254 C iMin,iMax :: Working range of x-index for applying forcing.
255 C jMin,jMax :: Working range of y-index for applying forcing.
256 C kLev :: Current vertical level index
257 C bi,bj :: Current tile indices
258 C myTime :: Current time in simulation
259 C myIter :: Current iteration number
260 C myThid :: my Thread Id number
261 INTEGER iMin, iMax, jMin, jMax
262 INTEGER kLev, bi, bj
263 _RL myTime
264 INTEGER myIter
265 INTEGER myThid
266 INTEGER ptracerFlag
267
268 #ifdef ALLOW_SHELFICE
269 C !LOCAL VARIABLES:
270 C i,j :: Loop counters
271 INTEGER i, j
272 INTEGER maxIceFront
273 _RL gTR_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
274 _RL iceFrontForcingTRLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
275 _RL shelficeForcingTRLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
276 CEOP
277
278 maxIceFront = 0. _d 0
279
280 DO j=1,sNy
281 DO i=1,sNx
282
283 gTr_arr(i,j) = 0. _d 0
284
285 maxIceFront = MAX(K_icefront(i,j,bi,bj),
286 & maxIceFront)
287
288 ENDDO
289 ENDDO
290
291 #ifdef shelfice_new_thermo
292 DO j=1,sNy
293 DO i=1,sNx
294
295 iceFrontForcingTRLoc(i,j) = ABS(MIN(
296 & iceFrontForcingTR(i,j,kLev,bi,bj), 0. _d 0))
297
298 shelficeForcingTRLoc = ABS(MIN(
299 & shelficeForcingTR(i,j,bi,bj), 0. _d 0))
300
301 C do icefront only
302 if(ptracerFlag .EQ. 1. _d 0) then
303 if(kLev .LE. maxIceFront) then
304
305 gTR_arr(i,j) = iceFrontForcingTRLoc(i,j) /
306 & drF(kLev)
307
308 else
309
310 gTR_arr(i,j) = 0. _d 0
311
312 endif
313 endif
314
315 C do shelfice only
316
317 if(ptracerFlag .EQ. 2. _d 0) then
318 if (kLev .EQ. kTopC(I,J,bi,bj)) then
319
320 gTR_arr(i,j) = shelficeForcingTRLoc(i,j) /
321 & drF(kLev)
322
323 else
324
325 gTR_arr(i,j) = 0. _d 0
326
327 endif
328 endif
329
330 C do icefront and shelfice
331 if(ptracerFlag .EQ. 3. _d 0) then
332 if(kLev .LE. maxIceFront) then
333
334 gTR_arr(i,j) = iceFrontForcingTRLoc(i,j) /
335 & drF(kLev)
336
337 else if(kLev .EQ. kTopC(I,J,bi,bj)) then
338
339 gTR_arr(i,j) = gTR_arr(i,j) +
340 & shelficeForcingTRLoc(i,j)/drF(kLev)
341
342 else
343
344 gTR_arr(i,j) = 0. _d 0
345
346 endif
347 endif
348
349 ENDDO
350 ENDDO
351 #endif /* shelfice_new_thermo */
352
353 #endif /* ALLOW_SHELFICE */
354 RETURN
355 END

  ViewVC Help
Powered by ViewVC 1.1.22