/[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.26 - (hide annotations) (download)
Sun Jul 18 01:04:23 2004 UTC (19 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint54c_post
Changes since 1.25: +10 -7 lines
replace surfaceTendency U,V,S,T,Tice by surfaceForcing U,V,S,T,Tice

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

  ViewVC Help
Powered by ViewVC 1.1.22