/[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.18 - (show annotations) (download)
Tue Feb 18 05:33:54 2003 UTC (21 years, 4 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint50c_post, checkpoint50c_pre, checkpoint48i_post, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint48f_post, checkpoint48h_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint50g_post, checkpoint50e_pre, checkpoint50e_post, checkpoint50d_pre, checkpoint49, checkpoint48g_post, checkpoint50b_post
Changes since 1.17: +2 -2 lines
Merging from release1_p12:
o Modifications for using pkg/exf with pkg/seaice
  - improved description of the various forcing configurations
  - added basic radiation bulk formulae to pkg/exf
  - units/sign fix for evap computation in exf_getffields.F
  - updated verification/global_with_exf/results/output.txt
o Added pkg/sbo for computing IERS Special Bureau for the Oceans
  (SBO) core products, including oceanic mass, center-of-mass,
  angular, and bottom pressure (see pkg/sbo/README.sbo).
o Lower bound for viscosity/diffusivity in pkg/kpp/kpp_routines.F
  to avoid negative values in shallow regions.
  - updated verification/natl_box/results/output.txt
  - updated verification/lab_sea/results/output.txt
o MPI gather, scatter: eesupp/src/gather_2d.F and scatter_2d.F
o Added useSingleCpuIO option (see PARAMS.h).
o Updated useSingleCpuIO option in mdsio_writefield.F to
  work with multi-field files, e.g., for single-file pickup.
o pkg/seaice:
  - bug fix in growth.F: QNET for no shortwave case
  - added HeffFile for specifying initial sea-ice thickness
  - changed SEAICE_EXTERNAL_FLUXES wind stress implementation
o Added missing /* */ to CPP comments in pkg/seaice, pkg/exf,
  kpp_transport_t.F, forward_step.F, and the_main_loop.F
o pkg/seaice:
  - adjoint-friendly modifications
  - added a SEAICE_WRITE_PICKUP at end of the_model_main.F

1 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.17 2002/09/25 19:36:50 mlosch 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 U 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