/[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.18 - (hide annotations) (download)
Tue Feb 18 05:33:54 2003 UTC (21 years, 3 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 dimitri 1.18 C $Header: /u/gcmpack/MITgcm/model/src/external_forcing.F,v 1.17 2002/09/25 19:36:50 mlosch Exp $
2 adcroft 1.12 C $Name: $
3 cnh 1.1
4     #include "CPP_OPTIONS.h"
5    
6 cnh 1.13 CBOP
7     C !ROUTINE: EXTERNAL_FORCING_U
8     C !INTERFACE:
9 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_U(
10     I iMin, iMax, jMin, jMax,bi,bj,kLev,
11     I myCurrentTime,myThid)
12 cnh 1.13 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 cnh 1.2 IMPLICIT NONE
24 cnh 1.1 C == Global data ==
25     #include "SIZE.h"
26     #include "EEPARAMS.h"
27     #include "PARAMS.h"
28     #include "GRID.h"
29     #include "DYNVARS.h"
30 cnh 1.2 #include "FFIELDS.h"
31 cnh 1.13
32     C !INPUT/OUTPUT PARAMETERS:
33 cnh 1.1 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 adcroft 1.4 _RL myCurrentTime
41     INTEGER myThid
42 cnh 1.1
43 cnh 1.13 C !LOCAL VARIABLES:
44 cnh 1.2 C == Local variables ==
45     C Loop counters
46     INTEGER I, J
47 mlosch 1.17 C number of surface interface layer
48     INTEGER kSurface
49 cnh 1.13 CEOP
50 cnh 1.2
51 mlosch 1.17 if ( buoyancyRelation .eq. 'OCEANICP' ) then
52     kSurface = Nr
53     else
54     kSurface = 1
55     endif
56    
57 cnh 1.2 C-- Forcing term
58     C Add windstress momentum impulse into the top-layer
59 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
60 cnh 1.2 DO j=jMin,jMax
61     DO i=iMin,iMax
62     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
63 heimbach 1.7 & +foFacMom*surfaceTendencyU(i,j,bi,bj)
64 adcroft 1.3 & *_maskW(i,j,kLev,bi,bj)
65 cnh 1.2 ENDDO
66     ENDDO
67     ENDIF
68    
69 heimbach 1.16 #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 heimbach 1.14 #endif
76    
77 cnh 1.1 RETURN
78     END
79 cnh 1.13 CBOP
80     C !ROUTINE: EXTERNAL_FORCING_V
81     C !INTERFACE:
82 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_V(
83     I iMin, iMax, jMin, jMax,bi,bj,kLev,
84     I myCurrentTime,myThid)
85 cnh 1.13 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 cnh 1.2 IMPLICIT NONE
97 cnh 1.1 C == Global data ==
98     #include "SIZE.h"
99     #include "EEPARAMS.h"
100     #include "PARAMS.h"
101     #include "GRID.h"
102     #include "DYNVARS.h"
103 cnh 1.2 #include "FFIELDS.h"
104    
105 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
106 cnh 1.1 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 adcroft 1.4 _RL myCurrentTime
114     INTEGER myThid
115 cnh 1.13
116     C !LOCAL VARIABLES:
117 cnh 1.2 C == Local variables ==
118     C Loop counters
119     INTEGER I, J
120 mlosch 1.17 C number of surface interface layer
121     INTEGER kSurface
122 cnh 1.13 CEOP
123 cnh 1.2
124 mlosch 1.17 if ( buoyancyRelation .eq. 'OCEANICP' ) then
125     kSurface = Nr
126     else
127     kSurface = 1
128     endif
129    
130 cnh 1.2 C-- Forcing term
131     C Add windstress momentum impulse into the top-layer
132 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
133 cnh 1.2 DO j=jMin,jMax
134     DO i=iMin,iMax
135     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
136 heimbach 1.7 & +foFacMom*surfaceTendencyV(i,j,bi,bj)
137 adcroft 1.3 & *_maskS(i,j,kLev,bi,bj)
138 cnh 1.2 ENDDO
139     ENDDO
140     ENDIF
141 cnh 1.1
142 heimbach 1.16 #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 heimbach 1.14 #endif
149    
150 cnh 1.1 RETURN
151     END
152 cnh 1.13 CBOP
153     C !ROUTINE: EXTERNAL_FORCING_T
154     C !INTERFACE:
155 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_T(
156     I iMin, iMax, jMin, jMax,bi,bj,kLev,
157     I myCurrentTime,myThid)
158 cnh 1.13 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 cnh 1.2 IMPLICIT NONE
170 cnh 1.1 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 heimbach 1.7 #ifdef SHORTWAVE_HEATING
178 heimbach 1.8 integer two
179     _RL minusone
180     parameter (two=2,minusone=-1.)
181     _RL swfracb(two)
182 heimbach 1.7 #endif
183    
184 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
185 cnh 1.1 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 adcroft 1.4 _RL myCurrentTime
193     INTEGER myThid
194 cnh 1.1 CEndOfInterface
195    
196 cnh 1.13 C !LOCAL VARIABLES:
197 cnh 1.2 C == Local variables ==
198     C Loop counters
199     INTEGER I, J
200 mlosch 1.17 C number of surface interface layer
201     INTEGER kSurface
202 cnh 1.13 CEOP
203 cnh 1.2
204 mlosch 1.17 if ( buoyancyRelation .eq. 'OCEANICP' ) then
205     kSurface = Nr
206     else
207     kSurface = 1
208     endif
209    
210 cnh 1.2 C-- Forcing term
211     C Add heat in top-layer
212 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
213 cnh 1.2 DO j=jMin,jMax
214     DO i=iMin,iMax
215     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
216 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
217 cnh 1.2 ENDDO
218     ENDDO
219     ENDIF
220 adcroft 1.5
221     #ifdef SHORTWAVE_HEATING
222     C Penetrating SW radiation
223 heimbach 1.8 swfracb(1)=abs(rF(klev))
224     swfracb(2)=abs(rF(klev+1))
225     call SWFRAC(
226     I two,minusone,
227     I myCurrentTime,myThid,
228 dimitri 1.18 U swfracb)
229 adcroft 1.5 DO j=jMin,jMax
230     DO i=iMin,iMax
231 adcroft 1.12 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 mlosch 1.17 & *recip_Cp*recip_rhoConst*recip_drF(klev)
234 adcroft 1.5 ENDDO
235     ENDDO
236     #endif
237 heimbach 1.14
238 heimbach 1.16 #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 heimbach 1.14 #endif
245    
246 cnh 1.1 RETURN
247     END
248 cnh 1.13 CBOP
249     C !ROUTINE: EXTERNAL_FORCING_S
250     C !INTERFACE:
251 cnh 1.1 SUBROUTINE EXTERNAL_FORCING_S(
252     I iMin, iMax, jMin, jMax,bi,bj,kLev,
253     I myCurrentTime,myThid)
254 cnh 1.13
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 cnh 1.2 IMPLICIT NONE
267 cnh 1.1 C == Global data ==
268     #include "SIZE.h"
269     #include "EEPARAMS.h"
270     #include "PARAMS.h"
271     #include "GRID.h"
272     #include "DYNVARS.h"
273 cnh 1.2 #include "FFIELDS.h"
274 cnh 1.1
275 cnh 1.13 C !INPUT/OUTPUT PARAMETERS:
276 cnh 1.1 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 adcroft 1.4 _RL myCurrentTime
284     INTEGER myThid
285 cnh 1.2
286 cnh 1.13 C !LOCAL VARIABLES:
287 cnh 1.2 C == Local variables ==
288     C Loop counters
289     INTEGER I, J
290 mlosch 1.17 C number of surface interface layer
291     INTEGER kSurface
292 cnh 1.13 CEOP
293 cnh 1.2
294 mlosch 1.17 if ( buoyancyRelation .eq. 'OCEANICP' ) then
295     kSurface = Nr
296     else
297     kSurface = 1
298     endif
299    
300    
301 cnh 1.2 C-- Forcing term
302     C Add fresh-water in top-layer
303 mlosch 1.17 IF ( kLev .EQ. kSurface ) THEN
304 cnh 1.2 DO j=jMin,jMax
305     DO i=iMin,iMax
306     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
307 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
308 cnh 1.2 ENDDO
309     ENDDO
310     ENDIF
311 heimbach 1.14
312 heimbach 1.16 #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 heimbach 1.14 #endif
319 cnh 1.1
320     RETURN
321     END
  ViewVC Help
Powered by ViewVC 1.1.22