/[MITgcm]/MITgcm/pkg/ctrl/ctrl_init.F
ViewVC logotype

Annotation of /MITgcm/pkg/ctrl/ctrl_init.F

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


Revision 1.36 - (hide annotations) (download)
Tue Mar 15 16:40:55 2011 UTC (13 years, 2 months ago) by mlosch
Branch: MAIN
Changes since 1.35: +373 -660 lines
change behavior of xx_${varname}period to be analogous to
exf-conventions, along the way:
- introduce helper routine ctrl_init_rec (part of ctrl_init.F) to
  clean up ctrl_init a little
- remove unused variables

1 edhill 1.10 C
2 mlosch 1.36 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_init.F,v 1.35 2011/01/19 08:29:35 mlosch Exp $
3 heimbach 1.14 C $Name: $
4 heimbach 1.1
5     #include "CTRL_CPPOPTIONS.h"
6    
7 heimbach 1.5 subroutine ctrl_init( mythid )
8 heimbach 1.1
9     c ==================================================================
10 heimbach 1.5 c SUBROUTINE ctrl_init
11 heimbach 1.1 c ==================================================================
12     c
13     c o Set parts of the vector of control variables and initialize the
14     c rest to zero.
15     c
16     c The vector of control variables is initialized here. The
17     c temperature and salinity contributions are read from file.
18     c Subsequently, the latter are dimensionalized and the tile
19     c edges are updated.
20     c
21     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
22     c
23     c changed: Christian Eckert eckert@mit.edu 23-Feb-2000
24     c - Restructured the code in order to create a package
25     c for the MITgcmUV.
26     c
27     c Patrick Heimbach heimbach@mit.edu 30-May-2000
28     c - diffsec was falsely declared.
29     c
30     c Patrick Heimbach heimbach@mit.edu 06-Jun-2000
31     c - Transferred some filename declarations
32     c from ctrl_pack/ctrl_unpack to here
33     c - Transferred mask-per-tile to here
34     c - computation of control vector length here
35     c
36     c Patrick Heimbach heimbach@mit.edu 16-Jun-2000
37     c - Added call to ctrl_pack
38     c - Alternatively: transfer writing of scale files to
39     c ctrl_unpack
40     c
41 heimbach 1.9 c Dimitris Menemenlis menemenlis@mit.edu 7-Mar-2003
42     c - To be consistent with usage in ctrl_getrec.F,
43     c startrec and endrec need to be referenced to
44     c model time = 0, not to startTime.
45     c Also "- modelstep" -> "+ modelstep/2":
46     c old: startrec = int((modelstart - diffsecs)/
47     c old: & xx_???period) + 1
48     c old: endrec = int((modelend - diffsecs - modelstep)/
49     c old: & xx_???period) + 2
50     c new: startrec = int((modelstart + startTime - diffsecs)/
51     c new: & xx_???period) + 1
52     c new: endrec = int((modelend + startTime - diffsecs + modelstep/2)/
53     c new: & xx_???period) + 2
54     c
55 heimbach 1.11 c heimbach@mit.edu totally restructured 28-Oct-2003
56     c
57 heimbach 1.1 c ==================================================================
58 heimbach 1.5 c SUBROUTINE ctrl_init
59 heimbach 1.1 c ==================================================================
60    
61     implicit none
62    
63     c == global variables ==
64    
65     #include "EEPARAMS.h"
66     #include "SIZE.h"
67     #include "PARAMS.h"
68     #include "GRID.h"
69     #include "ctrl.h"
70 heimbach 1.12 #include "optim.h"
71 heimbach 1.1
72 heimbach 1.11 #ifdef ALLOW_CAL
73 heimbach 1.9 # include "cal.h"
74 heimbach 1.5 #endif
75     #ifdef ALLOW_OBCS_CONTROL
76     # include "OBCS.h"
77     #endif
78 heimbach 1.33 #ifdef ALLOW_DIC_CONTROL
79     # include "DIC_CTRL.h"
80     #endif
81 heimbach 1.5
82 heimbach 1.1 c == routine arguments ==
83    
84     integer mythid
85    
86     c == local variables ==
87    
88 heimbach 1.21 integer bi,bj
89 mlosch 1.36 integer i,j
90 heimbach 1.21 integer itlo,ithi
91     integer jtlo,jthi
92     integer jmin,jmax
93     integer imin,imax
94    
95 heimbach 1.11 integer ivar
96 heimbach 1.1 integer startrec
97     integer endrec
98 heimbach 1.11 integer diffrec
99 heimbach 1.5
100 heimbach 1.1 c == external ==
101    
102     integer ilnblnk
103     external ilnblnk
104    
105     c == end of interface ==
106    
107 heimbach 1.21 jtlo = mybylo(mythid)
108     jthi = mybyhi(mythid)
109     itlo = mybxlo(mythid)
110     ithi = mybxhi(mythid)
111     jmin = 1-oly
112     jmax = sny+oly
113     imin = 1-olx
114     imax = snx+olx
115    
116 heimbach 1.1 c-- Set default values.
117 heimbach 1.11 do ivar = 1,maxcvars
118 mlosch 1.36 ncvarindex(ivar) = -1
119     ncvarrecs(ivar) = 0
120     ncvarxmax(ivar) = 0
121     ncvarymax(ivar) = 0
122     ncvarnrmax(ivar) = 0
123     ncvargrd(ivar) = '?'
124 heimbach 1.11 enddo
125 heimbach 1.1
126     _BARRIER
127    
128     c-- =====================
129     c-- Initial state fields.
130     c-- =====================
131    
132 heimbach 1.5 cph(
133     cph index 7-10 reserved for atmos. state,
134     cph index 11-14 reserved for open boundaries,
135     cph index 15-16 reserved for mixing coeff.
136 heimbach 1.18 cph index 17 reserved for passive tracer TR1
137 heimbach 1.5 cph index 18,19 reserved for sst, sss
138     cph index 20 for hFacC
139 heimbach 1.6 cph index 21-22 for efluxy, efluxp
140 heimbach 1.17 cph index 23 for bottom drag
141     cph index 24
142     cph index 25-26 for edtaux, edtauy
143     cph index 27-29 for uvel0, vvel0, etan0
144 heimbach 1.32 cph index 30-31 for generic 2d, 3d field
145 heimbach 1.18 cph index 32 reserved for precip (atmos. state)
146     cph index 33 reserved for swflux (atmos. state)
147 heimbach 1.19 cph index 34 reserved for swdown (atmos. state)
148 heimbach 1.24 cph 35 lwflux
149     cph 36 lwdown
150     cph 37 evap
151     cph 38 snowprecip
152     cph 39 apressure
153     cph 40 runoff
154 heimbach 1.26 cph 41 seaice SIAREA
155     cph 42 seaice SIHEFF
156     cph 43 seaice SIHSNOW
157 heimbach 1.5 cph)
158    
159 heimbach 1.16 c----------------------------------------------------------------------
160 heimbach 1.6 c--
161 heimbach 1.1 #ifdef ALLOW_THETA0_CONTROL
162 heimbach 1.5 c-- Initial state temperature contribution.
163 heimbach 1.11 call ctrl_init_ctrlvar (
164     & xx_theta_file, 1, 101, 1, 1, 1,
165     & snx, sny, nr, 'c', '3d', mythid )
166 heimbach 1.1 #endif /* ALLOW_THETA0_CONTROL */
167    
168 heimbach 1.16 c----------------------------------------------------------------------
169 heimbach 1.6 c--
170 heimbach 1.1 #ifdef ALLOW_SALT0_CONTROL
171 heimbach 1.5 c-- Initial state salinity contribution.
172 heimbach 1.11 call ctrl_init_ctrlvar (
173     & xx_salt_file, 2, 102, 1, 1, 1,
174     & snx, sny, nr, 'c', '3d', mythid )
175 heimbach 1.1 #endif /* ALLOW_SALT0_CONTROL */
176    
177 heimbach 1.5 c-- ===========================
178     c-- Surface flux contributions.
179     c-- ===========================
180    
181 heimbach 1.16 c----------------------------------------------------------------------
182 heimbach 1.6 c--
183 heimbach 1.5 #if (defined (ALLOW_HFLUX_CONTROL))
184     c-- Heat flux.
185 mlosch 1.36 call ctrl_init_rec (
186     I xx_hfluxstartdate1, xx_hfluxstartdate2, xx_hfluxperiod, 1,
187     O xx_hfluxstartdate, diffrec, startrec, endrec,
188     I mythid )
189     call ctrl_init_ctrlvar (
190     & xx_hflux_file, 3, 103, diffrec, startrec, endrec,
191     & snx, sny, 1, 'c', 'xy', mythid )
192 heimbach 1.5
193     #elif (defined (ALLOW_ATEMP_CONTROL))
194     c-- Atmos. temperature
195 mlosch 1.36 call ctrl_init_rec (
196     I xx_atempstartdate1, xx_atempstartdate2, xx_atempperiod, 1,
197     O xx_atempstartdate, diffrec, startrec, endrec,
198     I mythid )
199     call ctrl_init_ctrlvar (
200     & xx_atemp_file, 7, 107, diffrec, startrec, endrec,
201     & snx, sny, 1, 'c', 'xy', mythid )
202    
203 heimbach 1.5 #elif (defined (ALLOW_HFLUX0_CONTROL))
204     c-- initial forcing only
205 mlosch 1.36 call ctrl_init_ctrlvar (
206     & xx_hflux_file, 3, 103, 1, 1, 1,
207     & snx, sny, 1, 'c', 'xy', mythid )
208 heimbach 1.1
209 heimbach 1.5 #endif /* ALLOW_HFLUX_CONTROL */
210    
211 heimbach 1.16 c----------------------------------------------------------------------
212 heimbach 1.6 c--
213 heimbach 1.5 #if (defined (ALLOW_SFLUX_CONTROL))
214     c-- Salt flux.
215 mlosch 1.36 call ctrl_init_rec (
216     I xx_sfluxstartdate1, xx_sfluxstartdate2, xx_sfluxperiod, 1,
217     O xx_sfluxstartdate, diffrec, startrec, endrec,
218     I mythid )
219     call ctrl_init_ctrlvar (
220     & xx_sflux_file, 4, 104, diffrec, startrec, endrec,
221     & snx, sny, 1, 'c', 'xy', mythid )
222 heimbach 1.11
223 heimbach 1.5 #elif (defined (ALLOW_AQH_CONTROL))
224     c-- Atmos. humidity
225 mlosch 1.36 call ctrl_init_rec (
226     I xx_aqhstartdate1, xx_aqhstartdate2, xx_aqhperiod, 1,
227     O xx_aqhstartdate, diffrec, startrec, endrec,
228     I mythid )
229     call ctrl_init_ctrlvar (
230     & xx_aqh_file, 8, 108, diffrec, startrec, endrec,
231     & snx, sny, 1, 'c', 'xy', mythid )
232 heimbach 1.5
233     #elif (defined (ALLOW_SFLUX0_CONTROL))
234     c-- initial forcing only
235 mlosch 1.36 call ctrl_init_ctrlvar (
236     & xx_sflux_file, 4, 104, 1, 1, 1,
237     & snx, sny, 1, 'c', 'xy', mythid )
238 heimbach 1.1
239 heimbach 1.5 #endif /* ALLOW_SFLUX_CONTROL */
240    
241 heimbach 1.16 c----------------------------------------------------------------------
242 heimbach 1.6 c--
243 heimbach 1.5 #if (defined (ALLOW_USTRESS_CONTROL))
244     c-- Zonal wind stress.
245 mlosch 1.36 call ctrl_init_rec (
246     I xx_tauustartdate1, xx_tauustartdate2, xx_tauuperiod, 1,
247     O xx_tauustartdate, diffrec, startrec, endrec,
248     I mythid )
249     call ctrl_init_ctrlvar (
250     & xx_tauu_file, 5, 105, diffrec, startrec, endrec,
251 gforget 1.34 #ifndef ALLOW_ROTATE_UV_CONTROLS
252 mlosch 1.36 & snx, sny, 1, 'w', 'xy', mythid )
253 gforget 1.34 #else
254 mlosch 1.36 & snx, sny, 1, 'c', 'xy', mythid )
255 gforget 1.34 #endif
256 heimbach 1.5
257     #elif (defined (ALLOW_UWIND_CONTROL))
258     c-- Zonal wind speed.
259 mlosch 1.36 call ctrl_init_rec (
260     I xx_uwindstartdate1, xx_uwindstartdate2, xx_uwindperiod, 1,
261     O xx_uwindstartdate, diffrec, startrec, endrec,
262     I mythid )
263     call ctrl_init_ctrlvar (
264     & xx_uwind_file, 9, 109, diffrec, startrec, endrec,
265     & snx, sny, 1, 'c', 'xy', mythid )
266 heimbach 1.5
267     #elif (defined (ALLOW_TAUU0_CONTROL))
268     c-- initial forcing only
269 mlosch 1.36 call ctrl_init_ctrlvar (
270     & xx_tauu_file, 5, 105, 1, 1, 1,
271     & snx, sny, 1, 'w', 'xy', mythid )
272 heimbach 1.1
273 heimbach 1.5 #endif /* ALLOW_USTRESS_CONTROL */
274    
275 heimbach 1.16 c----------------------------------------------------------------------
276 heimbach 1.6 c--
277 heimbach 1.5 #if (defined (ALLOW_VSTRESS_CONTROL))
278     c-- Meridional wind stress.
279 mlosch 1.36 call ctrl_init_rec (
280     I xx_tauvstartdate1, xx_tauvstartdate2, xx_tauvperiod, 1,
281     O xx_tauvstartdate, diffrec, startrec, endrec,
282     I mythid )
283     call ctrl_init_ctrlvar (
284     & xx_tauv_file, 6, 106, diffrec, startrec, endrec,
285 gforget 1.34 #ifndef ALLOW_ROTATE_UV_CONTROLS
286 mlosch 1.36 & snx, sny, 1, 's', 'xy', mythid )
287 gforget 1.34 #else
288 mlosch 1.36 & snx, sny, 1, 'c', 'xy', mythid )
289 gforget 1.34 #endif
290 heimbach 1.5
291     #elif (defined (ALLOW_VWIND_CONTROL))
292     c-- Meridional wind speed.
293 mlosch 1.36 call ctrl_init_rec (
294     I xx_vwindstartdate1, xx_vwindstartdate2, xx_vwindperiod, 1,
295     O xx_vwindstartdate, diffrec, startrec, endrec,
296     I mythid )
297     call ctrl_init_ctrlvar (
298     & xx_vwind_file, 10, 110, diffrec, startrec, endrec,
299     & snx, sny, 1, 'c', 'xy', mythid )
300 heimbach 1.5
301     #elif (defined (ALLOW_TAUV0_CONTROL))
302     c-- initial forcing only
303 mlosch 1.36 call ctrl_init_ctrlvar (
304     & xx_tauv_file, 6, 106, 1, 1, 1,
305     & snx, sny, 1, 's', 'xy', mythid )
306 heimbach 1.1
307 heimbach 1.5 #endif /* ALLOW_VSTRESS_CONTROL */
308    
309 heimbach 1.11 c-- ===========================
310     c-- Open boundary contributions.
311     c-- ===========================
312    
313 heimbach 1.16 c----------------------------------------------------------------------
314 heimbach 1.6 c--
315 heimbach 1.5 #ifdef ALLOW_OBCSN_CONTROL
316     c-- Northern obc.
317 mlosch 1.36 call ctrl_init_rec (
318     I xx_obcsnstartdate1, xx_obcsnstartdate2, xx_obcsnperiod, 4,
319     O xx_obcsnstartdate, diffrec, startrec, endrec,
320     I mythid )
321     call ctrl_init_ctrlvar (
322     & xx_obcsn_file, 11, 111, diffrec, startrec, endrec,
323     & snx, 1, nr, 'm', 'xz', mythid )
324 heimbach 1.5 #endif /* ALLOW_OBCSN_CONTROL */
325    
326 heimbach 1.16 c----------------------------------------------------------------------
327 heimbach 1.11 c--
328 heimbach 1.5 #ifdef ALLOW_OBCSS_CONTROL
329     c-- Southern obc.
330 mlosch 1.36 call ctrl_init_rec (
331     I xx_obcssstartdate1, xx_obcssstartdate2, xx_obcssperiod, 4,
332     O xx_obcssstartdate, diffrec, startrec, endrec,
333     I mythid )
334     call ctrl_init_ctrlvar (
335     & xx_obcss_file, 12, 112, diffrec, startrec, endrec,
336     & snx, 1, nr, 'm', 'xz', mythid )
337 heimbach 1.5 #endif /* ALLOW_OBCSS_CONTROL */
338    
339 heimbach 1.16 c----------------------------------------------------------------------
340 heimbach 1.6 c--
341 heimbach 1.5 #ifdef ALLOW_OBCSW_CONTROL
342     c-- Western obc.
343 mlosch 1.36 call ctrl_init_rec (
344     I xx_obcswstartdate1, xx_obcswstartdate2, xx_obcswperiod, 4,
345     O xx_obcswstartdate, diffrec, startrec, endrec,
346     I mythid )
347     call ctrl_init_ctrlvar (
348     & xx_obcsw_file, 13, 113, diffrec, startrec, endrec,
349     & 1, sny, nr, 'm', 'yz', mythid )
350 heimbach 1.11 #endif /* ALLOW_OBCSW_CONTROL */
351 heimbach 1.5
352 heimbach 1.16 c----------------------------------------------------------------------
353 heimbach 1.6 c--
354 heimbach 1.5 #ifdef ALLOW_OBCSE_CONTROL
355     c-- Eastern obc.
356 mlosch 1.36 call ctrl_init_rec (
357     I xx_obcsestartdate1, xx_obcsestartdate2, xx_obcseperiod, 4,
358     O xx_obcsestartdate, diffrec, startrec, endrec,
359     I mythid )
360     call ctrl_init_ctrlvar (
361     & xx_obcse_file, 14, 114, diffrec, startrec, endrec,
362     & 1, sny, nr, 'm', 'yz', mythid )
363 heimbach 1.5 #endif /* ALLOW_OBCSE_CONTROL */
364 heimbach 1.2
365 heimbach 1.16 c----------------------------------------------------------------------
366 heimbach 1.6 c--
367 heimbach 1.3 #ifdef ALLOW_DIFFKR_CONTROL
368 mlosch 1.36 call ctrl_init_ctrlvar (
369     & xx_diffkr_file, 15, 115, 1, 1, 1,
370     & snx, sny, nr, 'c', '3d', mythid )
371 heimbach 1.3 #endif /* ALLOW_DIFFKR_CONTROL */
372    
373 heimbach 1.16 c----------------------------------------------------------------------
374 heimbach 1.6 c--
375 heimbach 1.3 #ifdef ALLOW_KAPGM_CONTROL
376 mlosch 1.36 call ctrl_init_ctrlvar (
377     & xx_kapgm_file, 16, 116, 1, 1, 1,
378     & snx, sny, nr, 'c', '3d', mythid )
379 heimbach 1.3 #endif /* ALLOW_KAPGM_CONTROL */
380    
381 heimbach 1.16 c----------------------------------------------------------------------
382 heimbach 1.6 c--
383 heimbach 1.18 #ifdef ALLOW_TR10_CONTROL
384 mlosch 1.36 call ctrl_init_ctrlvar (
385     & xx_tr1_file, 17, 117, 1, 1, 1,
386     & snx, sny, nr, 'c', '3d', mythid )
387 heimbach 1.18 #endif /* ALLOW_TR10_CONTROL */
388 heimbach 1.2
389 heimbach 1.16 c----------------------------------------------------------------------
390 heimbach 1.6 c--
391 heimbach 1.20 #if (defined (ALLOW_SST_CONTROL))
392 mlosch 1.36 call ctrl_init_rec (
393     I xx_sststartdate1, xx_sststartdate2, xx_sstperiod, 1,
394     O xx_sststartdate, diffrec, startrec, endrec,
395     I mythid )
396     call ctrl_init_ctrlvar (
397     & xx_sst_file, 18, 118, diffrec, startrec, endrec,
398     & snx, sny, 1, 'c', 'xy', mythid )
399 heimbach 1.20
400     #elif (defined (ALLOW_SST0_CONTROL))
401 mlosch 1.36 call ctrl_init_ctrlvar (
402     & xx_sst_file, 18, 118, 1, 1, 1,
403     & snx, sny, 1, 'c', 'xy', mythid )
404 heimbach 1.20
405     #endif /* ALLOW_SST_CONTROL */
406 heimbach 1.6
407 heimbach 1.16 c----------------------------------------------------------------------
408 heimbach 1.6 c--
409 heimbach 1.20 #if (defined (ALLOW_SSS_CONTROL))
410 mlosch 1.36 call ctrl_init_rec (
411     I xx_sssstartdate1, xx_sssstartdate2, xx_sssperiod, 1,
412     O xx_sssstartdate, diffrec, startrec, endrec,
413     I mythid )
414     call ctrl_init_ctrlvar (
415     & xx_sss_file, 19, 119, diffrec, startrec, endrec,
416     & snx, sny, 1, 'c', 'xy', mythid )
417 heimbach 1.20
418     #elif (defined (ALLOW_SSS0_CONTROL))
419 mlosch 1.36 call ctrl_init_ctrlvar (
420     & xx_sss_file, 19, 119, 1, 1, 1,
421     & snx, sny, 1, 'c', 'xy', mythid )
422    
423 heimbach 1.6 #endif /* ALLOW_SSS0_CONTROL */
424    
425 heimbach 1.16 c----------------------------------------------------------------------
426 heimbach 1.6 c--
427 heimbach 1.23 #ifdef ALLOW_DEPTH_CONTROL
428 heimbach 1.11 call ctrl_init_ctrlvar (
429 heimbach 1.23 & xx_depth_file, 20, 120, 1, 1, 1,
430 heimbach 1.11 & snx, sny, 1, 'c', 'xy', mythid )
431 heimbach 1.23 #endif /* ALLOW_DEPTH_CONTROL */
432 heimbach 1.6
433 heimbach 1.16 c----------------------------------------------------------------------
434 heimbach 1.6 c--
435 heimbach 1.5 #ifdef ALLOW_EFLUXY0_CONTROL
436 heimbach 1.11 call ctrl_init_ctrlvar (
437     & xx_efluxy_file, 21, 121, 1, 1, 1,
438     & snx, sny, nr, 's', '3d', mythid )
439 heimbach 1.5 #endif /* ALLOW_EFLUXY0_CONTROL */
440    
441 heimbach 1.16 c----------------------------------------------------------------------
442 heimbach 1.6 c--
443 heimbach 1.5 #ifdef ALLOW_EFLUXP0_CONTROL
444 heimbach 1.11 call ctrl_init_ctrlvar (
445     & xx_efluxp_file, 22, 122, 1, 1, 1,
446     & snx, sny, nr, 'v', '3d', mythid )
447 heimbach 1.5 #endif /* ALLOW_EFLUXP0_CONTROL */
448 heimbach 1.6
449 heimbach 1.16 c----------------------------------------------------------------------
450 heimbach 1.6 c--
451     #ifdef ALLOW_BOTTOMDRAG_CONTROL
452 heimbach 1.11 call ctrl_init_ctrlvar (
453     & xx_bottomdrag_file, 23, 123, 1, 1, 1,
454     & snx, sny, 1, 'c', 'xy', mythid )
455 heimbach 1.6 #endif /* ALLOW_BOTTOMDRAG_CONTROL */
456    
457 heimbach 1.16 c----------------------------------------------------------------------
458 heimbach 1.15 c--
459 dfer 1.28 #ifdef ALLOW_HFLUXM_CONTROL
460     call ctrl_init_ctrlvar (
461     & xx_hfluxm_file, 24, 124, 1, 1, 1,
462     & snx, sny, 1, 'c', 'xy', mythid )
463     #endif /* ALLOW_HFLUXM_CONTROL */
464    
465     c----------------------------------------------------------------------
466     c--
467 gforget 1.30 #ifdef ALLOW_EDDYPSI_CONTROL
468 heimbach 1.15 call ctrl_init_ctrlvar (
469     & xx_edtaux_file, 25, 125, 1, 1, 1,
470     & snx, sny, nr, 'w', '3d', mythid )
471    
472     call ctrl_init_ctrlvar (
473     & xx_edtauy_file, 26, 126, 1, 1, 1,
474     & snx, sny, nr, 's', '3d', mythid )
475 gforget 1.30 #endif /* ALLOW_EDDYPSI_CONTROL */
476 heimbach 1.15
477 heimbach 1.16 c----------------------------------------------------------------------
478     c--
479     #ifdef ALLOW_UVEL0_CONTROL
480     call ctrl_init_ctrlvar (
481     & xx_uvel_file, 27, 127, 1, 1, 1,
482     & snx, sny, nr, 'w', '3d', mythid )
483     #endif /* ALLOW_UVEL0_CONTROL */
484    
485     c----------------------------------------------------------------------
486     c--
487     #ifdef ALLOW_VVEL0_CONTROL
488     call ctrl_init_ctrlvar (
489     & xx_vvel_file, 28, 128, 1, 1, 1,
490     & snx, sny, nr, 's', '3d', mythid )
491     #endif /* ALLOW_VVEL0_CONTROL */
492    
493     c----------------------------------------------------------------------
494     c--
495     #ifdef ALLOW_ETAN0_CONTROL
496     call ctrl_init_ctrlvar (
497     & xx_etan_file, 29, 129, 1, 1, 1,
498     & snx, sny, 1, 'c', 'xy', mythid )
499     #endif /* ALLOW_VVEL0_CONTROL */
500    
501     c----------------------------------------------------------------------
502     c--
503 heimbach 1.32 #ifdef ALLOW_GEN2D_CONTROL
504 heimbach 1.16 call ctrl_init_ctrlvar (
505 heimbach 1.32 & xx_gen2d_file, 30, 130, 1, 1, 1,
506 heimbach 1.16 & snx, sny, 1, 'c', 'xy', mythid )
507 heimbach 1.32 #endif /* ALLOW_GEN2D_CONTROL */
508 heimbach 1.16
509     c----------------------------------------------------------------------
510     c--
511 heimbach 1.32 #ifdef ALLOW_GEN3D_CONTROL
512 heimbach 1.16 call ctrl_init_ctrlvar (
513 heimbach 1.32 & xx_gen3d_file, 31, 131, 1, 1, 1,
514     & snx, sny, nr, 'c', '3d', mythid )
515     #endif /* ALLOW_GEN3D_CONTROL */
516 heimbach 1.16
517     c----------------------------------------------------------------------
518 heimbach 1.17 c--
519 heimbach 1.18 #ifdef ALLOW_PRECIP_CONTROL
520     c-- Atmos. precipitation
521 mlosch 1.36 call ctrl_init_rec (
522     I xx_precipstartdate1, xx_precipstartdate2, xx_precipperiod,1,
523     O xx_precipstartdate, diffrec, startrec, endrec,
524     I mythid )
525     call ctrl_init_ctrlvar (
526     & xx_precip_file, 32, 132, diffrec, startrec, endrec,
527     & snx, sny, 1, 'c', 'xy', mythid )
528 heimbach 1.18
529     #endif /* ALLOW_PRECIP_CONTROL */
530    
531     c----------------------------------------------------------------------
532     c--
533     #ifdef ALLOW_SWFLUX_CONTROL
534     c-- Atmos. swflux
535 mlosch 1.36 call ctrl_init_rec (
536     I xx_swfluxstartdate1, xx_swfluxstartdate2, xx_swfluxperiod, 1,
537     O xx_swfluxstartdate, diffrec, startrec, endrec,
538     I mythid )
539     call ctrl_init_ctrlvar (
540     & xx_swflux_file, 33, 133, diffrec, startrec, endrec,
541     & snx, sny, 1, 'c', 'xy', mythid )
542 heimbach 1.18
543     #endif /* ALLOW_SWFLUX_CONTROL */
544 heimbach 1.17
545     c----------------------------------------------------------------------
546 heimbach 1.19 c--
547     #ifdef ALLOW_SWDOWN_CONTROL
548     c-- Atmos. swdown
549 mlosch 1.36 call ctrl_init_rec (
550     I xx_swdownstartdate1, xx_swdownstartdate2, xx_swdownperiod, 1,
551     O xx_swdownstartdate, diffrec, startrec, endrec,
552     I mythid )
553     call ctrl_init_ctrlvar (
554     & xx_swdown_file, 34, 134, diffrec, startrec, endrec,
555     & snx, sny, 1, 'c', 'xy', mythid )
556 heimbach 1.19
557     #endif /* ALLOW_SWDOWN_CONTROL */
558    
559     c----------------------------------------------------------------------
560 heimbach 1.24 c--
561     #ifdef ALLOW_LWFLUX_CONTROL
562     c-- Atmos. lwflux
563 mlosch 1.36 call ctrl_init_rec (
564     I xx_lwfluxstartdate1, xx_lwfluxstartdate2, xx_lwfluxperiod, 1,
565     O xx_lwfluxstartdate, diffrec, startrec, endrec,
566     I mythid )
567     call ctrl_init_ctrlvar (
568     & xx_lwflux_file, 35, 135, diffrec, startrec, endrec,
569     & snx, sny, 1, 'c', 'xy', mythid )
570 heimbach 1.24
571     #endif /* ALLOW_LWFLUX_CONTROL */
572    
573     c----------------------------------------------------------------------
574     c--
575     #ifdef ALLOW_LWDOWN_CONTROL
576     c-- Atmos. lwdown
577 mlosch 1.36 call ctrl_init_rec (
578     I xx_lwdownstartdate1, xx_lwdownstartdate2, xx_lwdownperiod, 1,
579     O xx_lwdownstartdate, diffrec, startrec, endrec,
580     I mythid )
581     call ctrl_init_ctrlvar (
582     & xx_lwdown_file, 36, 136, diffrec, startrec, endrec,
583     & snx, sny, 1, 'c', 'xy', mythid )
584 heimbach 1.24
585     #endif /* ALLOW_LWDOWN_CONTROL */
586    
587     c----------------------------------------------------------------------
588     c--
589     #ifdef ALLOW_EVAP_CONTROL
590     c-- Atmos. evap
591 mlosch 1.36 call ctrl_init_rec (
592     I xx_evapstartdate1, xx_evapstartdate2, xx_evapperiod, 1,
593     O xx_evapstartdate, diffrec, startrec, endrec,
594     I mythid )
595     call ctrl_init_ctrlvar (
596     & xx_evap_file, 37, 137, diffrec, startrec, endrec,
597     & snx, sny, 1, 'c', 'xy', mythid )
598 heimbach 1.24
599     #endif /* ALLOW_EVAP_CONTROL */
600    
601     c----------------------------------------------------------------------
602     c--
603     #ifdef ALLOW_SNOWPRECIP_CONTROL
604     c-- Atmos. snowprecip
605 mlosch 1.36 call ctrl_init_rec (
606     I xx_snowprecipstartdate1, xx_snowprecipstartdate2,
607     I xx_snowprecipperiod, 1,
608     O xx_snowprecipstartdate, diffrec, startrec, endrec,
609     I mythid )
610     call ctrl_init_ctrlvar (
611     & xx_snowprecip_file, 38, 138, diffrec, startrec, endrec,
612     & snx, sny, 1, 'c', 'xy', mythid )
613 heimbach 1.24
614     #endif /* ALLOW_SNOWPRECIP_CONTROL */
615    
616     c----------------------------------------------------------------------
617     c--
618     #ifdef ALLOW_APRESSURE_CONTROL
619     c-- Atmos. apressure
620 mlosch 1.36 call ctrl_init_rec (
621     I xx_apressurestartdate1, xx_apressurestartdate2,
622     I xx_apressureperiod, 1,
623     O xx_apressurestartdate, diffrec, startrec, endrec,
624     I mythid )
625     call ctrl_init_ctrlvar (
626     & xx_apressure_file, 39, 139, diffrec, startrec, endrec,
627     & snx, sny, 1, 'c', 'xy', mythid )
628 heimbach 1.24
629     #endif /* ALLOW_APRESSURE_CONTROL */
630    
631     c----------------------------------------------------------------------
632     c--
633     #ifdef ALLOW_RUNOFF_CONTROL
634     c-- Atmos. runoff
635 mlosch 1.36 call ctrl_init_rec (
636     I xx_runoffstartdate1, xx_runoffstartdate2, xx_runoffperiod, 1,
637     O xx_runoffstartdate, diffrec, startrec, endrec,
638     I mythid )
639     call ctrl_init_ctrlvar (
640     & xx_runoff_file, 40, 140, diffrec, startrec, endrec,
641     & snx, sny, 1, 'c', 'xy', mythid )
642 heimbach 1.24 #endif /* ALLOW_RUNOFF_CONTROL */
643    
644     c----------------------------------------------------------------------
645 heimbach 1.26 c--
646     #ifdef ALLOW_SIAREA_CONTROL
647 mlosch 1.36 C-- so far there are no xx_siareastartdate1, etc., so we need to fudge it.
648     CML call ctrl_init_rec (
649     CML I xx_siareastartdate1, xx_siareastartdate2, xx_siareaperiod, 1,
650     CML O xx_siareastartdate, diffrec, startrec, endrec,
651     CML I mythid )
652     startrec = 1
653     endrec = 1
654     diffrec = endrec - startrec + 1
655     call ctrl_init_ctrlvar (
656     & xx_siarea_file, 41, 141, diffrec, startrec, endrec,
657     & snx, sny, 1, 'c', 'xy', mythid )
658 heimbach 1.26 #endif /* ALLOW_siarea_CONTROL */
659    
660     c----------------------------------------------------------------------
661     c--
662     #ifdef ALLOW_SIHEFF_CONTROL
663 mlosch 1.36 C-- so far there are no xx_siheffstartdate1, etc., so we need to fudge it.
664     CML call ctrl_init_rec (
665     CML I xx_siheffstartdate1, xx_siheffstartdate2, xx_siheffperiod, 1,
666     CML O xx_siheffstartdate, diffrec, startrec, endrec,
667     CML I mythid )
668     startrec = 1
669     endrec = 1
670     diffrec = endrec - startrec + 1
671     call ctrl_init_ctrlvar (
672     & xx_siheff_file, 42, 142, diffrec, startrec, endrec,
673     & snx, sny, 1, 'c', 'xy', mythid )
674 heimbach 1.26 #endif /* ALLOW_siheff_CONTROL */
675    
676     c----------------------------------------------------------------------
677     c--
678     #ifdef ALLOW_SIHSNOW_CONTROL
679 mlosch 1.36 C-- so far there are no xx_sihsnowstartdate1, etc., so we need to fudge it.
680     CML call ctrl_init_rec (
681     CML I xx_sihsnowstartdate1, xx_sihsnowstartdate2, xx_sihsnowperiod, 1,
682     CML O xx_sihsnowstartdate, diffrec, startrec, endrec,
683     CML I mythid )
684     startrec = 1
685     endrec = 1
686     diffrec = endrec - startrec + 1
687     call ctrl_init_ctrlvar (
688     & xx_sihsnow_file, 43, 143, diffrec, startrec, endrec,
689     & snx, sny, 1, 'c', 'xy', mythid )
690 heimbach 1.26 #endif /* ALLOW_sihsnow_CONTROL */
691    
692 gforget 1.29
693     c----------------------------------------------------------------------
694     c--
695     #ifdef ALLOW_KAPREDI_CONTROL
696 mlosch 1.36 call ctrl_init_ctrlvar (
697     & xx_kapredi_file, 44, 144, 1, 1, 1,
698     & snx, sny, nr, 'c', '3d', mythid )
699 gforget 1.29 #endif /* ALLOW_KAPREDI_CONTROL */
700    
701 heimbach 1.26 c----------------------------------------------------------------------
702 heimbach 1.16 c----------------------------------------------------------------------
703 heimbach 1.21
704 mlosch 1.36 call ctrl_init_wet( mythid )
705    
706 heimbach 1.21 c----------------------------------------------------------------------
707 heimbach 1.16 c----------------------------------------------------------------------
708 heimbach 1.1
709 heimbach 1.33 #ifdef ALLOW_DIC_CONTROL
710 mlosch 1.36 do i = 1, dic_n_control
711     xx_dic(i) = 0. _d 0
712     enddo
713 heimbach 1.33 #endif
714    
715     c----------------------------------------------------------------------
716     c----------------------------------------------------------------------
717    
718 heimbach 1.21 do bj = jtlo,jthi
719 mlosch 1.36 do bi = itlo,ithi
720     do j = jmin,jmax
721     do i = imin,imax
722     wareaunit (i,j,bi,bj) = 1.0
723 heimbach 1.21 #ifndef ALLOW_ECCO
724 mlosch 1.36 whflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
725     wsflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
726     wtauu (i,j,bi,bj) = maskW(i,j,1,bi,bj)
727     wtauv (i,j,bi,bj) = maskS(i,j,1,bi,bj)
728     watemp (i,j,bi,bj) = maskC(i,j,1,bi,bj)
729     waqh (i,j,bi,bj) = maskC(i,j,1,bi,bj)
730     wprecip (i,j,bi,bj) = maskC(i,j,1,bi,bj)
731     wswflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
732     wswdown (i,j,bi,bj) = maskC(i,j,1,bi,bj)
733     wuwind (i,j,bi,bj) = maskC(i,j,1,bi,bj)
734     wvwind (i,j,bi,bj) = maskC(i,j,1,bi,bj)
735     wlwflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
736     wlwdown (i,j,bi,bj) = maskC(i,j,1,bi,bj)
737     wevap (i,j,bi,bj) = maskC(i,j,1,bi,bj)
738     wsnowprecip(i,j,bi,bj) = maskC(i,j,1,bi,bj)
739     wapressure(i,j,bi,bj) = maskC(i,j,1,bi,bj)
740     wrunoff (i,j,bi,bj) = maskC(i,j,1,bi,bj)
741     wsst (i,j,bi,bj) = maskC(i,j,1,bi,bj)
742     wsss (i,j,bi,bj) = maskC(i,j,1,bi,bj)
743 heimbach 1.21 #endif
744 mlosch 1.36 enddo
745 heimbach 1.21 enddo
746 mlosch 1.36 enddo
747 heimbach 1.21 enddo
748    
749 heimbach 1.1 return
750     end
751    
752 mlosch 1.36 subroutine ctrl_init_rec(
753     I fldstartdate1, fldstartdate2, fldperiod, nfac,
754     O fldstartdate, diffrec, startrec, endrec,
755     I mythid )
756    
757     c ==================================================================
758     c SUBROUTINE ctrl_init_rec
759     c ==================================================================
760     c
761     c helper routine to compute the first and last record of a
762     c time dependent control variable
763     c
764     c Martin.Losch@awi.de, 2011-Mar-15
765     c
766     c ==================================================================
767     c SUBROUTINE ctrl_init_rec
768     c ==================================================================
769    
770     implicit none
771    
772     c == global variables ==
773     #include "SIZE.h"
774     #include "EEPARAMS.h"
775     #include "PARAMS.h"
776     #ifdef ALLOW_CAL
777     # include "cal.h"
778     #endif
779    
780     c == input variables ==
781     c fldstartdate1/2 : start time (date/time) of fld
782     c fldperod : sampling interval of fld
783     c nfac : factor for the case that fld is an obcs variable
784     c in this case nfac = 4, otherwise nfac = 1
785     c mythid : thread ID of this instance
786     integer fldstartdate1
787     integer fldstartdate2
788     _RL fldperiod
789     integer nfac
790     integer mythid
791    
792     c == output variables ==
793     c fldstartdate : full date from fldstartdate1 and 2
794     c startrec : first record of ctrl variable
795     c startrec : last record of ctrl variable
796     c diffrec : difference between first and last record of ctrl variable
797     integer fldstartdate(4)
798     integer startrec
799     integer endrec
800     integer diffrec
801    
802     c == local variables ==
803     integer i
804     #ifdef ALLOW_CAL
805     integer difftime(4)
806     _RL diffsecs
807     #endif /* ALLOW_CAL */
808    
809     c initialise some output
810     do i = 1,4
811     fldstartdate(i) = 0
812     end do
813     startrec = 0
814     endrec = 0
815     diffrec = 0
816     # ifdef ALLOW_CAL
817     call cal_FullDate( fldstartdate1, fldstartdate2,
818     & fldstartdate , mythid )
819     call cal_TimePassed( fldstartdate, modelstartdate,
820     & difftime, mythid )
821     call cal_ToSeconds ( difftime, diffsecs, mythid )
822     if ( fldperiod .EQ. -12. ) then
823     startrec = 1
824     endrec = 12*nfac
825     elseif ( fldperiod .EQ. 0. ) then
826     startrec = 1
827     endrec = 1*nfac
828     else
829     startrec = int((modelstart + startTime - diffsecs)/
830     & fldperiod) + 1
831     endrec = int((modelend + startTime - diffsecs + modelstep/2)/
832     & fldperiod) + 2
833     if ( nfac .ne. 1 ) then
834     c This is the case of obcs. I am not sure that this is correct, but
835     c it seems to work in most configurations.
836     print * , 'ml-startrec = ', startrec
837     print * , 'ml-endrec = ', endrec
838     endrec = (endrec - startrec + 1)*nfac
839     startrec = (startrec - 1)*nfac + 1
840     print * , 'ml-startrec2 = ', startrec
841     print * , 'ml-endrec2 = ', endrec
842     endif
843     endif
844     # else /* ndef ALLOW_CAL */
845     if ( fldperiod .EQ. 0. ) then
846     startrec = 1
847     endrec = 1*nfac
848     else
849     startrec = 1
850     endrec = (int((endTime - startTime)/fldperiod) + 1)*nfac
851     endif
852     #endif /* ALLOW_CAL */
853     diffrec = endrec - startrec + 1
854    
855     return
856     end

  ViewVC Help
Powered by ViewVC 1.1.22