/[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.25 - (hide annotations) (download)
Fri May 14 21:08:28 2004 UTC (20 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint54, checkpoint53d_post, checkpoint54b_post, checkpoint54a_pre, checkpoint53c_post, checkpoint54a_post, checkpoint53g_post, checkpoint53f_post, checkpoint53b_post, checkpoint53d_pre
Changes since 1.24: +3 -1 lines
Commiting new energy balance model to repository
o package is pkg/ebm
o verif. is verification/global_ocean_ebm
o references are in ebm_driver.F
Will need long integration testing.

1 heimbach 1.25 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.24 2004/04/08 04:04:24 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.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 heimbach 1.7 & +foFacMom*surfaceTendencyU(i,j,bi,bj)
83 adcroft 1.3 & *_maskW(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 heimbach 1.7 & +foFacMom*surfaceTendencyV(i,j,bi,bj)
171 adcroft 1.3 & *_maskS(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 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
268 cnh 1.2 ENDDO
269     ENDDO
270     ENDIF
271 adcroft 1.5
272     #ifdef SHORTWAVE_HEATING
273     C Penetrating SW radiation
274 jmc 1.24 kp1 = klev+1
275 heimbach 1.8 swfracb(1)=abs(rF(klev))
276     swfracb(2)=abs(rF(klev+1))
277 jmc 1.24 CALL SWFRAC(
278 heimbach 1.8 I two,minusone,
279     I myCurrentTime,myThid,
280 dimitri 1.18 U swfracb)
281 jmc 1.24 IF (klev.EQ.Nr) THEN
282     kp1 = klev
283     swfracb(2)=0. _d 0
284     ENDIF
285 adcroft 1.5 DO j=jMin,jMax
286     DO i=iMin,iMax
287 adcroft 1.12 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
288 jmc 1.24 & -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
289     & -swfracb(2)*maskC(i,j,kp1, bi,bj))
290 mlosch 1.17 & *recip_Cp*recip_rhoConst*recip_drF(klev)
291 adcroft 1.5 ENDDO
292     ENDDO
293     #endif
294 heimbach 1.14
295 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
296     IF (useOBCS) THEN
297     CALL OBCS_SPONGE_T(
298     I iMin, iMax, jMin, jMax,bi,bj,kLev,
299     I myCurrentTime,myThid)
300     ENDIF
301 heimbach 1.14 #endif
302    
303 cnh 1.1 RETURN
304     END
305 cnh 1.13 CBOP
306     C !ROUTINE: EXTERNAL_FORCING_S
307     C !INTERFACE:
308 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_S(
309     I iMin, iMax, jMin, jMax,bi,bj,kLev,
310     I myCurrentTime,myThid)
311 cnh 1.13
312     C !DESCRIPTION: \bv
313     C *==========================================================*
314     C | S/R EXTERNAL_FORCING_S
315     C | o Contains problem specific forcing for merid velocity.
316     C *==========================================================*
317     C | Adds terms to gS for forcing by external sources
318     C | e.g. fresh-water flux, climatalogical relaxation.......
319     C *==========================================================*
320     C \ev
321    
322     C !USES:
323 cnh 1.2 IMPLICIT NONE
324 cnh 1.1 C == Global data ==
325     #include "SIZE.h"
326     #include "EEPARAMS.h"
327     #include "PARAMS.h"
328     #include "GRID.h"
329     #include "DYNVARS.h"
330 cnh 1.2 #include "FFIELDS.h"
331 cnh 1.1
332 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
333 cnh 1.1 C == Routine arguments ==
334     C iMin - Working range of tile for applying forcing.
335     C iMax
336     C jMin
337     C jMax
338     C kLev
339     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
340 adcroft 1.4 _RL myCurrentTime
341     INTEGER myThid
342 cnh 1.2
343 cnh 1.13 C !LOCAL VARIABLES:
344 cnh 1.2 C == Local variables ==
345     C Loop counters
346     INTEGER I, J
347 mlosch 1.17 C number of surface interface layer
348     INTEGER kSurface
349 cnh 1.13 CEOP
350 cnh 1.2
351 jmc 1.22 if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
352 jmc 1.21 kSurface = 0
353     elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
354 mlosch 1.17 kSurface = Nr
355     else
356     kSurface = 1
357     endif
358    
359    
360 cnh 1.2 C-- Forcing term
361 jmc 1.21 #ifdef ALLOW_AIM
362     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
363     & iMin,iMax, jMin,jMax, bi,bj, kLev,
364     & myCurrentTime, myThid )
365     #endif /* ALLOW_AIM */
366    
367 molod 1.23 C AMM
368     #ifdef ALLOW_FIZHI
369     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
370     & iMin,iMax, jMin,jMax, bi,bj, kLev,
371     & myCurrentTime, myThid )
372     #endif /* ALLOW_FIZHI */
373     C AMM
374 heimbach 1.25
375 cnh 1.2 C Add fresh-water in top-layer
376 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
377 cnh 1.2 DO j=jMin,jMax
378     DO i=iMin,iMax
379     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
380 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
381 cnh 1.2 ENDDO
382     ENDDO
383     ENDIF
384 heimbach 1.14
385 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
386     IF (useOBCS) THEN
387     CALL OBCS_SPONGE_S(
388     I iMin, iMax, jMin, jMax,bi,bj,kLev,
389     I myCurrentTime,myThid)
390     ENDIF
391 heimbach 1.14 #endif
392 cnh 1.1
393     RETURN
394     END

  ViewVC Help
Powered by ViewVC 1.1.22