/[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.23 - (hide annotations) (download)
Mon Dec 15 23:00:44 2003 UTC (21 years, 7 months ago) by molod
Branch: MAIN
CVS Tags: checkpoint52l_pre, hrcube4, hrcube5, checkpoint52j_pre, checkpoint52l_post, checkpoint52k_post, checkpoint52f_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint52e_pre, checkpoint52e_post, checkpoint52f_pre, checkpoint52d_post, checkpoint52i_post, checkpoint52h_pre, checkpoint52j_post
Changes since 1.22: +29 -1 lines
 o added some infrastructure to call fizhi and gridalt routines
 o added package dependencies for fizhi

1 molod 1.23 C $Header: /u/u3/gcmpack/MITgcm/model/src/external_forcing.F,v 1.22 2003/12/11 21:23:00 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 #ifdef SHORTWAVE_HEATING
212 heimbach 1.8 integer two
213     _RL minusone
214     parameter (two=2,minusone=-1.)
215     _RL swfracb(two)
216 heimbach 1.7 #endif
217    
218 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
219 cnh 1.1 C == Routine arguments ==
220     C iMin - Working range of tile for applying forcing.
221     C iMax
222     C jMin
223     C jMax
224     C kLev
225     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
226 adcroft 1.4 _RL myCurrentTime
227     INTEGER myThid
228 cnh 1.1 CEndOfInterface
229    
230 cnh 1.13 C !LOCAL VARIABLES:
231 cnh 1.2 C == Local variables ==
232     C Loop counters
233     INTEGER I, J
234 mlosch 1.17 C number of surface interface layer
235     INTEGER kSurface
236 cnh 1.13 CEOP
237 cnh 1.2
238 jmc 1.22 if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
239 jmc 1.21 kSurface = 0
240     elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
241 mlosch 1.17 kSurface = Nr
242     else
243     kSurface = 1
244     endif
245    
246 cnh 1.2 C-- Forcing term
247 jmc 1.21 #ifdef ALLOW_AIM
248     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
249     & iMin,iMax, jMin,jMax, bi,bj, kLev,
250     & myCurrentTime, myThid )
251     #endif /* ALLOW_AIM */
252    
253 molod 1.23 C AMM
254     #ifdef ALLOW_FIZHI
255     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
256     & iMin,iMax, jMin,jMax, bi,bj, kLev,
257     & myCurrentTime, myThid )
258     #endif /* ALLOW_FIZHI */
259     C AMM
260 cnh 1.2 C Add heat in top-layer
261 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
262 cnh 1.2 DO j=jMin,jMax
263     DO i=iMin,iMax
264     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
265 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
266 cnh 1.2 ENDDO
267     ENDDO
268     ENDIF
269 adcroft 1.5
270     #ifdef SHORTWAVE_HEATING
271     C Penetrating SW radiation
272 heimbach 1.8 swfracb(1)=abs(rF(klev))
273     swfracb(2)=abs(rF(klev+1))
274     call SWFRAC(
275     I two,minusone,
276     I myCurrentTime,myThid,
277 dimitri 1.18 U swfracb)
278 adcroft 1.5 DO j=jMin,jMax
279     DO i=iMin,iMax
280 adcroft 1.12 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
281     & -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
282 mlosch 1.17 & *recip_Cp*recip_rhoConst*recip_drF(klev)
283 adcroft 1.5 ENDDO
284     ENDDO
285     #endif
286 heimbach 1.14
287 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
288     IF (useOBCS) THEN
289     CALL OBCS_SPONGE_T(
290     I iMin, iMax, jMin, jMax,bi,bj,kLev,
291     I myCurrentTime,myThid)
292     ENDIF
293 heimbach 1.14 #endif
294    
295 cnh 1.1 RETURN
296     END
297 cnh 1.13 CBOP
298     C !ROUTINE: EXTERNAL_FORCING_S
299     C !INTERFACE:
300 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_S(
301     I iMin, iMax, jMin, jMax,bi,bj,kLev,
302     I myCurrentTime,myThid)
303 cnh 1.13
304     C !DESCRIPTION: \bv
305     C *==========================================================*
306     C | S/R EXTERNAL_FORCING_S
307     C | o Contains problem specific forcing for merid velocity.
308     C *==========================================================*
309     C | Adds terms to gS for forcing by external sources
310     C | e.g. fresh-water flux, climatalogical relaxation.......
311     C *==========================================================*
312     C \ev
313    
314     C !USES:
315 cnh 1.2 IMPLICIT NONE
316 cnh 1.1 C == Global data ==
317     #include "SIZE.h"
318     #include "EEPARAMS.h"
319     #include "PARAMS.h"
320     #include "GRID.h"
321     #include "DYNVARS.h"
322 cnh 1.2 #include "FFIELDS.h"
323 cnh 1.1
324 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
325 cnh 1.1 C == Routine arguments ==
326     C iMin - Working range of tile for applying forcing.
327     C iMax
328     C jMin
329     C jMax
330     C kLev
331     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
332 adcroft 1.4 _RL myCurrentTime
333     INTEGER myThid
334 cnh 1.2
335 cnh 1.13 C !LOCAL VARIABLES:
336 cnh 1.2 C == Local variables ==
337     C Loop counters
338     INTEGER I, J
339 mlosch 1.17 C number of surface interface layer
340     INTEGER kSurface
341 cnh 1.13 CEOP
342 cnh 1.2
343 jmc 1.22 if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
344 jmc 1.21 kSurface = 0
345     elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
346 mlosch 1.17 kSurface = Nr
347     else
348     kSurface = 1
349     endif
350    
351    
352 cnh 1.2 C-- Forcing term
353 jmc 1.21 #ifdef ALLOW_AIM
354     IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
355     & iMin,iMax, jMin,jMax, bi,bj, kLev,
356     & myCurrentTime, myThid )
357     #endif /* ALLOW_AIM */
358    
359 molod 1.23 C AMM
360     #ifdef ALLOW_FIZHI
361     IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
362     & iMin,iMax, jMin,jMax, bi,bj, kLev,
363     & myCurrentTime, myThid )
364     #endif /* ALLOW_FIZHI */
365     C AMM
366 cnh 1.2 C Add fresh-water in top-layer
367 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
368 cnh 1.2 DO j=jMin,jMax
369     DO i=iMin,iMax
370     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
371 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
372 cnh 1.2 ENDDO
373     ENDDO
374     ENDIF
375 heimbach 1.14
376 heimbach 1.16 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
377     IF (useOBCS) THEN
378     CALL OBCS_SPONGE_S(
379     I iMin, iMax, jMin, jMax,bi,bj,kLev,
380     I myCurrentTime,myThid)
381     ENDIF
382 heimbach 1.14 #endif
383 cnh 1.1
384     RETURN
385     END

  ViewVC Help
Powered by ViewVC 1.1.22