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

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

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


Revision 1.29 - (hide annotations) (download)
Mon Feb 28 17:37:31 2005 UTC (19 years, 2 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint57e_post
Changes since 1.28: +13 -1 lines
Adding eddy stress controls a la Ferreira et al.

1 heimbach 1.29 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.28 2004/10/19 02:39:58 jmc Exp $
2 adcroft 1.12 C $Name: $
3 cnh 1.1
4 edhill 1.20 #include "PACKAGES_CONFIG.h"
5 cnh 1.1 #include "CPP_OPTIONS.h"
6 heimbach 1.19 #ifdef ALLOW_OBCS
7     # include "OBCS_OPTIONS.h"
8     #endif
9 cnh 1.1
10 cnh 1.13 CBOP
11     C !ROUTINE: EXTERNAL_FORCING_U
12     C !INTERFACE:
13 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_U(
14     I iMin, iMax, jMin, jMax,bi,bj,kLev,
15     I myCurrentTime,myThid)
16 cnh 1.13 C !DESCRIPTION: \bv
17     C *==========================================================*
18     C | S/R EXTERNAL_FORCING_U
19     C | o Contains problem specific forcing for zonal velocity.
20     C *==========================================================*
21     C | Adds terms to gU for forcing by external sources
22     C | e.g. wind stress, bottom friction etc..................
23     C *==========================================================*
24     C \ev
25    
26     C !USES:
27 cnh 1.2 IMPLICIT NONE
28 cnh 1.1 C == Global data ==
29     #include "SIZE.h"
30     #include "EEPARAMS.h"
31     #include "PARAMS.h"
32     #include "GRID.h"
33     #include "DYNVARS.h"
34 cnh 1.2 #include "FFIELDS.h"
35 cnh 1.13
36     C !INPUT/OUTPUT PARAMETERS:
37 cnh 1.1 C == Routine arguments ==
38     C iMin - Working range of tile for applying forcing.
39     C iMax
40     C jMin
41     C jMax
42     C kLev
43     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
44 adcroft 1.4 _RL myCurrentTime
45     INTEGER myThid
46 cnh 1.1
47 cnh 1.13 C !LOCAL VARIABLES:
48 cnh 1.2 C == Local variables ==
49     C Loop counters
50     INTEGER I, J
51 mlosch 1.17 C number of surface interface layer
52     INTEGER kSurface
53 cnh 1.13 CEOP
54 cnh 1.2
55 jmc 1.28 IF ( fluidIsAir ) THEN
56 jmc 1.21 kSurface = 0
57 jmc 1.28 ELSEIF ( usingPCoords ) THEN
58 mlosch 1.17 kSurface = Nr
59 jmc 1.28 ELSE
60 mlosch 1.17 kSurface = 1
61 jmc 1.28 ENDIF
62 mlosch 1.17
63 cnh 1.2 C-- Forcing term
64 jmc 1.21 #ifdef ALLOW_AIM
65     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
66     & iMin,iMax, jMin,jMax, bi,bj, kLev,
67     & myCurrentTime, myThid )
68     #endif /* ALLOW_AIM */
69 molod 1.23 C AMM
70     #ifdef ALLOW_FIZHI
71     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
72     & iMin,iMax, jMin,jMax, bi,bj, kLev,
73     & myCurrentTime, myThid )
74     #endif /* ALLOW_FIZHI */
75     C AMM
76 jmc 1.21
77 cnh 1.2 C Add windstress momentum impulse into the top-layer
78 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
79 cnh 1.2 DO j=jMin,jMax
80     DO i=iMin,iMax
81     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
82 jmc 1.26 & +foFacMom*surfaceForcingU(i,j,bi,bj)
83     & *recip_drF(kLev)*recip_hFacW(i,j,kLev,bi,bj)
84 cnh 1.2 ENDDO
85     ENDDO
86     ENDIF
87    
88 heimbach 1.29 #if (defined (ALLOW_TAU_EDDY) || defined (ALLOW_GMREDI))
89     CALL TAUEDDY_EXTERNAL_FORCING_U(
90     I iMin, iMax, jMin, jMax,bi,bj,kLev,
91     I myCurrentTime,myThid)
92     #endif
93    
94 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
95     IF (useOBCS) THEN
96     CALL OBCS_SPONGE_U(
97     I iMin, iMax, jMin, jMax,bi,bj,kLev,
98     I myCurrentTime,myThid)
99     ENDIF
100 heimbach 1.14 #endif
101    
102 cnh 1.1 RETURN
103     END
104 cnh 1.13 CBOP
105     C !ROUTINE: EXTERNAL_FORCING_V
106     C !INTERFACE:
107 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_V(
108     I iMin, iMax, jMin, jMax,bi,bj,kLev,
109     I myCurrentTime,myThid)
110 cnh 1.13 C !DESCRIPTION: \bv
111     C *==========================================================*
112     C | S/R EXTERNAL_FORCING_V
113     C | o Contains problem specific forcing for merid velocity.
114     C *==========================================================*
115     C | Adds terms to gV for forcing by external sources
116     C | e.g. wind stress, bottom friction etc..................
117     C *==========================================================*
118     C \ev
119    
120     C !USES:
121 cnh 1.2 IMPLICIT NONE
122 cnh 1.1 C == Global data ==
123     #include "SIZE.h"
124     #include "EEPARAMS.h"
125     #include "PARAMS.h"
126     #include "GRID.h"
127     #include "DYNVARS.h"
128 cnh 1.2 #include "FFIELDS.h"
129    
130 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
131 cnh 1.1 C == Routine arguments ==
132     C iMin - Working range of tile for applying forcing.
133     C iMax
134     C jMin
135     C jMax
136     C kLev
137     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
138 adcroft 1.4 _RL myCurrentTime
139     INTEGER myThid
140 cnh 1.13
141     C !LOCAL VARIABLES:
142 cnh 1.2 C == Local variables ==
143     C Loop counters
144     INTEGER I, J
145 mlosch 1.17 C number of surface interface layer
146     INTEGER kSurface
147 cnh 1.13 CEOP
148 cnh 1.2
149 jmc 1.28 IF ( fluidIsAir ) THEN
150 jmc 1.21 kSurface = 0
151 jmc 1.28 ELSEIF ( usingPCoords ) THEN
152 mlosch 1.17 kSurface = Nr
153 jmc 1.28 ELSE
154 mlosch 1.17 kSurface = 1
155 jmc 1.28 ENDIF
156 mlosch 1.17
157 cnh 1.2 C-- Forcing term
158 jmc 1.21 #ifdef ALLOW_AIM
159     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
160     & iMin,iMax, jMin,jMax, bi,bj, kLev,
161     & myCurrentTime, myThid )
162     #endif /* ALLOW_AIM */
163    
164 molod 1.23 C AMM
165     #ifdef ALLOW_FIZHI
166     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
167     & iMin,iMax, jMin,jMax, bi,bj, kLev,
168     & myCurrentTime, myThid )
169     #endif /* ALLOW_FIZHI */
170     C AMM
171 cnh 1.2 C Add windstress momentum impulse into the top-layer
172 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
173 cnh 1.2 DO j=jMin,jMax
174     DO i=iMin,iMax
175     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
176 jmc 1.26 & +foFacMom*surfaceForcingV(i,j,bi,bj)
177     & *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)
178 cnh 1.2 ENDDO
179     ENDDO
180     ENDIF
181 cnh 1.1
182 heimbach 1.29 #if (defined (ALLOW_TAU_EDDY) || defined (ALLOW_GMREDI))
183     CALL TAUEDDY_EXTERNAL_FORCING_V(
184     I iMin, iMax, jMin, jMax,bi,bj,kLev,
185     I myCurrentTime,myThid)
186     #endif
187    
188 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
189     IF (useOBCS) THEN
190     CALL OBCS_SPONGE_V(
191     I iMin, iMax, jMin, jMax,bi,bj,kLev,
192     I myCurrentTime,myThid)
193     ENDIF
194 heimbach 1.14 #endif
195    
196 cnh 1.1 RETURN
197     END
198 cnh 1.13 CBOP
199     C !ROUTINE: EXTERNAL_FORCING_T
200     C !INTERFACE:
201 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_T(
202     I iMin, iMax, jMin, jMax,bi,bj,kLev,
203     I myCurrentTime,myThid)
204 cnh 1.13 C !DESCRIPTION: \bv
205     C *==========================================================*
206     C | S/R EXTERNAL_FORCING_T
207     C | o Contains problem specific forcing for temperature.
208     C *==========================================================*
209     C | Adds terms to gT for forcing by external sources
210     C | e.g. heat flux, climatalogical relaxation..............
211     C *==========================================================*
212     C \ev
213    
214     C !USES:
215 cnh 1.2 IMPLICIT NONE
216 cnh 1.1 C == Global data ==
217     #include "SIZE.h"
218     #include "EEPARAMS.h"
219     #include "PARAMS.h"
220     #include "GRID.h"
221     #include "DYNVARS.h"
222     #include "FFIELDS.h"
223 heimbach 1.7
224 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
225 cnh 1.1 C == Routine arguments ==
226     C iMin - Working range of tile for applying forcing.
227     C iMax
228     C jMin
229     C jMax
230     C kLev
231     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
232 adcroft 1.4 _RL myCurrentTime
233     INTEGER myThid
234 cnh 1.1 CEndOfInterface
235    
236 cnh 1.13 C !LOCAL VARIABLES:
237 cnh 1.2 C == Local variables ==
238     C Loop counters
239     INTEGER I, J
240 mlosch 1.17 C number of surface interface layer
241     INTEGER kSurface
242 jmc 1.24 #ifdef SHORTWAVE_HEATING
243     integer two
244     _RL minusone
245     parameter (two=2,minusone=-1.)
246     _RL swfracb(two)
247     INTEGER kp1
248     #endif
249 cnh 1.13 CEOP
250 cnh 1.2
251 jmc 1.28 IF ( fluidIsAir ) THEN
252 jmc 1.21 kSurface = 0
253 jmc 1.28 ELSEIF ( usingPCoords ) THEN
254 mlosch 1.17 kSurface = Nr
255 jmc 1.28 ELSE
256 mlosch 1.17 kSurface = 1
257 jmc 1.28 ENDIF
258 mlosch 1.17
259 cnh 1.2 C-- Forcing term
260 jmc 1.21 #ifdef ALLOW_AIM
261     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
262     & iMin,iMax, jMin,jMax, bi,bj, kLev,
263     & myCurrentTime, myThid )
264     #endif /* ALLOW_AIM */
265    
266 molod 1.23 C AMM
267     #ifdef ALLOW_FIZHI
268     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
269     & iMin,iMax, jMin,jMax, bi,bj, kLev,
270     & myCurrentTime, myThid )
271     #endif /* ALLOW_FIZHI */
272     C AMM
273 heimbach 1.25
274 cnh 1.2 C Add heat in top-layer
275 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
276 cnh 1.2 DO j=jMin,jMax
277     DO i=iMin,iMax
278     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
279 jmc 1.26 & +surfaceForcingT(i,j,bi,bj)
280     & *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
281 cnh 1.2 ENDDO
282     ENDDO
283     ENDIF
284 adcroft 1.5
285     #ifdef SHORTWAVE_HEATING
286     C Penetrating SW radiation
287 jmc 1.24 kp1 = klev+1
288 heimbach 1.8 swfracb(1)=abs(rF(klev))
289     swfracb(2)=abs(rF(klev+1))
290 jmc 1.24 CALL SWFRAC(
291 heimbach 1.8 I two,minusone,
292     I myCurrentTime,myThid,
293 dimitri 1.18 U swfracb)
294 jmc 1.24 IF (klev.EQ.Nr) THEN
295     kp1 = klev
296     swfracb(2)=0. _d 0
297     ENDIF
298 adcroft 1.5 DO j=jMin,jMax
299     DO i=iMin,iMax
300 adcroft 1.12 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
301 jmc 1.24 & -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
302     & -swfracb(2)*maskC(i,j,kp1, bi,bj))
303 jmc 1.27 & *recip_Cp*recip_rhoConst
304     & *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)
305 adcroft 1.5 ENDDO
306     ENDDO
307     #endif
308 heimbach 1.14
309 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
310     IF (useOBCS) THEN
311     CALL OBCS_SPONGE_T(
312     I iMin, iMax, jMin, jMax,bi,bj,kLev,
313     I myCurrentTime,myThid)
314     ENDIF
315 heimbach 1.14 #endif
316    
317 cnh 1.1 RETURN
318     END
319 cnh 1.13 CBOP
320     C !ROUTINE: EXTERNAL_FORCING_S
321     C !INTERFACE:
322 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_S(
323     I iMin, iMax, jMin, jMax,bi,bj,kLev,
324     I myCurrentTime,myThid)
325 cnh 1.13
326     C !DESCRIPTION: \bv
327     C *==========================================================*
328     C | S/R EXTERNAL_FORCING_S
329     C | o Contains problem specific forcing for merid velocity.
330     C *==========================================================*
331     C | Adds terms to gS for forcing by external sources
332     C | e.g. fresh-water flux, climatalogical relaxation.......
333     C *==========================================================*
334     C \ev
335    
336     C !USES:
337 cnh 1.2 IMPLICIT NONE
338 cnh 1.1 C == Global data ==
339     #include "SIZE.h"
340     #include "EEPARAMS.h"
341     #include "PARAMS.h"
342     #include "GRID.h"
343     #include "DYNVARS.h"
344 cnh 1.2 #include "FFIELDS.h"
345 cnh 1.1
346 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
347 cnh 1.1 C == Routine arguments ==
348     C iMin - Working range of tile for applying forcing.
349     C iMax
350     C jMin
351     C jMax
352     C kLev
353     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
354 adcroft 1.4 _RL myCurrentTime
355     INTEGER myThid
356 cnh 1.2
357 cnh 1.13 C !LOCAL VARIABLES:
358 cnh 1.2 C == Local variables ==
359     C Loop counters
360     INTEGER I, J
361 mlosch 1.17 C number of surface interface layer
362     INTEGER kSurface
363 cnh 1.13 CEOP
364 cnh 1.2
365 jmc 1.28 IF ( fluidIsAir ) THEN
366 jmc 1.21 kSurface = 0
367 jmc 1.28 ELSEIF ( usingPCoords ) THEN
368 mlosch 1.17 kSurface = Nr
369 jmc 1.28 ELSE
370 mlosch 1.17 kSurface = 1
371 jmc 1.28 ENDIF
372 mlosch 1.17
373 cnh 1.2 C-- Forcing term
374 jmc 1.21 #ifdef ALLOW_AIM
375     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
376     & iMin,iMax, jMin,jMax, bi,bj, kLev,
377     & myCurrentTime, myThid )
378     #endif /* ALLOW_AIM */
379    
380 molod 1.23 C AMM
381     #ifdef ALLOW_FIZHI
382     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
383     & iMin,iMax, jMin,jMax, bi,bj, kLev,
384     & myCurrentTime, myThid )
385     #endif /* ALLOW_FIZHI */
386     C AMM
387 heimbach 1.25
388 cnh 1.2 C Add fresh-water in top-layer
389 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
390 cnh 1.2 DO j=jMin,jMax
391     DO i=iMin,iMax
392     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
393 jmc 1.26 & +surfaceForcingS(i,j,bi,bj)
394     & *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
395 cnh 1.2 ENDDO
396     ENDDO
397     ENDIF
398 heimbach 1.14
399 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
400     IF (useOBCS) THEN
401     CALL OBCS_SPONGE_S(
402     I iMin, iMax, jMin, jMax,bi,bj,kLev,
403     I myCurrentTime,myThid)
404     ENDIF
405 heimbach 1.14 #endif
406 cnh 1.1
407     RETURN
408     END

  ViewVC Help
Powered by ViewVC 1.1.22