1 |
C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_seaice_sponge.F,v 1.1 2012/09/20 19:04:46 dimitri Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "OBCS_OPTIONS.h" |
5 |
|
6 |
C-- File obcs_seaice_sponge.F: |
7 |
C-- Contents: |
8 |
C-- o OBCS_SEAICE_SPONGE_A |
9 |
C-- o OBCS_SEAICE_SPONGE_H |
10 |
C-- o OBCS_SEAICE_SPONGE_SL |
11 |
C-- o OBCS_SEAICE_SPONGE_SN |
12 |
|
13 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
14 |
|
15 |
CStartOfInterface |
16 |
SUBROUTINE OBCS_SEAICE_SPONGE_A( myThid ) |
17 |
C *==========================================================* |
18 |
C | S/R OBCS_SEAICE_SPONGE_A |
19 |
C | Adds a relaxation term to AREA near Open-Boundaries |
20 |
C *==========================================================* |
21 |
IMPLICIT NONE |
22 |
|
23 |
C == Global data == |
24 |
#include "SIZE.h" |
25 |
#include "EEPARAMS.h" |
26 |
#include "PARAMS.h" |
27 |
#include "GRID.h" |
28 |
#include "DYNVARS.h" |
29 |
#include "OBCS_PARAMS.h" |
30 |
#include "OBCS_GRID.h" |
31 |
#include "OBCS_FIELDS.h" |
32 |
#include "OBCS_SEAICE.h" |
33 |
#ifdef ALLOW_SEAICE |
34 |
# include "SEAICE_SIZE.h" |
35 |
# include "SEAICE_PARAMS.h" |
36 |
# include "SEAICE.h" |
37 |
#endif |
38 |
|
39 |
C == Routine arguments == |
40 |
INTEGER myThid |
41 |
CEndOfInterface |
42 |
|
43 |
#if (defined(ALLOW_OBCS) && defined(ALLOW_SEAICE) && defined(ALLOW_OBCS_SEAICE_SPONGE)) |
44 |
C == Local variables == |
45 |
C Loop counters |
46 |
INTEGER bi, bj, i, j, isl, jsl |
47 |
_RL lambda_obcs |
48 |
|
49 |
IF ( useSeaiceSponge .AND. seaiceSpongeThickness.NE.0 ) THEN |
50 |
DO bj=myByLo(myThid),myByHi(myThid) |
51 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
52 |
|
53 |
C Northern Open Boundary |
54 |
# ifdef ALLOW_OBCS_NORTH |
55 |
IF ( tileHasOBN(bi,bj) ) THEN |
56 |
DO i=1,sNx |
57 |
IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN |
58 |
DO jsl= 1,seaiceSpongeThickness |
59 |
j=OB_Jn(i,bi,bj)-jsl |
60 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
61 |
lambda_obcs = ( |
62 |
& float(seaiceSpongeThickness-jsl)*Arelaxobcsbound |
63 |
& + float(jsl-1)*Arelaxobcsinner) |
64 |
& / float(seaiceSpongeThickness-1) |
65 |
IF (lambda_obcs.ne.0.) THEN |
66 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
67 |
ELSE |
68 |
lambda_obcs = 0. _d 0 |
69 |
ENDIF |
70 |
AREA(i,j,bi,bj) = AREA(i,j,bi,bj) |
71 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
72 |
& * ( AREA(i,j,bi,bj) - OBNa(i,bi,bj) ) |
73 |
ENDIF |
74 |
ENDDO |
75 |
ENDIF |
76 |
ENDDO |
77 |
ENDIF |
78 |
# endif |
79 |
|
80 |
C Southern Open Boundary |
81 |
# ifdef ALLOW_OBCS_SOUTH |
82 |
IF ( tileHasOBS(bi,bj) ) THEN |
83 |
DO i=1,sNx |
84 |
IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN |
85 |
DO jsl= 1,seaiceSpongeThickness |
86 |
j=OB_Js(i,bi,bj)+jsl |
87 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
88 |
lambda_obcs = ( |
89 |
& float(seaiceSpongeThickness-jsl)*Arelaxobcsbound |
90 |
& + float(jsl-1)*Arelaxobcsinner) |
91 |
& / float(seaiceSpongeThickness-1) |
92 |
if (lambda_obcs.ne.0.) then |
93 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
94 |
else |
95 |
lambda_obcs = 0. _d 0 |
96 |
endif |
97 |
AREA(i,j,bi,bj) = AREA(i,j,bi,bj) |
98 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
99 |
& * ( AREA(i,j,bi,bj) - OBSa(i,bi,bj) ) |
100 |
ENDIF |
101 |
ENDDO |
102 |
ENDIF |
103 |
ENDDO |
104 |
ENDIF |
105 |
# endif |
106 |
|
107 |
C Eastern Open Boundary |
108 |
# ifdef ALLOW_OBCS_EAST |
109 |
IF ( tileHasOBE(bi,bj) ) THEN |
110 |
DO j=1,sNy |
111 |
IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN |
112 |
DO isl= 1,seaiceSpongeThickness |
113 |
i=OB_Ie(j,bi,bj)-isl |
114 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
115 |
lambda_obcs = ( |
116 |
& float(seaiceSpongeThickness-isl)*Arelaxobcsbound |
117 |
& + float(isl-1)*Arelaxobcsinner) |
118 |
& / float(seaiceSpongeThickness-1) |
119 |
if (lambda_obcs.ne.0.) then |
120 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
121 |
else |
122 |
lambda_obcs = 0. _d 0 |
123 |
endif |
124 |
AREA(i,j,bi,bj) = AREA(i,j,bi,bj) |
125 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
126 |
& * ( AREA(i,j,bi,bj) - OBEa(j,bi,bj) ) |
127 |
ENDIF |
128 |
ENDDO |
129 |
ENDIF |
130 |
ENDDO |
131 |
ENDIF |
132 |
# endif |
133 |
|
134 |
C Western Open Boundary |
135 |
# ifdef ALLOW_OBCS_WEST |
136 |
IF ( tileHasOBW(bi,bj) ) THEN |
137 |
DO j=1,sNy |
138 |
IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN |
139 |
DO isl= 1,seaiceSpongeThickness |
140 |
i=OB_Iw(j,bi,bj)+isl |
141 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
142 |
lambda_obcs= ( |
143 |
& float(seaiceSpongeThickness-isl)*Arelaxobcsbound |
144 |
& + float(isl-1)*Arelaxobcsinner) |
145 |
& / float(seaiceSpongeThickness-1) |
146 |
if (lambda_obcs.ne.0.) then |
147 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
148 |
else |
149 |
lambda_obcs = 0. _d 0 |
150 |
endif |
151 |
AREA(i,j,bi,bj) = AREA(i,j,bi,bj) |
152 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
153 |
& * ( AREA(i,j,bi,bj) - OBWa(j,bi,bj) ) |
154 |
ENDIF |
155 |
ENDDO |
156 |
ENDIF |
157 |
ENDDO |
158 |
ENDIF |
159 |
# endif |
160 |
|
161 |
ENDDO |
162 |
ENDDO |
163 |
ENDIF |
164 |
|
165 |
#endif /* ALLOW_OBCS & ALLOW_SEAICE & ALLOW_OBCS_SEAICE_SPONGE */ |
166 |
|
167 |
RETURN |
168 |
END |
169 |
|
170 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
171 |
|
172 |
CStartOfInterface |
173 |
SUBROUTINE OBCS_SEAICE_SPONGE_H( myThid ) |
174 |
C *==========================================================* |
175 |
C | S/R OBCS_SEAICE_SPONGE_H |
176 |
C | Adds a relaxation term to HEFF near Open-Boundaries |
177 |
C *==========================================================* |
178 |
IMPLICIT NONE |
179 |
|
180 |
C == Global data == |
181 |
#include "SIZE.h" |
182 |
#include "EEPARAMS.h" |
183 |
#include "PARAMS.h" |
184 |
#include "GRID.h" |
185 |
#include "DYNVARS.h" |
186 |
#include "OBCS_PARAMS.h" |
187 |
#include "OBCS_GRID.h" |
188 |
#include "OBCS_FIELDS.h" |
189 |
#include "OBCS_SEAICE.h" |
190 |
#ifdef ALLOW_SEAICE |
191 |
# include "SEAICE_SIZE.h" |
192 |
# include "SEAICE_PARAMS.h" |
193 |
# include "SEAICE.h" |
194 |
#endif |
195 |
|
196 |
C == Routine arguments == |
197 |
INTEGER myThid |
198 |
CEndOfInterface |
199 |
|
200 |
#if (defined(ALLOW_OBCS) && defined(ALLOW_SEAICE) && defined(ALLOW_OBCS_SEAICE_SPONGE)) |
201 |
C == Local variables == |
202 |
C Loop counters |
203 |
INTEGER bi, bj, i, j, isl, jsl |
204 |
_RL lambda_obcs |
205 |
|
206 |
IF ( useSeaiceSponge .AND. seaiceSpongeThickness.NE.0 ) THEN |
207 |
DO bj=myByLo(myThid),myByHi(myThid) |
208 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
209 |
|
210 |
C Northern Open Boundary |
211 |
# ifdef ALLOW_OBCS_NORTH |
212 |
IF ( tileHasOBN(bi,bj) ) THEN |
213 |
DO i=1,sNx |
214 |
IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN |
215 |
DO jsl= 1,seaiceSpongeThickness |
216 |
j=OB_Jn(i,bi,bj)-jsl |
217 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
218 |
lambda_obcs = ( |
219 |
& float(seaiceSpongeThickness-jsl)*Hrelaxobcsbound |
220 |
& + float(jsl-1)*Hrelaxobcsinner) |
221 |
& / float(seaiceSpongeThickness-1) |
222 |
IF (lambda_obcs.ne.0.) THEN |
223 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
224 |
ELSE |
225 |
lambda_obcs = 0. _d 0 |
226 |
ENDIF |
227 |
HEFF(i,j,bi,bj) = HEFF(i,j,bi,bj) |
228 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
229 |
& * ( HEFF(i,j,bi,bj) - OBNh(i,bi,bj) ) |
230 |
ENDIF |
231 |
ENDDO |
232 |
ENDIF |
233 |
ENDDO |
234 |
ENDIF |
235 |
# endif |
236 |
|
237 |
C Southern Open Boundary |
238 |
# ifdef ALLOW_OBCS_SOUTH |
239 |
IF ( tileHasOBS(bi,bj) ) THEN |
240 |
DO i=1,sNx |
241 |
IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN |
242 |
DO jsl= 1,seaiceSpongeThickness |
243 |
j=OB_Js(i,bi,bj)+jsl |
244 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
245 |
lambda_obcs = ( |
246 |
& float(seaiceSpongeThickness-jsl)*Hrelaxobcsbound |
247 |
& + float(jsl-1)*Hrelaxobcsinner) |
248 |
& / float(seaiceSpongeThickness-1) |
249 |
if (lambda_obcs.ne.0.) then |
250 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
251 |
else |
252 |
lambda_obcs = 0. _d 0 |
253 |
endif |
254 |
HEFF(i,j,bi,bj) = HEFF(i,j,bi,bj) |
255 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
256 |
& * ( HEFF(i,j,bi,bj) - OBSh(i,bi,bj) ) |
257 |
ENDIF |
258 |
ENDDO |
259 |
ENDIF |
260 |
ENDDO |
261 |
ENDIF |
262 |
# endif |
263 |
|
264 |
C Eastern Open Boundary |
265 |
# ifdef ALLOW_OBCS_EAST |
266 |
IF ( tileHasOBE(bi,bj) ) THEN |
267 |
DO j=1,sNy |
268 |
IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN |
269 |
DO isl= 1,seaiceSpongeThickness |
270 |
i=OB_Ie(j,bi,bj)-isl |
271 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
272 |
lambda_obcs = ( |
273 |
& float(seaiceSpongeThickness-isl)*Hrelaxobcsbound |
274 |
& + float(isl-1)*Hrelaxobcsinner) |
275 |
& / float(seaiceSpongeThickness-1) |
276 |
if (lambda_obcs.ne.0.) then |
277 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
278 |
else |
279 |
lambda_obcs = 0. _d 0 |
280 |
endif |
281 |
HEFF(i,j,bi,bj) = HEFF(i,j,bi,bj) |
282 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
283 |
& * ( HEFF(i,j,bi,bj) - OBEh(j,bi,bj) ) |
284 |
ENDIF |
285 |
ENDDO |
286 |
ENDIF |
287 |
ENDDO |
288 |
ENDIF |
289 |
# endif |
290 |
|
291 |
C Western Open Boundary |
292 |
# ifdef ALLOW_OBCS_WEST |
293 |
IF ( tileHasOBW(bi,bj) ) THEN |
294 |
DO j=1,sNy |
295 |
IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN |
296 |
DO isl= 1,seaiceSpongeThickness |
297 |
i=OB_Iw(j,bi,bj)+isl |
298 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
299 |
lambda_obcs= ( |
300 |
& float(seaiceSpongeThickness-isl)*Hrelaxobcsbound |
301 |
& + float(isl-1)*Hrelaxobcsinner) |
302 |
& / float(seaiceSpongeThickness-1) |
303 |
if (lambda_obcs.ne.0.) then |
304 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
305 |
else |
306 |
lambda_obcs = 0. _d 0 |
307 |
endif |
308 |
HEFF(i,j,bi,bj) = HEFF(i,j,bi,bj) |
309 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
310 |
& * ( HEFF(i,j,bi,bj) - OBWh(j,bi,bj) ) |
311 |
ENDIF |
312 |
ENDDO |
313 |
ENDIF |
314 |
ENDDO |
315 |
ENDIF |
316 |
# endif |
317 |
|
318 |
ENDDO |
319 |
ENDDO |
320 |
ENDIF |
321 |
|
322 |
#endif /* ALLOW_OBCS & ALLOW_SEAICE & ALLOW_OBCS_SEAICE_SPONGE */ |
323 |
|
324 |
RETURN |
325 |
END |
326 |
|
327 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
328 |
|
329 |
CStartOfInterface |
330 |
SUBROUTINE OBCS_SEAICE_SPONGE_SL( myThid ) |
331 |
C *==========================================================* |
332 |
C | S/R OBCS_SEAICE_SPONGE_SL |
333 |
C | Adds a relaxation term to HSALT near Open-Boundaries |
334 |
C *==========================================================* |
335 |
IMPLICIT NONE |
336 |
|
337 |
C == Global data == |
338 |
#include "SIZE.h" |
339 |
#include "EEPARAMS.h" |
340 |
#include "PARAMS.h" |
341 |
#include "GRID.h" |
342 |
#include "DYNVARS.h" |
343 |
#include "OBCS_PARAMS.h" |
344 |
#include "OBCS_GRID.h" |
345 |
#include "OBCS_FIELDS.h" |
346 |
#include "OBCS_SEAICE.h" |
347 |
#ifdef ALLOW_SEAICE |
348 |
# include "SEAICE_SIZE.h" |
349 |
# include "SEAICE_PARAMS.h" |
350 |
# include "SEAICE.h" |
351 |
#endif |
352 |
|
353 |
C == Routine arguments == |
354 |
INTEGER myThid |
355 |
CEndOfInterface |
356 |
|
357 |
#if (defined(ALLOW_OBCS) && defined(ALLOW_SEAICE) && defined(ALLOW_OBCS_SEAICE_SPONGE) && defined(SEAICE_VARIABLE_SALINITY)) |
358 |
C == Local variables == |
359 |
C Loop counters |
360 |
INTEGER bi, bj, i, j, isl, jsl |
361 |
_RL lambda_obcs |
362 |
|
363 |
IF ( useSeaiceSponge .AND. seaiceSpongeThickness.NE.0 ) THEN |
364 |
DO bj=myByLo(myThid),myByHi(myThid) |
365 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
366 |
|
367 |
C Northern Open Boundary |
368 |
# ifdef ALLOW_OBCS_NORTH |
369 |
IF ( tileHasOBN(bi,bj) ) THEN |
370 |
DO i=1,sNx |
371 |
IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN |
372 |
DO jsl= 1,seaiceSpongeThickness |
373 |
j=OB_Jn(i,bi,bj)-jsl |
374 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
375 |
lambda_obcs = ( |
376 |
& float(seaiceSpongeThickness-jsl)*SLrelaxobcsbound |
377 |
& + float(jsl-1)*SLrelaxobcsinner) |
378 |
& / float(seaiceSpongeThickness-1) |
379 |
IF (lambda_obcs.ne.0.) THEN |
380 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
381 |
ELSE |
382 |
lambda_obcs = 0. _d 0 |
383 |
ENDIF |
384 |
HSALT(i,j,bi,bj) = HSALT(i,j,bi,bj) |
385 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
386 |
& * ( HSALT(i,j,bi,bj) - OBNsl(i,bi,bj) ) |
387 |
ENDIF |
388 |
ENDDO |
389 |
ENDIF |
390 |
ENDDO |
391 |
ENDIF |
392 |
# endif |
393 |
|
394 |
C Southern Open Boundary |
395 |
# ifdef ALLOW_OBCS_SOUTH |
396 |
IF ( tileHasOBS(bi,bj) ) THEN |
397 |
DO i=1,sNx |
398 |
IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN |
399 |
DO jsl= 1,seaiceSpongeThickness |
400 |
j=OB_Js(i,bi,bj)+jsl |
401 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
402 |
lambda_obcs = ( |
403 |
& float(seaiceSpongeThickness-jsl)*SLrelaxobcsbound |
404 |
& + float(jsl-1)*SLrelaxobcsinner) |
405 |
& / float(seaiceSpongeThickness-1) |
406 |
if (lambda_obcs.ne.0.) then |
407 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
408 |
else |
409 |
lambda_obcs = 0. _d 0 |
410 |
endif |
411 |
HSALT(i,j,bi,bj) = HSALT(i,j,bi,bj) |
412 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
413 |
& * ( HSALT(i,j,bi,bj) - OBSsl(i,bi,bj) ) |
414 |
ENDIF |
415 |
ENDDO |
416 |
ENDIF |
417 |
ENDDO |
418 |
ENDIF |
419 |
# endif |
420 |
|
421 |
C Eastern Open Boundary |
422 |
# ifdef ALLOW_OBCS_EAST |
423 |
IF ( tileHasOBE(bi,bj) ) THEN |
424 |
DO j=1,sNy |
425 |
IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN |
426 |
DO isl= 1,seaiceSpongeThickness |
427 |
i=OB_Ie(j,bi,bj)-isl |
428 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
429 |
lambda_obcs = ( |
430 |
& float(seaiceSpongeThickness-isl)*SLrelaxobcsbound |
431 |
& + float(isl-1)*SLrelaxobcsinner) |
432 |
& / float(seaiceSpongeThickness-1) |
433 |
if (lambda_obcs.ne.0.) then |
434 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
435 |
else |
436 |
lambda_obcs = 0. _d 0 |
437 |
endif |
438 |
HSALT(i,j,bi,bj) = HSALT(i,j,bi,bj) |
439 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
440 |
& * ( HSALT(i,j,bi,bj) - OBEsl(j,bi,bj) ) |
441 |
ENDIF |
442 |
ENDDO |
443 |
ENDIF |
444 |
ENDDO |
445 |
ENDIF |
446 |
# endif |
447 |
|
448 |
C Western Open Boundary |
449 |
# ifdef ALLOW_OBCS_WEST |
450 |
IF ( tileHasOBW(bi,bj) ) THEN |
451 |
DO j=1,sNy |
452 |
IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN |
453 |
DO isl= 1,seaiceSpongeThickness |
454 |
i=OB_Iw(j,bi,bj)+isl |
455 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
456 |
lambda_obcs= ( |
457 |
& float(seaiceSpongeThickness-isl)*SLrelaxobcsbound |
458 |
& + float(isl-1)*SLrelaxobcsinner) |
459 |
& / float(seaiceSpongeThickness-1) |
460 |
if (lambda_obcs.ne.0.) then |
461 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
462 |
else |
463 |
lambda_obcs = 0. _d 0 |
464 |
endif |
465 |
HSALT(i,j,bi,bj) = HSALT(i,j,bi,bj) |
466 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
467 |
& * ( HSALT(i,j,bi,bj) - OBWsl(j,bi,bj) ) |
468 |
ENDIF |
469 |
ENDDO |
470 |
ENDIF |
471 |
ENDDO |
472 |
ENDIF |
473 |
# endif |
474 |
|
475 |
ENDDO |
476 |
ENDDO |
477 |
ENDIF |
478 |
|
479 |
#endif /* ALLOW_OBCS & ALLOW_SEAICE & ALLOW_OBCS_SEAICE_SPONGE & SEAICE_VARIABLE_SALINITY */ |
480 |
|
481 |
RETURN |
482 |
END |
483 |
|
484 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
485 |
|
486 |
CStartOfInterface |
487 |
SUBROUTINE OBCS_SEAICE_SPONGE_SN( myThid ) |
488 |
C *==========================================================* |
489 |
C | S/R OBCS_SEAICE_SPONGE_SN |
490 |
C | Adds a relaxation term to HSNOW near Open-Boundaries |
491 |
C *==========================================================* |
492 |
IMPLICIT NONE |
493 |
|
494 |
C == Global data == |
495 |
#include "SIZE.h" |
496 |
#include "EEPARAMS.h" |
497 |
#include "PARAMS.h" |
498 |
#include "GRID.h" |
499 |
#include "DYNVARS.h" |
500 |
#include "OBCS_PARAMS.h" |
501 |
#include "OBCS_GRID.h" |
502 |
#include "OBCS_FIELDS.h" |
503 |
#include "OBCS_SEAICE.h" |
504 |
#ifdef ALLOW_SEAICE |
505 |
# include "SEAICE_SIZE.h" |
506 |
# include "SEAICE_PARAMS.h" |
507 |
# include "SEAICE.h" |
508 |
#endif |
509 |
|
510 |
C == Routine arguments == |
511 |
INTEGER myThid |
512 |
CEndOfInterface |
513 |
|
514 |
#if (defined(ALLOW_OBCS) && defined(ALLOW_SEAICE) && defined(ALLOW_OBCS_SEAICE_SPONGE)) |
515 |
C == Local variables == |
516 |
C Loop counters |
517 |
INTEGER bi, bj, i, j, isl, jsl |
518 |
_RL lambda_obcs |
519 |
|
520 |
IF ( useSeaiceSponge .AND. seaiceSpongeThickness.NE.0 ) THEN |
521 |
DO bj=myByLo(myThid),myByHi(myThid) |
522 |
DO bi=myBxLo(myThid),myBxHi(myThid) |
523 |
|
524 |
C Northern Open Boundary |
525 |
# ifdef ALLOW_OBCS_NORTH |
526 |
IF ( tileHasOBN(bi,bj) ) THEN |
527 |
DO i=1,sNx |
528 |
IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN |
529 |
DO jsl= 1,seaiceSpongeThickness |
530 |
j=OB_Jn(i,bi,bj)-jsl |
531 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
532 |
lambda_obcs = ( |
533 |
& float(seaiceSpongeThickness-jsl)*SNrelaxobcsbound |
534 |
& + float(jsl-1)*SNrelaxobcsinner) |
535 |
& / float(seaiceSpongeThickness-1) |
536 |
IF (lambda_obcs.ne.0.) THEN |
537 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
538 |
ELSE |
539 |
lambda_obcs = 0. _d 0 |
540 |
ENDIF |
541 |
HSNOW(i,j,bi,bj) = HSNOW(i,j,bi,bj) |
542 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
543 |
& * ( HSNOW(i,j,bi,bj) - OBNsn(i,bi,bj) ) |
544 |
ENDIF |
545 |
ENDDO |
546 |
ENDIF |
547 |
ENDDO |
548 |
ENDIF |
549 |
# endif |
550 |
|
551 |
C Southern Open Boundary |
552 |
# ifdef ALLOW_OBCS_SOUTH |
553 |
IF ( tileHasOBS(bi,bj) ) THEN |
554 |
DO i=1,sNx |
555 |
IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN |
556 |
DO jsl= 1,seaiceSpongeThickness |
557 |
j=OB_Js(i,bi,bj)+jsl |
558 |
IF ((j.ge.1).and.(j.le.sNy)) THEN |
559 |
lambda_obcs = ( |
560 |
& float(seaiceSpongeThickness-jsl)*SNrelaxobcsbound |
561 |
& + float(jsl-1)*SNrelaxobcsinner) |
562 |
& / float(seaiceSpongeThickness-1) |
563 |
if (lambda_obcs.ne.0.) then |
564 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
565 |
else |
566 |
lambda_obcs = 0. _d 0 |
567 |
endif |
568 |
HSNOW(i,j,bi,bj) = HSNOW(i,j,bi,bj) |
569 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
570 |
& * ( HSNOW(i,j,bi,bj) - OBSsn(i,bi,bj) ) |
571 |
ENDIF |
572 |
ENDDO |
573 |
ENDIF |
574 |
ENDDO |
575 |
ENDIF |
576 |
# endif |
577 |
|
578 |
C Eastern Open Boundary |
579 |
# ifdef ALLOW_OBCS_EAST |
580 |
IF ( tileHasOBE(bi,bj) ) THEN |
581 |
DO j=1,sNy |
582 |
IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN |
583 |
DO isl= 1,seaiceSpongeThickness |
584 |
i=OB_Ie(j,bi,bj)-isl |
585 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
586 |
lambda_obcs = ( |
587 |
& float(seaiceSpongeThickness-isl)*SNrelaxobcsbound |
588 |
& + float(isl-1)*SNrelaxobcsinner) |
589 |
& / float(seaiceSpongeThickness-1) |
590 |
if (lambda_obcs.ne.0.) then |
591 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
592 |
else |
593 |
lambda_obcs = 0. _d 0 |
594 |
endif |
595 |
HSNOW(i,j,bi,bj) = HSNOW(i,j,bi,bj) |
596 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
597 |
& * ( HSNOW(i,j,bi,bj) - OBEsn(j,bi,bj) ) |
598 |
ENDIF |
599 |
ENDDO |
600 |
ENDIF |
601 |
ENDDO |
602 |
ENDIF |
603 |
# endif |
604 |
|
605 |
C Western Open Boundary |
606 |
# ifdef ALLOW_OBCS_WEST |
607 |
IF ( tileHasOBW(bi,bj) ) THEN |
608 |
DO j=1,sNy |
609 |
IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN |
610 |
DO isl= 1,seaiceSpongeThickness |
611 |
i=OB_Iw(j,bi,bj)+isl |
612 |
IF ((i.ge.1).and.(i.le.sNx)) THEN |
613 |
lambda_obcs= ( |
614 |
& float(seaiceSpongeThickness-isl)*SNrelaxobcsbound |
615 |
& + float(isl-1)*SNrelaxobcsinner) |
616 |
& / float(seaiceSpongeThickness-1) |
617 |
if (lambda_obcs.ne.0.) then |
618 |
lambda_obcs = SEAICE_deltaTtherm / lambda_obcs |
619 |
else |
620 |
lambda_obcs = 0. _d 0 |
621 |
endif |
622 |
HSNOW(i,j,bi,bj) = HSNOW(i,j,bi,bj) |
623 |
& - maskC(i,j,1,bi,bj) * lambda_obcs |
624 |
& * ( HSNOW(i,j,bi,bj) - OBWsn(j,bi,bj) ) |
625 |
ENDIF |
626 |
ENDDO |
627 |
ENDIF |
628 |
ENDDO |
629 |
ENDIF |
630 |
# endif |
631 |
|
632 |
ENDDO |
633 |
ENDDO |
634 |
ENDIF |
635 |
|
636 |
#endif /* ALLOW_OBCS & ALLOW_SEAICE & ALLOW_OBCS_SEAICE_SPONGE */ |
637 |
|
638 |
RETURN |
639 |
END |