/[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.17 - (show annotations) (download)
Wed Sep 25 19:36:50 2002 UTC (23 years, 2 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47e_post, checkpoint46l_post, checkpoint47c_post, checkpoint48e_post, checkpoint46l_pre, checkpoint48b_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint47a_post, checkpoint48d_pre, checkpoint47i_post, checkpoint47d_post, checkpoint48d_post, checkpoint46j_pre, checkpoint47g_post, checkpoint46j_post, checkpoint46k_post, checkpoint48a_post, checkpoint47j_post, branch-exfmods-tag, checkpoint48c_post, checkpoint47b_post, checkpoint46m_post, checkpoint47f_post, checkpoint46i_post, checkpoint47, checkpoint48, checkpoint46h_post, checkpoint47h_post
Branch point for: branch-exfmods-curt
Changes since 1.16: +39 -6 lines 
o cleaned up the use of rhoNil and rhoConst.
  - rhoNil should only appear in the LINEAR equation of state, everywhere
    else rhoNil is replaced by rhoConst, e.g. find_rho computes rho-rhoConst
    and the dynamical equations are all divided by rhoConst
o introduced new parameter rhoConstFresh, a reference density of fresh
  water, to remove the fresh water flux's dependence on rhoNil. The default
  value is 999.8 kg/m^3
o cleanup up external_forcing.F and external_forcing_surf.F
  - can now be used by both OCEANIC and OCEANICP
1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.16 2002/07/13 04:59:42 heimbach Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: EXTERNAL_FORCING_U
8 C !INTERFACE:
9 SUBROUTINE EXTERNAL_FORCING_U(
10 I iMin, iMax, jMin, jMax,bi,bj,kLev,
11 I myCurrentTime,myThid)
12 C !DESCRIPTION: \bv
13 C *==========================================================*
14 C | S/R EXTERNAL_FORCING_U
15 C | o Contains problem specific forcing for zonal velocity.
16 C *==========================================================*
17 C | Adds terms to gU for forcing by external sources
18 C | e.g. wind stress, bottom friction etc..................
19 C *==========================================================*
20 C \ev
21
22 C !USES:
23 IMPLICIT NONE
24 C == Global data ==
25 #include "SIZE.h"
26 #include "EEPARAMS.h"
27 #include "PARAMS.h"
28 #include "GRID.h"
29 #include "DYNVARS.h"
30 #include "FFIELDS.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C == Routine arguments ==
34 C iMin - Working range of tile for applying forcing.
35 C iMax
36 C jMin
37 C jMax
38 C kLev
39 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
40 _RL myCurrentTime
41 INTEGER myThid
42
43 C !LOCAL VARIABLES:
44 C == Local variables ==
45 C Loop counters
46 INTEGER I, J
47 C number of surface interface layer
48 INTEGER kSurface
49 CEOP
50
51 if ( buoyancyRelation .eq. 'OCEANICP' ) then
52 kSurface = Nr
53 else
54 kSurface = 1
55 endif
56
57 C-- Forcing term
58 C Add windstress momentum impulse into the top-layer
59 IF ( kLev .EQ. kSurface ) THEN
60 DO j=jMin,jMax
61 DO i=iMin,iMax
62 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
63 & +foFacMom*surfaceTendencyU(i,j,bi,bj)
64 & *_maskW(i,j,kLev,bi,bj)
65 ENDDO
66 ENDDO
67 ENDIF
68
69 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
70 IF (useOBCS) THEN
71 CALL OBCS_SPONGE_U(
72 I iMin, iMax, jMin, jMax,bi,bj,kLev,
73 I myCurrentTime,myThid)
74 ENDIF
75 #endif
76
77 RETURN
78 END
79 CBOP
80 C !ROUTINE: EXTERNAL_FORCING_V
81 C !INTERFACE:
82 SUBROUTINE EXTERNAL_FORCING_V(
83 I iMin, iMax, jMin, jMax,bi,bj,kLev,
84 I myCurrentTime,myThid)
85 C !DESCRIPTION: \bv
86 C *==========================================================*
87 C | S/R EXTERNAL_FORCING_V
88 C | o Contains problem specific forcing for merid velocity.
89 C *==========================================================*
90 C | Adds terms to gV for forcing by external sources
91 C | e.g. wind stress, bottom friction etc..................
92 C *==========================================================*
93 C \ev
94
95 C !USES:
96 IMPLICIT NONE
97 C == Global data ==
98 #include "SIZE.h"
99 #include "EEPARAMS.h"
100 #include "PARAMS.h"
101 #include "GRID.h"
102 #include "DYNVARS.h"
103 #include "FFIELDS.h"
104
105 C !INPUT/OUTPUT PARAMETERS:
106 C == Routine arguments ==
107 C iMin - Working range of tile for applying forcing.
108 C iMax
109 C jMin
110 C jMax
111 C kLev
112 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
113 _RL myCurrentTime
114 INTEGER myThid
115
116 C !LOCAL VARIABLES:
117 C == Local variables ==
118 C Loop counters
119 INTEGER I, J
120 C number of surface interface layer
121 INTEGER kSurface
122 CEOP
123
124 if ( buoyancyRelation .eq. 'OCEANICP' ) then
125 kSurface = Nr
126 else
127 kSurface = 1
128 endif
129
130 C-- Forcing term
131 C Add windstress momentum impulse into the top-layer
132 IF ( kLev .EQ. kSurface ) THEN
133 DO j=jMin,jMax
134 DO i=iMin,iMax
135 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
136 & +foFacMom*surfaceTendencyV(i,j,bi,bj)
137 & *_maskS(i,j,kLev,bi,bj)
138 ENDDO
139 ENDDO
140 ENDIF
141
142 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
143 IF (useOBCS) THEN
144 CALL OBCS_SPONGE_V(
145 I iMin, iMax, jMin, jMax,bi,bj,kLev,
146 I myCurrentTime,myThid)
147 ENDIF
148 #endif
149
150 RETURN
151 END
152 CBOP
153 C !ROUTINE: EXTERNAL_FORCING_T
154 C !INTERFACE:
155 SUBROUTINE EXTERNAL_FORCING_T(
156 I iMin, iMax, jMin, jMax,bi,bj,kLev,
157 I myCurrentTime,myThid)
158 C !DESCRIPTION: \bv
159 C *==========================================================*
160 C | S/R EXTERNAL_FORCING_T
161 C | o Contains problem specific forcing for temperature.
162 C *==========================================================*
163 C | Adds terms to gT for forcing by external sources
164 C | e.g. heat flux, climatalogical relaxation..............
165 C *==========================================================*
166 C \ev
167
168 C !USES:
169 IMPLICIT NONE
170 C == Global data ==
171 #include "SIZE.h"
172 #include "EEPARAMS.h"
173 #include "PARAMS.h"
174 #include "GRID.h"
175 #include "DYNVARS.h"
176 #include "FFIELDS.h"
177 #ifdef SHORTWAVE_HEATING
178 integer two
179 _RL minusone
180 parameter (two=2,minusone=-1.)
181 _RL swfracb(two)
182 #endif
183
184 C !INPUT/OUTPUT PARAMETERS:
185 C == Routine arguments ==
186 C iMin - Working range of tile for applying forcing.
187 C iMax
188 C jMin
189 C jMax
190 C kLev
191 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
192 _RL myCurrentTime
193 INTEGER myThid
194 CEndOfInterface
195
196 C !LOCAL VARIABLES:
197 C == Local variables ==
198 C Loop counters
199 INTEGER I, J
200 C number of surface interface layer
201 INTEGER kSurface
202 CEOP
203
204 if ( buoyancyRelation .eq. 'OCEANICP' ) then
205 kSurface = Nr
206 else
207 kSurface = 1
208 endif
209
210 C-- Forcing term
211 C Add heat in top-layer
212 IF ( kLev .EQ. kSurface ) THEN
213 DO j=jMin,jMax
214 DO i=iMin,iMax
215 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
216 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
217 ENDDO
218 ENDDO
219 ENDIF
220
221 #ifdef SHORTWAVE_HEATING
222 C Penetrating SW radiation
223 swfracb(1)=abs(rF(klev))
224 swfracb(2)=abs(rF(klev+1))
225 call SWFRAC(
226 I two,minusone,
227 I myCurrentTime,myThid,
228 O swfracb)
229 DO j=jMin,jMax
230 DO i=iMin,iMax
231 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
232 & -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
233 & *recip_Cp*recip_rhoConst*recip_drF(klev)
234 ENDDO
235 ENDDO
236 #endif
237
238 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
239 IF (useOBCS) THEN
240 CALL OBCS_SPONGE_T(
241 I iMin, iMax, jMin, jMax,bi,bj,kLev,
242 I myCurrentTime,myThid)
243 ENDIF
244 #endif
245
246 RETURN
247 END
248 CBOP
249 C !ROUTINE: EXTERNAL_FORCING_S
250 C !INTERFACE:
251 SUBROUTINE EXTERNAL_FORCING_S(
252 I iMin, iMax, jMin, jMax,bi,bj,kLev,
253 I myCurrentTime,myThid)
254
255 C !DESCRIPTION: \bv
256 C *==========================================================*
257 C | S/R EXTERNAL_FORCING_S
258 C | o Contains problem specific forcing for merid velocity.
259 C *==========================================================*
260 C | Adds terms to gS for forcing by external sources
261 C | e.g. fresh-water flux, climatalogical relaxation.......
262 C *==========================================================*
263 C \ev
264
265 C !USES:
266 IMPLICIT NONE
267 C == Global data ==
268 #include "SIZE.h"
269 #include "EEPARAMS.h"
270 #include "PARAMS.h"
271 #include "GRID.h"
272 #include "DYNVARS.h"
273 #include "FFIELDS.h"
274
275 C !INPUT/OUTPUT PARAMETERS:
276 C == Routine arguments ==
277 C iMin - Working range of tile for applying forcing.
278 C iMax
279 C jMin
280 C jMax
281 C kLev
282 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
283 _RL myCurrentTime
284 INTEGER myThid
285
286 C !LOCAL VARIABLES:
287 C == Local variables ==
288 C Loop counters
289 INTEGER I, J
290 C number of surface interface layer
291 INTEGER kSurface
292 CEOP
293
294 if ( buoyancyRelation .eq. 'OCEANICP' ) then
295 kSurface = Nr
296 else
297 kSurface = 1
298 endif
299
300
301 C-- Forcing term
302 C Add fresh-water in top-layer
303 IF ( kLev .EQ. kSurface ) THEN
304 DO j=jMin,jMax
305 DO i=iMin,iMax
306 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
307 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
308 ENDDO
309 ENDDO
310 ENDIF
311
312 #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
313 IF (useOBCS) THEN
314 CALL OBCS_SPONGE_S(
315 I iMin, iMax, jMin, jMax,bi,bj,kLev,
316 I myCurrentTime,myThid)
317 ENDIF
318 #endif
319
320 RETURN
321 END
  ViewVC Help
Powered by ViewVC 1.1.22