/[MITgcm]/MITgcm/pkg/exf/exf_getffields.F
ViewVC logotype

Annotation of /MITgcm/pkg/exf/exf_getffields.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.45 - (hide annotations) (download)
Thu Jan 5 20:33:19 2012 UTC (12 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63l, checkpoint63i, checkpoint63j, checkpoint63k
Changes since 1.44: +13 -21 lines
add argument uvInterp & remove USE_NO_INTERP_RUNOFF code

1 jmc 1.45 C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_getffields.F,v 1.44 2011/12/21 17:19:08 jmc Exp $
2 heimbach 1.19 C $Name: $
3 heimbach 1.1
4 edhill 1.17 #include "EXF_OPTIONS.h"
5 heimbach 1.1
6 heimbach 1.31 subroutine exf_getffields( mytime, myiter, mythid )
7 heimbach 1.1
8     c ==================================================================
9 heimbach 1.13 c SUBROUTINE exf_getffields
10 heimbach 1.1 c ==================================================================
11     c
12 dimitri 1.8 c o Read-in atmospheric state and/or surface fluxes from files.
13     c
14 heimbach 1.13 c heimbach@mit.edu, 23-May-2003 totally re-structured
15 dimitri 1.16 c 5-Aug-2003: added USE_EXF_INTERPOLATION for arbitrary input grid
16 dimitri 1.7 c
17 heimbach 1.1 c ==================================================================
18 heimbach 1.13 c SUBROUTINE exf_getffields
19 heimbach 1.1 c ==================================================================
20    
21     implicit none
22    
23     c == global variables ==
24    
25     #include "EEPARAMS.h"
26     #include "SIZE.h"
27     #include "PARAMS.h"
28     #include "DYNVARS.h"
29     #include "GRID.h"
30    
31 jmc 1.35 #include "EXF_PARAM.h"
32     #include "EXF_FIELDS.h"
33     #include "EXF_CONSTANTS.h"
34 heimbach 1.1
35 heimbach 1.19 #ifdef ALLOW_AUTODIFF
36 heimbach 1.14 # include "ctrl.h"
37     # include "ctrl_dummy.h"
38     #endif
39    
40 heimbach 1.1 c == routine arguments ==
41    
42 jmc 1.44 _RL mytime
43     integer myiter
44 heimbach 1.1 integer mythid
45    
46     c == local variables ==
47    
48 jmc 1.44 integer i, j, bi, bj
49 dimitri 1.20
50 gforget 1.43 #ifdef ALLOW_ROTATE_UV_CONTROLS
51     _RL tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
52     _RL tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
53     _RL tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
54     _RL tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
55     #endif
56    
57 heimbach 1.1 c == end of interface ==
58    
59 dimitri 1.8 c-- read forcing fields from files and temporal interpolation
60    
61 dimitri 1.22 c Zonal and meridional wind stress.
62     call exf_set_uv(
63 jmc 1.44 I ustressfile, ustressstartdate, ustressperiod,
64     I exf_inscal_ustress,
65     I ustress_exfremo_intercept, ustress_exfremo_slope,
66     U ustress, ustress0, ustress1, ustressmask,
67     I vstressfile, vstressstartdate, vstressperiod,
68     I exf_inscal_vstress,
69     I vstress_exfremo_intercept, vstress_exfremo_slope,
70     U vstress, vstress0, vstress1, vstressmask,
71     #ifdef USE_EXF_INTERPOLATION
72     I ustress_lon0, ustress_lon_inc, ustress_lat0, ustress_lat_inc,
73     I ustress_nlon, ustress_nlat, ustress_interpMethod,
74     I vstress_lon0, vstress_lon_inc, vstress_lat0, vstress_lat_inc,
75     I vstress_nlon, vstress_nlat, vstress_interpMethod,
76 jmc 1.45 I uvInterp_stress,
77 dimitri 1.22 #endif /* USE_EXF_INTERPOLATION */
78 jmc 1.44 I mytime, myiter, mythid )
79 dimitri 1.22
80 heimbach 1.32 c-- wind speed
81 jmc 1.44 call exf_set_gen(
82     & wspeedfile, wspeedstartdate, wspeedperiod,
83 heimbach 1.32 & exf_inscal_wspeed,
84     & wspeed_exfremo_intercept, wspeed_exfremo_slope,
85 jmc 1.44 & wspeed, wspeed0, wspeed1, wspeedmask,
86 heimbach 1.32 #ifdef USE_EXF_INTERPOLATION
87 jmc 1.44 & wspeed_lon0, wspeed_lon_inc,
88 heimbach 1.32 & wspeed_lat0, wspeed_lat_inc,
89 jmc 1.44 & wspeed_nlon, wspeed_nlat, xC, yC, wspeed_interpMethod,
90 heimbach 1.32 #endif
91     & mytime, myiter, mythid )
92    
93 dimitri 1.8 #ifdef ALLOW_ATM_WIND
94    
95 dimitri 1.20 c Zonal and meridional wind.
96     call exf_set_uv(
97 jmc 1.45 I uwindfile, uwindstartdate, uwindperiod,
98     I exf_inscal_uwind,
99     I uwind_exfremo_intercept, uwind_exfremo_slope,
100 jmc 1.44 U uwind, uwind0, uwind1, uwindmask,
101 jmc 1.45 I vwindfile, vwindstartdate, vwindperiod,
102     I exf_inscal_vwind,
103     I vwind_exfremo_intercept, vwind_exfremo_slope,
104 jmc 1.44 U vwind, vwind0, vwind1, vwindmask,
105     #ifdef USE_EXF_INTERPOLATION
106 jmc 1.45 I uwind_lon0, uwind_lon_inc, uwind_lat0, uwind_lat_inc,
107     I uwind_nlon, uwind_nlat, uwind_interpMethod,
108     I vwind_lon0, vwind_lon_inc, vwind_lat0, vwind_lat_inc,
109     I vwind_nlon, vwind_nlat, vwind_interpMethod, uvInterp_wind,
110 jmc 1.44 #endif /* USE_EXF_INTERPOLATION */
111 jmc 1.45 I mytime, myiter, mythid )
112 dimitri 1.8
113 dimitri 1.38 if (useRelativeWind) then
114 dimitri 1.37 C Subtract UVEL and VVEL from UWIND and VWIND.
115 dimitri 1.38 do bj = mybylo(mythid),mybyhi(mythid)
116     do bi = mybxlo(mythid),mybxhi(mythid)
117     do j = 1,sny
118     do i = 1,snx
119 dimitri 1.39 uwind(i,j,bi,bj) = uwind(i,j,bi,bj) - 0.5 _d 0 *
120 dimitri 1.38 & (uVel(i,j,1,bi,bj)+uVel(i+1,j,1,bi,bj))
121 dimitri 1.39 vwind(i,j,bi,bj) = vwind(i,j,bi,bj) - 0.5 _d 0 *
122 dimitri 1.38 & (vVel(i,j,1,bi,bj)+vVel(i,j+1,1,bi,bj))
123     enddo
124 dimitri 1.37 enddo
125     enddo
126     enddo
127 dimitri 1.38 endif
128 dimitri 1.37
129 dimitri 1.22 #endif /* ALLOW_ATM_WIND */
130 dimitri 1.8
131 dimitri 1.22 c Atmospheric heat flux.
132 dimitri 1.34 call exf_set_gen (
133 jmc 1.44 & hfluxfile, hfluxstartdate, hfluxperiod,
134 heimbach 1.23 & exf_inscal_hflux,
135 heimbach 1.30 & hflux_exfremo_intercept, hflux_exfremo_slope,
136 jmc 1.44 & hflux, hflux0, hflux1, hfluxmask,
137 dimitri 1.22 #ifdef USE_EXF_INTERPOLATION
138     & hflux_lon0, hflux_lon_inc, hflux_lat0, hflux_lat_inc,
139 jmc 1.44 & hflux_nlon, hflux_nlat, xC, yC, hflux_interpMethod,
140 dimitri 1.22 #endif
141 heimbach 1.31 & mytime, myiter, mythid )
142 dimitri 1.20
143 dimitri 1.22 c Salt flux.
144 dimitri 1.34 call exf_set_gen (
145 jmc 1.44 & sfluxfile, sfluxstartdate, sfluxperiod,
146 heimbach 1.23 & exf_inscal_sflux,
147 heimbach 1.30 & sflux_exfremo_intercept, sflux_exfremo_slope,
148 jmc 1.44 & sflux, sflux0, sflux1, sfluxmask,
149 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
150 dimitri 1.22 & sflux_lon0, sflux_lon_inc, sflux_lat0, sflux_lat_inc,
151 jmc 1.44 & sflux_nlon, sflux_nlat, xC, yC, sflux_interpMethod,
152 dimitri 1.22 #endif
153 heimbach 1.31 & mytime, myiter, mythid )
154 dimitri 1.8
155 heimbach 1.1 #ifdef ALLOW_ATM_TEMP
156 dimitri 1.8
157 heimbach 1.1 c Atmospheric temperature.
158 jmc 1.44 call exf_set_gen(
159     & atempfile, atempstartdate, atempperiod,
160 heimbach 1.13 & exf_inscal_atemp,
161 heimbach 1.30 & atemp_exfremo_intercept, atemp_exfremo_slope,
162 jmc 1.44 & atemp, atemp0, atemp1, atempmask,
163 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
164     & atemp_lon0, atemp_lon_inc, atemp_lat0, atemp_lat_inc,
165 jmc 1.44 & atemp_nlon, atemp_nlat, xC, yC, atemp_interpMethod,
166 dimitri 1.15 #endif
167 heimbach 1.31 & mytime, myiter, mythid )
168 dimitri 1.21 do bj = mybylo(mythid),mybyhi(mythid)
169 heimbach 1.30 do bi = mybxlo(mythid),mybxhi(mythid)
170     do j = 1,sny
171     do i = 1,snx
172     atemp(i,j,bi,bj) = atemp(i,j,bi,bj) + exf_offset_atemp
173 dimitri 1.21 enddo
174 heimbach 1.30 enddo
175     enddo
176 dimitri 1.21 enddo
177 heimbach 1.1
178     c Atmospheric humidity.
179 jmc 1.44 call exf_set_gen(
180     & aqhfile, aqhstartdate, aqhperiod,
181 heimbach 1.13 & exf_inscal_aqh,
182 heimbach 1.30 & aqh_exfremo_intercept, aqh_exfremo_slope,
183 jmc 1.44 & aqh, aqh0, aqh1, aqhmask,
184 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
185     & aqh_lon0, aqh_lon_inc, aqh_lat0, aqh_lat_inc,
186 jmc 1.44 & aqh_nlon, aqh_nlat, xC, yC, aqh_interpMethod,
187 dimitri 1.15 #endif
188 heimbach 1.31 & mytime, myiter, mythid )
189 heimbach 1.1
190     c Net long wave radiative flux.
191 jmc 1.44 call exf_set_gen(
192     & lwfluxfile, lwfluxstartdate, lwfluxperiod,
193 heimbach 1.13 & exf_inscal_lwflux,
194 heimbach 1.30 & lwflux_exfremo_intercept, lwflux_exfremo_slope,
195 jmc 1.44 & lwflux, lwflux0, lwflux1, lwfluxmask,
196 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
197     & lwflux_lon0, lwflux_lon_inc, lwflux_lat0, lwflux_lat_inc,
198 jmc 1.44 & lwflux_nlon, lwflux_nlat, xC, yC, lwflux_interpMethod,
199 dimitri 1.15 #endif
200 heimbach 1.31 & mytime, myiter, mythid )
201 heimbach 1.1
202     c Precipitation.
203 jmc 1.44 call exf_set_gen(
204     & precipfile, precipstartdate, precipperiod,
205 heimbach 1.13 & exf_inscal_precip,
206 heimbach 1.30 & precip_exfremo_intercept, precip_exfremo_slope,
207 jmc 1.44 & precip, precip0, precip1, precipmask,
208 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
209     & precip_lon0, precip_lon_inc, precip_lat0, precip_lat_inc,
210 jmc 1.44 & precip_nlon, precip_nlat, xC, yC, precip_interpMethod,
211 dimitri 1.15 #endif
212 heimbach 1.31 & mytime, myiter, mythid )
213 heimbach 1.1
214 heimbach 1.32 c Snow.
215 jmc 1.44 call exf_set_gen(
216     & snowprecipfile, snowprecipstartdate, snowprecipperiod,
217 heimbach 1.32 & exf_inscal_snowprecip,
218     & snowprecip_exfremo_intercept, snowprecip_exfremo_slope,
219 jmc 1.44 & snowprecip, snowprecip0, snowprecip1, snowprecipmask,
220 heimbach 1.32 #ifdef USE_EXF_INTERPOLATION
221 jmc 1.44 & snowprecip_lon0, snowprecip_lon_inc,
222 heimbach 1.32 & snowprecip_lat0, snowprecip_lat_inc,
223 jmc 1.44 & snowprecip_nlon, snowprecip_nlat, xC, yC,
224     & snowprecip_interpMethod,
225 heimbach 1.32 #endif
226     & mytime, myiter, mythid )
227    
228 dimitri 1.22 #endif /* ALLOW_ATM_TEMP */
229 heimbach 1.1
230 dimitri 1.8 #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
231 heimbach 1.1 c Net short wave radiative flux.
232 dimitri 1.34 call exf_set_gen (
233 jmc 1.44 & swfluxfile, swfluxstartdate, swfluxperiod,
234 heimbach 1.23 & exf_inscal_swflux,
235 heimbach 1.30 & swflux_exfremo_intercept, swflux_exfremo_slope,
236 jmc 1.44 & swflux, swflux0, swflux1, swfluxmask,
237 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
238     & swflux_lon0, swflux_lon_inc, swflux_lat0, swflux_lat_inc,
239 jmc 1.44 & swflux_nlon, swflux_nlat, xC, yC, swflux_interpMethod,
240 dimitri 1.15 #endif
241 heimbach 1.31 & mytime, myiter, mythid )
242 heimbach 1.3 #endif
243    
244 dimitri 1.8 #ifdef EXF_READ_EVAP
245     c Evaporation
246 dimitri 1.34 call exf_set_gen (
247 jmc 1.44 & evapfile, evapstartdate, evapperiod,
248 heimbach 1.23 & exf_inscal_evap,
249 heimbach 1.30 & evap_exfremo_intercept, evap_exfremo_slope,
250 jmc 1.44 & evap, evap0, evap1, evapmask,
251 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
252     & evap_lon0, evap_lon_inc, evap_lat0, evap_lat_inc,
253 jmc 1.44 & evap_nlon, evap_nlat, xC, yC, evap_interpMethod,
254 dimitri 1.15 #endif
255 heimbach 1.31 & mytime, myiter, mythid )
256 heimbach 1.3 #endif
257 heimbach 1.1
258 dimitri 1.8 #ifdef ALLOW_DOWNWARD_RADIATION
259 heimbach 1.1
260 dimitri 1.8 c Downward shortwave radiation.
261 dimitri 1.34 call exf_set_gen (
262 jmc 1.44 & swdownfile, swdownstartdate, swdownperiod,
263 heimbach 1.23 & exf_inscal_swdown,
264 heimbach 1.30 & swdown_exfremo_intercept, swdown_exfremo_slope,
265 jmc 1.44 & swdown, swdown0, swdown1, swdownmask,
266 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
267     & swdown_lon0, swdown_lon_inc, swdown_lat0, swdown_lat_inc,
268 jmc 1.44 & swdown_nlon, swdown_nlat, xC, yC, swdown_interpMethod,
269 dimitri 1.15 #endif
270 heimbach 1.31 & mytime, myiter, mythid )
271 heimbach 1.1
272 dimitri 1.8 c Downward longwave radiation.
273 dimitri 1.34 call exf_set_gen (
274 jmc 1.44 & lwdownfile, lwdownstartdate, lwdownperiod,
275 heimbach 1.23 & exf_inscal_lwdown,
276 heimbach 1.30 & lwdown_exfremo_intercept, lwdown_exfremo_slope,
277 jmc 1.44 & lwdown, lwdown0, lwdown1, lwdownmask,
278 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
279     & lwdown_lon0, lwdown_lon_inc, lwdown_lat0, lwdown_lat_inc,
280 jmc 1.44 & lwdown_nlon, lwdown_nlat, xC, yC, lwdown_interpMethod,
281 dimitri 1.15 #endif
282 heimbach 1.31 & mytime, myiter, mythid )
283 heimbach 1.1
284 heimbach 1.3 #endif
285 heimbach 1.1
286 heimbach 1.12 #ifdef ATMOSPHERIC_LOADING
287     c Atmos. pressure forcing
288 dimitri 1.34 call exf_set_gen (
289 jmc 1.44 & apressurefile, apressurestartdate, apressureperiod,
290 heimbach 1.13 & exf_inscal_apressure,
291 heimbach 1.30 & apressure_exfremo_intercept, apressure_exfremo_slope,
292 jmc 1.44 & apressure, apressure0, apressure1, apressuremask,
293 dimitri 1.15 #ifdef USE_EXF_INTERPOLATION
294 jmc 1.44 & apressure_lon0, apressure_lon_inc,
295     & apressure_lat0, apressure_lat_inc,
296     & apressure_nlon,apressure_nlat,xC,yC, apressure_interpMethod,
297 dimitri 1.15 #endif
298 heimbach 1.31 & mytime, myiter, mythid )
299 heimbach 1.3 #endif
300 heimbach 1.1
301 gforget 1.41 #ifdef ALLOW_ICE_AREAMASK
302     c fractional ice-covered area MASK
303     call exf_set_gen (
304     & areamaskfile, areamaskstartdate, areamaskperiod,
305     & exf_inscal_areamask,
306     & areamask_exfremo_intercept, areamask_exfremo_slope,
307     & areamask, areamask0, areamask1, areamaskmask,
308     #ifdef USE_EXF_INTERPOLATION
309 jmc 1.44 & areamask_lon0, areamask_lon_inc,
310     & areamask_lat0, areamask_lat_inc,
311     & areamask_nlon, areamask_nlat, xC, yC, areamask_interpMethod,
312 gforget 1.41 #endif
313     & mytime, myiter, mythid )
314     #endif
315    
316 jmc 1.36 #ifdef ALLOW_RUNOFF
317 dimitri 1.34 c Runoff
318     call exf_set_gen (
319 jmc 1.44 & runofffile, runoffstartdate, runoffperiod,
320 dimitri 1.34 & exf_inscal_runoff,
321     & runoff_exfremo_intercept, runoff_exfremo_slope,
322 jmc 1.44 & runoff, runoff0, runoff1, runoffmask,
323 dimitri 1.34 #ifdef USE_EXF_INTERPOLATION
324 jmc 1.44 & runoff_lon0, runoff_lon_inc, runoff_lat0, runoff_lat_inc,
325     & runoff_nlon, runoff_nlat, xC, yC, runoff_interpMethod,
326 dimitri 1.34 #endif
327     & mytime, myiter, mythid )
328 jmc 1.44 #endif /* ALLOW_RUNOFF */
329 dimitri 1.34
330 heimbach 1.28 c-- Control variables for atmos. state
331    
332     #ifdef ALLOW_ATEMP_CONTROL
333 dimitri 1.34 call ctrl_get_gen (
334 heimbach 1.28 & xx_atemp_file, xx_atempstartdate, xx_atempperiod,
335     & maskc, atemp, xx_atemp0, xx_atemp1, xx_atemp_dummy,
336 heimbach 1.30 & xx_atemp_remo_intercept, xx_atemp_remo_slope,
337 heimbach 1.31 & mytime, myiter, mythid )
338 heimbach 1.28 #endif
339    
340     #ifdef ALLOW_AQH_CONTROL
341 dimitri 1.34 call ctrl_get_gen (
342 heimbach 1.28 & xx_aqh_file, xx_aqhstartdate, xx_aqhperiod,
343     & maskc, aqh, xx_aqh0, xx_aqh1, xx_aqh_dummy,
344 heimbach 1.30 & xx_aqh_remo_intercept, xx_aqh_remo_slope,
345 heimbach 1.31 & mytime, myiter, mythid )
346 heimbach 1.28 #endif
347    
348     #ifdef ALLOW_PRECIP_CONTROL
349 dimitri 1.34 call ctrl_get_gen (
350 heimbach 1.28 & xx_precip_file, xx_precipstartdate, xx_precipperiod,
351     & maskc, precip, xx_precip0, xx_precip1, xx_precip_dummy,
352 heimbach 1.30 & xx_precip_remo_intercept, xx_precip_remo_slope,
353 heimbach 1.31 & mytime, myiter, mythid )
354 heimbach 1.28 #endif
355    
356     #ifdef ALLOW_SWFLUX_CONTROL
357 dimitri 1.34 call ctrl_get_gen (
358 heimbach 1.28 & xx_swflux_file, xx_swfluxstartdate, xx_swfluxperiod,
359     & maskc, swflux, xx_swflux0, xx_swflux1, xx_swflux_dummy,
360 heimbach 1.30 & xx_swflux_remo_intercept, xx_swflux_remo_slope,
361 heimbach 1.31 & mytime, myiter, mythid )
362 heimbach 1.28 #endif
363    
364 heimbach 1.29 #ifdef ALLOW_SWDOWN_CONTROL
365 dimitri 1.34 call ctrl_get_gen (
366 heimbach 1.29 & xx_swdown_file, xx_swdownstartdate, xx_swdownperiod,
367     & maskc, swdown, xx_swdown0, xx_swdown1, xx_swdown_dummy,
368 heimbach 1.30 & xx_swdown_remo_intercept, xx_swdown_remo_slope,
369 heimbach 1.31 & mytime, myiter, mythid )
370 heimbach 1.29 #endif
371    
372 heimbach 1.33 #ifdef ALLOW_LWFLUX_CONTROL
373 dimitri 1.34 call ctrl_get_gen (
374 heimbach 1.33 & xx_lwflux_file, xx_lwfluxstartdate, xx_lwfluxperiod,
375     & maskc, lwflux, xx_lwflux0, xx_lwflux1, xx_lwflux_dummy,
376     & xx_lwflux_remo_intercept, xx_lwflux_remo_slope,
377     & mytime, myiter, mythid )
378     #endif
379    
380     #ifdef ALLOW_LWDOWN_CONTROL
381 dimitri 1.34 call ctrl_get_gen (
382 heimbach 1.33 & xx_lwdown_file, xx_lwdownstartdate, xx_lwdownperiod,
383     & maskc, lwdown, xx_lwdown0, xx_lwdown1, xx_lwdown_dummy,
384     & xx_lwdown_remo_intercept, xx_lwdown_remo_slope,
385     & mytime, myiter, mythid )
386     #endif
387    
388     #ifdef ALLOW_EVAP_CONTROL
389 dimitri 1.34 call ctrl_get_gen (
390 heimbach 1.33 & xx_evap_file, xx_evapstartdate, xx_evapperiod,
391     & maskc, evap, xx_evap0, xx_evap1, xx_evap_dummy,
392     & xx_evap_remo_intercept, xx_evap_remo_slope,
393     & mytime, myiter, mythid )
394     #endif
395    
396     #ifdef ALLOW_SNOWPRECIP_CONTROL
397 dimitri 1.34 call ctrl_get_gen (
398 jmc 1.44 & xx_snowprecip_file, xx_snowprecipstartdate,
399 heimbach 1.33 & xx_snowprecipperiod,
400 jmc 1.44 & maskc, snowprecip, xx_snowprecip0, xx_snowprecip1,
401 heimbach 1.33 & xx_snowprecip_dummy,
402     & xx_snowprecip_remo_intercept, xx_snowprecip_remo_slope,
403     & mytime, myiter, mythid )
404     #endif
405    
406     #ifdef ALLOW_APRESSURE_CONTROL
407 dimitri 1.34 call ctrl_get_gen (
408 jmc 1.44 & xx_apressure_file, xx_apressurestartdate,
409 heimbach 1.33 & xx_apressureperiod,
410 jmc 1.44 & maskc, apressure, xx_apressure0, xx_apressure1,
411 heimbach 1.33 & xx_apressure_dummy,
412     & xx_apressure_remo_intercept, xx_apressure_remo_slope,
413     & mytime, myiter, mythid )
414     #endif
415    
416 gforget 1.43 #ifndef ALLOW_ROTATE_UV_CONTROLS
417    
418 heimbach 1.28 #ifdef ALLOW_UWIND_CONTROL
419     call ctrl_get_gen (
420     & xx_uwind_file, xx_uwindstartdate, xx_uwindperiod,
421     & maskc, uwind, xx_uwind0, xx_uwind1, xx_uwind_dummy,
422 heimbach 1.30 & xx_uwind_remo_intercept, xx_uwind_remo_slope,
423 heimbach 1.31 & mytime, myiter, mythid )
424 heimbach 1.28 #endif /* ALLOW_UWIND_CONTROL */
425    
426     #ifdef ALLOW_VWIND_CONTROL
427     call ctrl_get_gen (
428     & xx_vwind_file, xx_vwindstartdate, xx_vwindperiod,
429     & maskc, vwind, xx_vwind0, xx_vwind1, xx_vwind_dummy,
430 heimbach 1.30 & xx_vwind_remo_intercept, xx_vwind_remo_slope,
431 heimbach 1.31 & mytime, myiter, mythid )
432 heimbach 1.28 #endif /* ALLOW_VWIND_CONTROL */
433    
434 gforget 1.43 #else
435    
436     #if defined(ALLOW_UWIND_CONTROL) && defined(ALLOW_VWIND_CONTROL)
437     do bj = mybylo(mythid),mybyhi(mythid)
438     do bi = mybxlo(mythid),mybxhi(mythid)
439     do j = 1-oly,sny+oly
440     do i = 1-olx,snx+olx
441     tmpUE(i,j,bi,bj) = 0. _d 0
442     tmpVN(i,j,bi,bj) = 0. _d 0
443     tmpUX(i,j,bi,bj) = 0. _d 0
444     tmpVY(i,j,bi,bj) = 0. _d 0
445     enddo
446     enddo
447     enddo
448     enddo
449    
450     call ctrl_get_gen (
451     & xx_uwind_file, xx_uwindstartdate, xx_uwindperiod,
452     & maskc, tmpUE, xx_uwind0, xx_uwind1, xx_uwind_dummy,
453     & xx_uwind_remo_intercept, xx_uwind_remo_slope,
454     & mytime, myiter, mythid )
455    
456     call ctrl_get_gen (
457     & xx_vwind_file, xx_vwindstartdate, xx_vwindperiod,
458     & maskc, tmpVN, xx_vwind0, xx_vwind1, xx_vwind_dummy,
459     & xx_vwind_remo_intercept, xx_vwind_remo_slope,
460     & mytime, myiter, mythid )
461    
462     call rotate_uv2en_rl(tmpUX,tmpVY,tmpUE,tmpVN,
463     & .FALSE.,.FALSE.,.TRUE.,1,mythid)
464    
465     do bj = mybylo(mythid),mybyhi(mythid)
466     do bi = mybxlo(mythid),mybxhi(mythid)
467     do j = 1,sny
468     do i = 1,snx
469     uwind(i,j,bi,bj)=uwind(i,j,bi,bj)+tmpUX(i,j,bi,bj)
470     vwind(i,j,bi,bj)=vwind(i,j,bi,bj)+tmpVY(i,j,bi,bj)
471     enddo
472     enddo
473     enddo
474     enddo
475 jmc 1.44 #endif
476 gforget 1.43
477     #endif /* ALLOW_ROTATE_UV_CONTROLS */
478    
479 dimitri 1.34 cdm transferred from exf_init_runoff.F
480     cdm functionality needs to be checked before turning on
481     cdm #ifdef ALLOW_RUNOFF_CONTROL
482 jmc 1.44 cdm call ctrl_get_gen (
483 dimitri 1.34 cdm & xx_runoff_file, xx_runoffstartdate, xx_runoffperiod,
484     cdm & maskc, runoff, xx_runoff0, xx_runoff1, xx_runoff_dummy,
485     cdm & xx_runoff_remo_intercept, xx_runoff_remo_slope,
486     cdm & 0., 0., mythid )
487     cdm #endif
488    
489 jmc 1.44 RETURN
490     END

  ViewVC Help
Powered by ViewVC 1.1.22