/[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.53 - (show annotations) (download)
Fri May 30 02:45:43 2008 UTC (15 years, 11 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint61b, checkpoint61a
Changes since 1.52: +3 -3 lines
o bridging the gap between eddy stress and GM.
  -> eddyTau is replaced with eddyPsi (eddyTau = f x rho0 x eddyPsi)
      along with a change in CPP option (now ALLOW_EDDYPSI).
  -> when using GM w/ GM_AdvForm:
      The total eddy streamfunction (Psi = eddyPsi + K x Slope)
      is applied either in the tracer Eq. or in momentum Eq.
      depending on data.gmredi (intro. GM_InMomAsStress).
  -> ALLOW_EDDYPSI_CONTROL for estimation purpose.
  The key modifications are in model/src/taueddy_external_forcing.F
  pkg/gmredi/gmredi_calc_*F pkg/gmredi/gmredi_*transport.F

1 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.52 2008/01/29 00:34:43 jmc 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 C Add windstress momentum impulse into the top-layer
75 IF ( kLev .EQ. kSurface ) THEN
76 c DO j=1,sNy
77 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
78 DO j=0,sNy+1
79 DO i=1,sNx+1
80 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
81 & +foFacMom*surfaceForcingU(i,j,bi,bj)
82 & *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
83 ENDDO
84 ENDDO
85 ENDIF
86
87 #ifdef ALLOW_EDDYPSI
88 CALL TAUEDDY_EXTERNAL_FORCING_U(
89 I iMin,iMax, jMin,jMax, bi,bj, kLev,
90 I myTime, myThid )
91 #endif
92
93 #ifdef ALLOW_OBCS
94 IF (useOBCS) THEN
95 CALL OBCS_SPONGE_U(
96 I iMin,iMax, jMin,jMax, bi,bj, kLev,
97 I myTime, myThid )
98 ENDIF
99 #endif
100
101 #ifdef ALLOW_MYPACKAGE
102 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
103 & iMin,iMax, jMin,jMax, bi,bj, kLev,
104 & myTime, myThid )
105 #endif /* ALLOW_MYPACKAGE */
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 C Add windstress momentum impulse into the top-layer
179 IF ( kLev .EQ. kSurface ) THEN
180 DO j=1,sNy+1
181 c DO i=1,sNx
182 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
183 DO i=0,sNx+1
184 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
185 & +foFacMom*surfaceForcingV(i,j,bi,bj)
186 & *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
187 ENDDO
188 ENDDO
189 ENDIF
190
191 #ifdef ALLOW_EDDYPSI
192 CALL TAUEDDY_EXTERNAL_FORCING_V(
193 I iMin,iMax, jMin,jMax, bi,bj, kLev,
194 I myTime, myThid )
195 #endif
196
197 #ifdef ALLOW_OBCS
198 IF (useOBCS) THEN
199 CALL OBCS_SPONGE_V(
200 I iMin,iMax, jMin,jMax, bi,bj, kLev,
201 I myTime, myThid )
202 ENDIF
203 #endif
204
205 #ifdef ALLOW_MYPACKAGE
206 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
207 & iMin,iMax, jMin,jMax, bi,bj, kLev,
208 & myTime, myThid )
209 #endif /* ALLOW_MYPACKAGE */
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 C Add heat in top-layer
291 IF ( kLev .EQ. kSurface ) THEN
292 DO j=1,sNy
293 DO i=1,sNx
294 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
295 & +surfaceForcingT(i,j,bi,bj)
296 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
297 ENDDO
298 ENDDO
299 ENDIF
300
301 cph#ifndef ALLOW_AUTODIFF_TAMC
302 cph I didnt put this ifndef here.
303 IF (linFSConserveTr) THEN
304 DO j=1,sNy
305 DO i=1,sNx
306 IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
307 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
308 & +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
309 ENDIF
310 ENDDO
311 ENDDO
312 ENDIF
313 cph#endif /* ndfef ALLOW_AUTODIFF_TAMC */
314
315 #ifdef ALLOW_SHELFICE
316 IF ( useShelfIce )
317 & CALL SHELFICE_FORCING_T(
318 I iMin,iMax, jMin,jMax, bi,bj, kLev,
319 I myTime, myThid )
320 #endif /* ALLOW_SHELFICE */
321
322 #ifdef SHORTWAVE_HEATING
323 C Penetrating SW radiation
324 c IF ( usePenetratingSW ) THEN
325 swfracb(1)=abs(rF(klev))
326 swfracb(2)=abs(rF(klev+1))
327 CALL SWFRAC(
328 I two, minusone,
329 U swfracb,
330 I myTime, 1, myThid )
331 kp1 = klev+1
332 IF (klev.EQ.Nr) THEN
333 kp1 = klev
334 swfracb(2)=0. _d 0
335 ENDIF
336 DO j=1,sNy
337 DO i=1,sNx
338 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
339 & -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
340 & -swfracb(2)*maskC(i,j,kp1, bi,bj))
341 & *recip_Cp*mass2rUnit
342 & *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
343 ENDDO
344 ENDDO
345 c ENDIF
346 #endif
347
348 #ifdef ALLOW_RBCS
349 IF (useRBCS) THEN
350 CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
351 & myTime, myThid )
352 ENDIF
353 #endif
354
355 #ifdef ALLOW_OBCS
356 IF (useOBCS) THEN
357 CALL OBCS_SPONGE_T(
358 I iMin,iMax, jMin,jMax, bi,bj, kLev,
359 I myTime, myThid )
360 ENDIF
361 #endif
362
363 #ifdef ALLOW_MYPACKAGE
364 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
365 & iMin,iMax, jMin,jMax, bi,bj, kLev,
366 & myTime, myThid )
367 #endif /* ALLOW_MYPACKAGE */
368
369 RETURN
370 END
371
372 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
373 CBOP
374 C !ROUTINE: EXTERNAL_FORCING_S
375 C !INTERFACE:
376 SUBROUTINE EXTERNAL_FORCING_S(
377 I iMin,iMax, jMin,jMax, bi,bj, kLev,
378 I myTime, myThid )
379
380 C !DESCRIPTION: \bv
381 C *==========================================================*
382 C | S/R EXTERNAL_FORCING_S
383 C | o Contains problem specific forcing for merid velocity.
384 C *==========================================================*
385 C | Adds terms to gS for forcing by external sources
386 C | e.g. fresh-water flux, climatalogical relaxation, etc ...
387 C *==========================================================*
388 C \ev
389
390 C !USES:
391 IMPLICIT NONE
392 C == Global data ==
393 #include "SIZE.h"
394 #include "EEPARAMS.h"
395 #include "PARAMS.h"
396 #include "GRID.h"
397 #include "DYNVARS.h"
398 #include "FFIELDS.h"
399 #include "SURFACE.h"
400
401 C !INPUT/OUTPUT PARAMETERS:
402 C == Routine arguments ==
403 C iMin,iMax :: Working range of x-index for applying forcing.
404 C jMin,jMax :: Working range of y-index for applying forcing.
405 C bi,bj :: Current tile indices
406 C kLev :: Current vertical level index
407 C myTime :: Current time in simulation
408 C myThid :: Thread Id number
409 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
410 _RL myTime
411 INTEGER myThid
412
413 C !LOCAL VARIABLES:
414 C == Local variables ==
415 C i,j :: Loop counters
416 C kSurface :: index of surface layer
417 INTEGER i, j
418 INTEGER kSurface
419 CEOP
420
421 IF ( fluidIsAir ) THEN
422 kSurface = 0
423 ELSEIF ( usingPCoords ) THEN
424 kSurface = Nr
425 ELSE
426 kSurface = 1
427 ENDIF
428
429 C-- Forcing term
430 #ifdef ALLOW_AIM
431 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
432 & iMin,iMax, jMin,jMax, bi,bj, kLev,
433 & myTime, myThid )
434 #endif /* ALLOW_AIM */
435
436 #ifdef ALLOW_FIZHI
437 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
438 & iMin,iMax, jMin,jMax, bi,bj, kLev,
439 & myTime, myThid )
440 #endif /* ALLOW_FIZHI */
441
442 C Add fresh-water in top-layer
443 IF ( kLev .EQ. kSurface ) THEN
444 DO j=1,sNy
445 DO i=1,sNx
446 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
447 & +surfaceForcingS(i,j,bi,bj)
448 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
449 ENDDO
450 ENDDO
451 ENDIF
452
453 cph#ifndef ALLOW_AUTODIFF_TAMC
454 cph I didnt put this ifndef here.
455 IF (linFSConserveTr) THEN
456 DO j=1,sNy
457 DO i=1,sNx
458 IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
459 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
460 & +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
461 ENDIF
462 ENDDO
463 ENDDO
464 ENDIF
465 cph#endif /* ndfef ALLOW_AUTODIFF_TAMC */
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_SALT_PLUME
475 IF ( useSALT_PLUME )
476 & CALL SALT_PLUME_TENDENCY_APPLY_S(
477 I iMin,iMax, jMin,jMax, bi,bj, kLev,
478 I myTime, myThid )
479 #endif /* ALLOW_SALT_PLUME */
480
481 #ifdef ALLOW_RBCS
482 IF (useRBCS) THEN
483 CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
484 & myTime, myThid )
485 ENDIF
486 #endif /* ALLOW_RBCS */
487
488 #ifdef ALLOW_OBCS
489 IF (useOBCS) THEN
490 CALL OBCS_SPONGE_S(
491 I iMin,iMax, jMin,jMax, bi,bj, kLev,
492 I myTime, myThid )
493 ENDIF
494 #endif /* ALLOW_OBCS */
495
496 #ifdef ALLOW_MYPACKAGE
497 IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
498 & iMin,iMax, jMin,jMax, bi,bj, kLev,
499 & myTime, myThid )
500 #endif /* ALLOW_MYPACKAGE */
501
502 RETURN
503 END

  ViewVC Help
Powered by ViewVC 1.1.22