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

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

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


Revision 1.40 - (show annotations) (download)
Fri Jan 5 01:29:31 2007 UTC (17 years, 4 months ago) by dfer
Branch: MAIN
Changes since 1.39: +25 -1 lines
Second wave: correction of tracer source/sink due to Linear
Free surface

1 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.39 2006/06/28 21:24:54 heimbach Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: EXTERNAL_FORCING_U
9 C !INTERFACE:
10 SUBROUTINE EXTERNAL_FORCING_U(
11 I iMin,iMax, jMin,jMax, bi,bj, kLev,
12 I myTime, myThid )
13 C !DESCRIPTION: \bv
14 C *==========================================================*
15 C | S/R EXTERNAL_FORCING_U
16 C | o Contains problem specific forcing for zonal velocity.
17 C *==========================================================*
18 C | Adds terms to gU for forcing by external sources
19 C | e.g. wind stress, bottom friction etc ...
20 C *==========================================================*
21 C \ev
22
23 C !USES:
24 IMPLICIT NONE
25 C == Global data ==
26 #include "SIZE.h"
27 #include "EEPARAMS.h"
28 #include "PARAMS.h"
29 #include "GRID.h"
30 #include "DYNVARS.h"
31 #include "FFIELDS.h"
32
33 C !INPUT/OUTPUT PARAMETERS:
34 C == Routine arguments ==
35 C iMin,iMax :: Working range of x-index for applying forcing.
36 C jMin,jMax :: Working range of y-index for applying forcing.
37 C bi,bj :: Current tile indices
38 C kLev :: Current vertical level index
39 C myTime :: Current time in simulation
40 C myThid :: Thread Id number
41 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
42 _RL myTime
43 INTEGER myThid
44
45 C !LOCAL VARIABLES:
46 C == Local variables ==
47 C i,j :: Loop counters
48 C kSurface :: index of surface layer
49 INTEGER i, j
50 INTEGER kSurface
51 CEOP
52
53 IF ( fluidIsAir ) THEN
54 kSurface = 0
55 ELSEIF ( usingPCoords ) THEN
56 kSurface = Nr
57 ELSE
58 kSurface = 1
59 ENDIF
60
61 C-- Forcing term
62 #ifdef ALLOW_AIM
63 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
64 & iMin,iMax, jMin,jMax, bi,bj, kLev,
65 & myTime, myThid )
66 #endif /* ALLOW_AIM */
67
68 #ifdef ALLOW_FIZHI
69 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
70 & iMin,iMax, jMin,jMax, bi,bj, kLev,
71 & myTime, myThid )
72 #endif /* ALLOW_FIZHI */
73
74 #ifdef ALLOW_MYPACKAGE
75 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
76 & iMin,iMax, jMin,jMax, bi,bj, kLev,
77 & myTime, myThid )
78 #endif /* ALLOW_MYPACKAGE */
79
80 C Add windstress momentum impulse into the top-layer
81 IF ( kLev .EQ. kSurface ) THEN
82 c DO j=1,sNy
83 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
84 DO j=0,sNy+1
85 DO i=1,sNx+1
86 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
87 & +foFacMom*surfaceForcingU(i,j,bi,bj)
88 & *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
89 ENDDO
90 ENDDO
91 ENDIF
92
93 #if (defined (ALLOW_TAU_EDDY))
94 CALL TAUEDDY_EXTERNAL_FORCING_U(
95 I iMin,iMax, jMin,jMax, bi,bj, kLev,
96 I myTime, myThid )
97 #endif
98
99 #ifdef ALLOW_OBCS
100 IF (useOBCS) THEN
101 CALL OBCS_SPONGE_U(
102 I iMin,iMax, jMin,jMax, bi,bj, kLev,
103 I myTime, myThid )
104 ENDIF
105 #endif
106
107 RETURN
108 END
109
110 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111 CBOP
112 C !ROUTINE: EXTERNAL_FORCING_V
113 C !INTERFACE:
114 SUBROUTINE EXTERNAL_FORCING_V(
115 I iMin,iMax, jMin,jMax, bi,bj, kLev,
116 I myTime, myThid )
117 C !DESCRIPTION: \bv
118 C *==========================================================*
119 C | S/R EXTERNAL_FORCING_V
120 C | o Contains problem specific forcing for merid velocity.
121 C *==========================================================*
122 C | Adds terms to gV for forcing by external sources
123 C | e.g. wind stress, bottom friction etc ...
124 C *==========================================================*
125 C \ev
126
127 C !USES:
128 IMPLICIT NONE
129 C == Global data ==
130 #include "SIZE.h"
131 #include "EEPARAMS.h"
132 #include "PARAMS.h"
133 #include "GRID.h"
134 #include "DYNVARS.h"
135 #include "FFIELDS.h"
136
137 C !INPUT/OUTPUT PARAMETERS:
138 C == Routine arguments ==
139 C iMin,iMax :: Working range of x-index for applying forcing.
140 C jMin,jMax :: Working range of y-index for applying forcing.
141 C bi,bj :: Current tile indices
142 C kLev :: Current vertical level index
143 C myTime :: Current time in simulation
144 C myThid :: Thread Id number
145 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
146 _RL myTime
147 INTEGER myThid
148
149 C !LOCAL VARIABLES:
150 C == Local variables ==
151 C i,j :: Loop counters
152 C kSurface :: index of surface layer
153 INTEGER i, j
154 INTEGER kSurface
155 CEOP
156
157 IF ( fluidIsAir ) THEN
158 kSurface = 0
159 ELSEIF ( usingPCoords ) THEN
160 kSurface = Nr
161 ELSE
162 kSurface = 1
163 ENDIF
164
165 C-- Forcing term
166 #ifdef ALLOW_AIM
167 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
168 & iMin,iMax, jMin,jMax, bi,bj, kLev,
169 & myTime, myThid )
170 #endif /* ALLOW_AIM */
171
172 #ifdef ALLOW_FIZHI
173 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
174 & iMin,iMax, jMin,jMax, bi,bj, kLev,
175 & myTime, myThid )
176 #endif /* ALLOW_FIZHI */
177
178 #ifdef ALLOW_MYPACKAGE
179 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
180 & iMin,iMax, jMin,jMax, bi,bj, kLev,
181 & myTime, myThid )
182 #endif /* ALLOW_MYPACKAGE */
183
184 C Add windstress momentum impulse into the top-layer
185 IF ( kLev .EQ. kSurface ) THEN
186 DO j=1,sNy+1
187 c DO i=1,sNx
188 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
189 DO i=0,sNx+1
190 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
191 & +foFacMom*surfaceForcingV(i,j,bi,bj)
192 & *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
193 ENDDO
194 ENDDO
195 ENDIF
196
197 #if (defined (ALLOW_TAU_EDDY))
198 CALL TAUEDDY_EXTERNAL_FORCING_V(
199 I iMin,iMax, jMin,jMax, bi,bj, kLev,
200 I myTime, myThid )
201 #endif
202
203 #ifdef ALLOW_OBCS
204 IF (useOBCS) THEN
205 CALL OBCS_SPONGE_V(
206 I iMin,iMax, jMin,jMax, bi,bj, kLev,
207 I myTime, myThid )
208 ENDIF
209 #endif
210
211 RETURN
212 END
213
214 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
215 CBOP
216 C !ROUTINE: EXTERNAL_FORCING_T
217 C !INTERFACE:
218 SUBROUTINE EXTERNAL_FORCING_T(
219 I iMin,iMax, jMin,jMax, bi,bj, kLev,
220 I myTime, myThid )
221 C !DESCRIPTION: \bv
222 C *==========================================================*
223 C | S/R EXTERNAL_FORCING_T
224 C | o Contains problem specific forcing for temperature.
225 C *==========================================================*
226 C | Adds terms to gT for forcing by external sources
227 C | e.g. heat flux, climatalogical relaxation, etc ...
228 C *==========================================================*
229 C \ev
230
231 C !USES:
232 IMPLICIT NONE
233 C == Global data ==
234 #include "SIZE.h"
235 #include "EEPARAMS.h"
236 #include "PARAMS.h"
237 #include "GRID.h"
238 #include "DYNVARS.h"
239 #include "FFIELDS.h"
240 #include "SURFACE.h"
241
242 C !INPUT/OUTPUT PARAMETERS:
243 C == Routine arguments ==
244 C iMin,iMax :: Working range of x-index for applying forcing.
245 C jMin,jMax :: Working range of y-index for applying forcing.
246 C bi,bj :: Current tile indices
247 C kLev :: Current vertical level index
248 C myTime :: Current time in simulation
249 C myThid :: Thread Id number
250 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
251 _RL myTime
252 INTEGER myThid
253
254 C !LOCAL VARIABLES:
255 C == Local variables ==
256 C i,j :: Loop counters
257 C kSurface :: index of surface layer
258 INTEGER i, j
259 INTEGER kSurface
260 CEOP
261 #ifdef SHORTWAVE_HEATING
262 integer two
263 _RL minusone
264 parameter (two=2,minusone=-1.)
265 _RL swfracb(two)
266 INTEGER kp1
267 #endif
268
269 IF ( fluidIsAir ) THEN
270 kSurface = 0
271 ELSEIF ( usingPCoords ) THEN
272 kSurface = Nr
273 ELSE
274 kSurface = 1
275 ENDIF
276
277 C-- Forcing term
278 #ifdef ALLOW_AIM
279 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
280 & iMin,iMax, jMin,jMax, bi,bj, kLev,
281 & myTime, myThid )
282 #endif /* ALLOW_AIM */
283
284 #ifdef ALLOW_FIZHI
285 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
286 & iMin,iMax, jMin,jMax, bi,bj, kLev,
287 & myTime, myThid )
288 #endif /* ALLOW_FIZHI */
289
290 #ifdef ALLOW_MYPACKAGE
291 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
292 & iMin,iMax, jMin,jMax, bi,bj, kLev,
293 & myTime, myThid )
294 #endif /* ALLOW_MYPACKAGE */
295
296 C Add heat in top-layer
297 IF ( kLev .EQ. kSurface ) THEN
298 DO j=1,sNy
299 DO i=1,sNx
300 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
301 & +surfaceForcingT(i,j,bi,bj)
302 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
303 ENDDO
304 ENDDO
305 ENDIF
306
307 IF (linFSConserveTr) THEN
308 DO j=1,sNy
309 DO i=1,sNx
310 IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
311 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
312 & +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
313 ENDIF
314 ENDDO
315 ENDDO
316 ENDIF
317
318 #ifdef ALLOW_SHELFICE
319 IF ( useShelfIce )
320 & CALL SHELFICE_FORCING_T(
321 I iMin,iMax, jMin,jMax, bi,bj, kLev,
322 I myTime, myThid )
323 #endif /* ALLOW_SHELFICE */
324
325 #ifdef SHORTWAVE_HEATING
326 C Penetrating SW radiation
327 c IF ( usePenetratingSW ) THEN
328 swfracb(1)=abs(rF(klev))
329 swfracb(2)=abs(rF(klev+1))
330 CALL SWFRAC(
331 I two,minusone,
332 I myTime,myThid,
333 U swfracb)
334 kp1 = klev+1
335 IF (klev.EQ.Nr) THEN
336 kp1 = klev
337 swfracb(2)=0. _d 0
338 ENDIF
339 DO j=1,sNy
340 DO i=1,sNx
341 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
342 & -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
343 & -swfracb(2)*maskC(i,j,kp1, bi,bj))
344 & *recip_Cp*recip_rhoConst
345 & *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
346 ENDDO
347 ENDDO
348 c ENDIF
349 #endif
350
351 #ifdef ALLOW_RBCS
352 if (useRBCS) then
353 call RBCS_ADD_TENDENCY(bi,bj,klev, 1,
354 & myTime, myThid )
355 endif
356 #endif
357
358 #ifdef ALLOW_OBCS
359 IF (useOBCS) THEN
360 CALL OBCS_SPONGE_T(
361 I iMin,iMax, jMin,jMax, bi,bj, kLev,
362 I myTime, myThid )
363 ENDIF
364 #endif
365
366 RETURN
367 END
368
369 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
370 CBOP
371 C !ROUTINE: EXTERNAL_FORCING_S
372 C !INTERFACE:
373 SUBROUTINE EXTERNAL_FORCING_S(
374 I iMin,iMax, jMin,jMax, bi,bj, kLev,
375 I myTime, myThid )
376
377 C !DESCRIPTION: \bv
378 C *==========================================================*
379 C | S/R EXTERNAL_FORCING_S
380 C | o Contains problem specific forcing for merid velocity.
381 C *==========================================================*
382 C | Adds terms to gS for forcing by external sources
383 C | e.g. fresh-water flux, climatalogical relaxation, etc ...
384 C *==========================================================*
385 C \ev
386
387 C !USES:
388 IMPLICIT NONE
389 C == Global data ==
390 #include "SIZE.h"
391 #include "EEPARAMS.h"
392 #include "PARAMS.h"
393 #include "GRID.h"
394 #include "DYNVARS.h"
395 #include "FFIELDS.h"
396 #include "SURFACE.h"
397
398 C !INPUT/OUTPUT PARAMETERS:
399 C == Routine arguments ==
400 C iMin,iMax :: Working range of x-index for applying forcing.
401 C jMin,jMax :: Working range of y-index for applying forcing.
402 C bi,bj :: Current tile indices
403 C kLev :: Current vertical level index
404 C myTime :: Current time in simulation
405 C myThid :: Thread Id number
406 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
407 _RL myTime
408 INTEGER myThid
409
410 C !LOCAL VARIABLES:
411 C == Local variables ==
412 C i,j :: Loop counters
413 C kSurface :: index of surface layer
414 INTEGER i, j
415 INTEGER kSurface
416 CEOP
417
418 IF ( fluidIsAir ) THEN
419 kSurface = 0
420 ELSEIF ( usingPCoords ) THEN
421 kSurface = Nr
422 ELSE
423 kSurface = 1
424 ENDIF
425
426 C-- Forcing term
427 #ifdef ALLOW_AIM
428 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
429 & iMin,iMax, jMin,jMax, bi,bj, kLev,
430 & myTime, myThid )
431 #endif /* ALLOW_AIM */
432
433 #ifdef ALLOW_FIZHI
434 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
435 & iMin,iMax, jMin,jMax, bi,bj, kLev,
436 & myTime, myThid )
437 #endif /* ALLOW_FIZHI */
438
439 #ifdef ALLOW_MYPACKAGE
440 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
441 & iMin,iMax, jMin,jMax, bi,bj, kLev,
442 & myTime, myThid )
443 #endif /* ALLOW_MYPACKAGE */
444
445 C Add fresh-water in top-layer
446 IF ( kLev .EQ. kSurface ) THEN
447 DO j=1,sNy
448 DO i=1,sNx
449 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
450 & +surfaceForcingS(i,j,bi,bj)
451 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
452 ENDDO
453 ENDDO
454 ENDIF
455
456 IF (linFSConserveTr) THEN
457 DO j=1,sNy
458 DO i=1,sNx
459 IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
460 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
461 & +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
462 ENDIF
463 ENDDO
464 ENDDO
465 ENDIF
466
467 #ifdef ALLOW_SHELFICE
468 IF ( useShelfIce )
469 & CALL SHELFICE_FORCING_S(
470 I iMin,iMax, jMin,jMax, bi,bj, kLev,
471 I myTime, myThid )
472 #endif /* ALLOW_SHELFICE */
473
474 #ifdef ALLOW_RBCS
475 if (useRBCS) then
476 call RBCS_ADD_TENDENCY(bi,bj,klev, 2,
477 & myTime, myThid )
478 endif
479 #endif
480
481 #ifdef ALLOW_OBCS
482 IF (useOBCS) THEN
483 CALL OBCS_SPONGE_S(
484 I iMin,iMax, jMin,jMax, bi,bj, kLev,
485 I myTime, myThid )
486 ENDIF
487 #endif
488
489 RETURN
490 END

  ViewVC Help
Powered by ViewVC 1.1.22