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

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

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


Revision 1.67 - (show annotations) (download)
Wed May 27 18:33:43 2015 UTC (9 years ago) by gforget
Branch: MAIN
CVS Tags: checkpoint65p, checkpoint65n, checkpoint65m, checkpoint65o
Changes since 1.66: +11 -2 lines
- fix xx_gentim2d_preproc_r type
- rename 'replicate' as 'docycle'
- define 'doglomean' and 'documul' pre-processing option
- improve summary

1 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_init.F,v 1.66 2015/05/27 01:43:53 gforget Exp $
2 C $Name: $
3
4 #include "CTRL_OPTIONS.h"
5 #ifdef ALLOW_EXF
6 # include "EXF_OPTIONS.h"
7 #endif
8
9 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
10
11 subroutine ctrl_init( myThid )
12
13 c ==================================================================
14 c SUBROUTINE ctrl_init
15 c ==================================================================
16 c
17 c o The vector of control variables is defined here.
18 c
19 c ==================================================================
20 c SUBROUTINE ctrl_init
21 c ==================================================================
22
23 implicit none
24
25 c == global variables ==
26
27 #include "EEPARAMS.h"
28 #include "SIZE.h"
29 #include "PARAMS.h"
30 #include "GRID.h"
31 #ifdef ALLOW_CTRL
32 # include "CTRL_SIZE.h"
33 # include "ctrl.h"
34 # include "CTRL_GENARR.h"
35 # include "CTRL_OBCS.h"
36 # include "optim.h"
37 #endif
38 #ifdef ALLOW_CAL
39 # include "cal.h"
40 #endif
41 #ifdef ALLOW_EXF
42 # include "EXF_PARAM.h"
43 #endif
44 #ifdef ALLOW_DIC_CONTROL
45 # include "DIC_CTRL.h"
46 #endif
47
48 c == routine arguments ==
49
50 integer myThid
51
52 c == local variables ==
53
54 integer bi,bj
55 integer i,j,k
56 integer itlo,ithi
57 integer jtlo,jthi
58 integer jmin,jmax
59 integer imin,imax
60
61 integer ivar
62 integer startrec
63 integer endrec
64 integer diffrec
65 integer iarr
66
67 _RL dummy
68 _RL loctmp3d (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
69
70 #ifdef ALLOW_OBCS_CONTROL_MODES
71 INTEGER length_of_rec,dUnit
72 INTEGER MDS_RECLEN
73 EXTERNAL MDS_RECLEN
74 #endif
75
76 #ifdef ALLOW_GENTIM2D_CONTROL
77 CHARACTER*(MAX_LEN_FNAM) fnamegen
78 INTEGER ilgen, k2, diffrecFull, endrecFull
79 #endif
80
81 c == external ==
82
83 integer ilnblnk
84 external ilnblnk
85
86 c == end of interface ==
87
88 jtlo = mybylo(myThid)
89 jthi = mybyhi(myThid)
90 itlo = mybxlo(myThid)
91 ithi = mybxhi(myThid)
92 jmin = 1-oly
93 jmax = sny+oly
94 imin = 1-olx
95 imax = snx+olx
96
97 c-- Set default values.
98 do ivar = 1,maxcvars
99 ncvarindex(ivar) = -1
100 ncvarrecs(ivar) = 0
101 ncvarxmax(ivar) = 0
102 ncvarymax(ivar) = 0
103 ncvarnrmax(ivar) = 0
104 ncvargrd(ivar) = '?'
105 enddo
106
107 c Set unit weight to 1
108 c
109
110 do bj=1,nSy
111 do bi=1,nSx
112 do k=1,Nr
113 wunit(k,bi,bj) = 1. _d 0
114 do j=1-oly,sNy+oly
115 do i=1-olx,sNx+olx
116 loctmp3d(i,j,k,bi,bj) = 1. _d 0
117 enddo
118 enddo
119 enddo
120 enddo
121 enddo
122
123 call active_write_xyz( 'wunit', loctmp3d, 1, 0, mythid, dummy)
124
125 _BARRIER
126
127 #ifdef ECCO_CTRL_DEPRECATED
128
129 c-- =====================
130 c-- Initial state fields.
131 c-- =====================
132
133 cph(
134 cph index 7-10 reserved for atmos. state,
135 cph index 11-14 reserved for open boundaries,
136 cph index 15-16 reserved for mixing coeff.
137 cph index 17 reserved for passive tracer TR1
138 cph index 18,19 reserved for sst, sss
139 cph index 20 for hFacC
140 cph index 21-22 for efluxy, efluxp
141 cph index 23 for bottom drag
142 cph index 24
143 cph index 25-26 for edtaux, edtauy
144 cph index 27-29 for uvel0, vvel0, etan0
145 cph index 30-31 for generic 2d, 3d field
146 cph index 32 reserved for precip (atmos. state)
147 cph index 33 reserved for swflux (atmos. state)
148 cph index 34 reserved for swdown (atmos. state)
149 cph 35 lwflux
150 cph 36 lwdown
151 cph 37 evap
152 cph 38 snowprecip
153 cph 39 apressure
154 cph 40 runoff
155 cph 41 seaice SIAREA
156 cph 42 seaice SIHEFF
157 cph 43 seaice SIHSNOW
158 cph 44 gmredi kapredi
159 cph 45 shelfice shifwflx
160 cph 47-52 mean atmos. state
161 cph)
162
163 c----------------------------------------------------------------------
164 c--
165 #ifdef ALLOW_THETA0_CONTROL
166 c-- Initial state temperature contribution.
167 call ctrl_init_ctrlvar (
168 & xx_theta_file, 1, 101, 1, 1, 1,
169 & snx, sny, nr, 'c', '3d', myThid )
170 #endif /* ALLOW_THETA0_CONTROL */
171
172 c----------------------------------------------------------------------
173 c--
174 #ifdef ALLOW_SALT0_CONTROL
175 c-- Initial state salinity contribution.
176 call ctrl_init_ctrlvar (
177 & xx_salt_file, 2, 102, 1, 1, 1,
178 & snx, sny, nr, 'c', '3d', myThid )
179 #endif /* ALLOW_SALT0_CONTROL */
180
181 c-- ===========================
182 c-- Surface flux contributions.
183 c-- ===========================
184
185 c----------------------------------------------------------------------
186 c--
187 #if (defined (ALLOW_HFLUX_CONTROL))
188 c-- Heat flux.
189 call ctrl_init_rec ( xx_hflux_file,
190 I xx_hfluxstartdate1, xx_hfluxstartdate2, xx_hfluxperiod, 1,
191 O xx_hfluxstartdate, diffrec, startrec, endrec,
192 I myThid )
193 call ctrl_init_ctrlvar (
194 & xx_hflux_file, 3, 103, diffrec, startrec, endrec,
195 & snx, sny, 1, 'c', 'xy', myThid )
196
197 #elif (defined (ALLOW_ATEMP_CONTROL))
198 c-- Atmos. temperature
199 call ctrl_init_rec ( xx_atemp_file,
200 I xx_atempstartdate1, xx_atempstartdate2, xx_atempperiod, 1,
201 O xx_atempstartdate, diffrec, startrec, endrec,
202 I myThid )
203 call ctrl_init_ctrlvar (
204 & xx_atemp_file, 7, 107, diffrec, startrec, endrec,
205 & snx, sny, 1, 'c', 'xy', myThid )
206
207 #elif (defined (ALLOW_HFLUX0_CONTROL))
208 c-- initial forcing only
209 call ctrl_init_ctrlvar (
210 & xx_hflux_file, 3, 103, 1, 1, 1,
211 & snx, sny, 1, 'c', 'xy', myThid )
212
213 #endif /* ALLOW_HFLUX_CONTROL */
214
215 c----------------------------------------------------------------------
216 c--
217 #if (defined (ALLOW_SFLUX_CONTROL))
218 c-- Salt flux.
219 call ctrl_init_rec ( xx_sflux_file,
220 I xx_sfluxstartdate1, xx_sfluxstartdate2, xx_sfluxperiod, 1,
221 O xx_sfluxstartdate, diffrec, startrec, endrec,
222 I myThid )
223 call ctrl_init_ctrlvar (
224 & xx_sflux_file, 4, 104, diffrec, startrec, endrec,
225 & snx, sny, 1, 'c', 'xy', myThid )
226
227 #elif (defined (ALLOW_AQH_CONTROL))
228 c-- Atmos. humidity
229 call ctrl_init_rec ( xx_aqh_file,
230 I xx_aqhstartdate1, xx_aqhstartdate2, xx_aqhperiod, 1,
231 O xx_aqhstartdate, diffrec, startrec, endrec,
232 I myThid )
233 call ctrl_init_ctrlvar (
234 & xx_aqh_file, 8, 108, diffrec, startrec, endrec,
235 & snx, sny, 1, 'c', 'xy', myThid )
236
237 #elif (defined (ALLOW_SFLUX0_CONTROL))
238 c-- initial forcing only
239 call ctrl_init_ctrlvar (
240 & xx_sflux_file, 4, 104, 1, 1, 1,
241 & snx, sny, 1, 'c', 'xy', myThid )
242
243 #endif /* ALLOW_SFLUX_CONTROL */
244
245 c----------------------------------------------------------------------
246 c--
247 #ifdef ALLOW_EXF
248 IF ( .NOT.useAtmWind ) THEN
249 #endif
250 #if (defined (ALLOW_USTRESS_CONTROL))
251 c-- Zonal wind stress.
252 call ctrl_init_rec ( xx_tauu_file,
253 I xx_tauustartdate1, xx_tauustartdate2, xx_tauuperiod, 1,
254 O xx_tauustartdate, diffrec, startrec, endrec,
255 I myThid )
256 call ctrl_init_ctrlvar (
257 & xx_tauu_file, 5, 105, diffrec, startrec, endrec,
258 #ifndef ALLOW_ROTATE_UV_CONTROLS
259 & snx, sny, 1, 'w', 'xy', myThid )
260 #else
261 & snx, sny, 1, 'c', 'xy', myThid )
262 #endif
263
264 #elif (defined (ALLOW_TAUU0_CONTROL))
265 c-- initial forcing only
266 call ctrl_init_ctrlvar (
267 & xx_tauu_file, 5, 105, 1, 1, 1,
268 & snx, sny, 1, 'w', 'xy', myThid )
269
270 #endif /* ALLOW_USTRESS_CONTROL */
271 #ifdef ALLOW_EXF
272 ENDIF
273 #endif
274
275 #if (defined (ALLOW_UWIND_CONTROL))
276 #ifdef ALLOW_EXF
277 IF ( useAtmWind ) THEN
278 #endif
279 c-- Zonal wind speed.
280 call ctrl_init_rec ( xx_uwind_file,
281 I xx_uwindstartdate1, xx_uwindstartdate2, xx_uwindperiod, 1,
282 O xx_uwindstartdate, diffrec, startrec, endrec,
283 I myThid )
284 call ctrl_init_ctrlvar (
285 & xx_uwind_file, 9, 109, diffrec, startrec, endrec,
286 & snx, sny, 1, 'c', 'xy', myThid )
287 #ifdef ALLOW_EXF
288 ENDIF
289 #endif
290 #endif /* ALLOW_UWIND_CONTROL */
291
292 c----------------------------------------------------------------------
293 c--
294 #ifdef ALLOW_EXF
295 IF ( .NOT.useAtmWind ) THEN
296 #endif
297 #if (defined (ALLOW_VSTRESS_CONTROL))
298 c-- Meridional wind stress.
299 call ctrl_init_rec ( xx_tauv_file,
300 I xx_tauvstartdate1, xx_tauvstartdate2, xx_tauvperiod, 1,
301 O xx_tauvstartdate, diffrec, startrec, endrec,
302 I myThid )
303 call ctrl_init_ctrlvar (
304 & xx_tauv_file, 6, 106, diffrec, startrec, endrec,
305 #ifndef ALLOW_ROTATE_UV_CONTROLS
306 & snx, sny, 1, 's', 'xy', myThid )
307 #else
308 & snx, sny, 1, 'c', 'xy', myThid )
309 #endif
310
311 #elif (defined (ALLOW_TAUV0_CONTROL))
312 c-- initial forcing only
313 call ctrl_init_ctrlvar (
314 & xx_tauv_file, 6, 106, 1, 1, 1,
315 & snx, sny, 1, 's', 'xy', myThid )
316
317 #endif /* ALLOW_VSTRESS_CONTROL */
318 #ifdef ALLOW_EXF
319 ENDIF
320 #endif
321
322 #if (defined (ALLOW_VWIND_CONTROL))
323 #ifdef ALLOW_EXF
324 IF ( useAtmWind ) THEN
325 #endif
326 c-- Meridional wind speed.
327 call ctrl_init_rec ( xx_vwind_file,
328 I xx_vwindstartdate1, xx_vwindstartdate2, xx_vwindperiod, 1,
329 O xx_vwindstartdate, diffrec, startrec, endrec,
330 I myThid )
331 call ctrl_init_ctrlvar (
332 & xx_vwind_file, 10, 110, diffrec, startrec, endrec,
333 & snx, sny, 1, 'c', 'xy', myThid )
334 #ifdef ALLOW_EXF
335 ENDIF
336 #endif
337 #endif /* ALLOW_VWIND_CONTROL */
338
339 #endif /* ECCO_CTRL_DEPRECATED */
340
341 c-- ===========================
342 c-- Open boundary contributions.
343 c-- ===========================
344
345 c----------------------------------------------------------------------
346 c--
347 #ifdef ALLOW_OBCSN_CONTROL
348 c-- Northern obc.
349 call ctrl_init_rec ( xx_obcsn_file,
350 I xx_obcsnstartdate1, xx_obcsnstartdate2, xx_obcsnperiod, 4,
351 O xx_obcsnstartdate, diffrec, startrec, endrec,
352 I myThid )
353 call ctrl_init_ctrlvar (
354 & xx_obcsn_file, 11, 111, diffrec, startrec, endrec,
355 & snx, 1, nr, 'm', 'xz', myThid )
356 #endif /* ALLOW_OBCSN_CONTROL */
357
358 c----------------------------------------------------------------------
359 c--
360 #ifdef ALLOW_OBCSS_CONTROL
361 c-- Southern obc.
362 call ctrl_init_rec ( xx_obcss_file,
363 I xx_obcssstartdate1, xx_obcssstartdate2, xx_obcssperiod, 4,
364 O xx_obcssstartdate, diffrec, startrec, endrec,
365 I myThid )
366 call ctrl_init_ctrlvar (
367 & xx_obcss_file, 12, 112, diffrec, startrec, endrec,
368 & snx, 1, nr, 'm', 'xz', myThid )
369 #endif /* ALLOW_OBCSS_CONTROL */
370
371 c----------------------------------------------------------------------
372 c--
373 #ifdef ALLOW_OBCSW_CONTROL
374 c-- Western obc.
375 call ctrl_init_rec ( xx_obcsw_file,
376 I xx_obcswstartdate1, xx_obcswstartdate2, xx_obcswperiod, 4,
377 O xx_obcswstartdate, diffrec, startrec, endrec,
378 I myThid )
379 call ctrl_init_ctrlvar (
380 & xx_obcsw_file, 13, 113, diffrec, startrec, endrec,
381 & 1, sny, nr, 'm', 'yz', myThid )
382 #endif /* ALLOW_OBCSW_CONTROL */
383
384 c----------------------------------------------------------------------
385 c--
386 #ifdef ALLOW_OBCSE_CONTROL
387 c-- Eastern obc.
388 call ctrl_init_rec ( xx_obcse_file,
389 I xx_obcsestartdate1, xx_obcsestartdate2, xx_obcseperiod, 4,
390 O xx_obcsestartdate, diffrec, startrec, endrec,
391 I myThid )
392 call ctrl_init_ctrlvar (
393 & xx_obcse_file, 14, 114, diffrec, startrec, endrec,
394 & 1, sny, nr, 'm', 'yz', myThid )
395 #endif /* ALLOW_OBCSE_CONTROL */
396
397 c----------------------------------------------------------------------
398 c--
399 #ifdef ALLOW_OBCS_CONTROL_MODES
400 cih Get matrices for reconstruction from barotropic-barclinic modes
401 CMM To use modes now hardcoded with ECCO_CPPOPTION. Would be good to have
402 c run-time option and also define filename=baro_invmodes.bin
403 CALL MDSFINDUNIT( dUnit, myThid )
404 length_of_rec = MDS_RECLEN( 64, NR*NR, myThid )
405 open(dUnit, file='baro_invmodes.bin', status='old',
406 & access='direct', recl=length_of_rec )
407 do j = 1,Nr
408 read(dUnit,rec=j) ((modesv(k,i,j), k=1,Nr), i=1,Nr)
409 end do
410 CLOSE( dUnit )
411 CMM double precision modesv is size [NR,NR,NR]
412 c dim one is z-space
413 c dim two is mode space
414 c dim three is the total depth for which this set of modes applies
415 c so for example modesv(:,2,nr) will be the second mode
416 c in z-space for the full model depth
417 c The modes are to be orthogonal when weighted by dz.
418 c i.e. if f_i(z) = mode i, sum_j(f_i(z_j)*f_j(z_j)*dz_j = delta_ij
419 c first mode should also be constant in depth...barotropic
420 c For a matlab code example how to construct the orthonormal modes,
421 c which are ideally the solution of planetary vertical mode equation
422 c using model mean dRho/dz, see
423 c MITgcm/verification/obcs_ctrl/input/gendata.m
424 c This code is compatible with partial cells
425 #endif
426
427 #ifdef ECCO_CTRL_DEPRECATED
428
429 c----------------------------------------------------------------------
430 c--
431 #ifdef ALLOW_DIFFKR_CONTROL
432 call ctrl_init_ctrlvar (
433 & xx_diffkr_file, 15, 115, 1, 1, 1,
434 & snx, sny, nr, 'c', '3d', myThid )
435 #endif /* ALLOW_DIFFKR_CONTROL */
436
437 c----------------------------------------------------------------------
438 c--
439 #ifdef ALLOW_KAPGM_CONTROL
440 call ctrl_init_ctrlvar (
441 & xx_kapgm_file, 16, 116, 1, 1, 1,
442 & snx, sny, nr, 'c', '3d', myThid )
443 #endif /* ALLOW_KAPGM_CONTROL */
444
445 c----------------------------------------------------------------------
446 c--
447 #ifdef ALLOW_TR10_CONTROL
448 call ctrl_init_ctrlvar (
449 & xx_tr1_file, 17, 117, 1, 1, 1,
450 & snx, sny, nr, 'c', '3d', myThid )
451 #endif /* ALLOW_TR10_CONTROL */
452
453 c----------------------------------------------------------------------
454 c--
455 #if (defined (ALLOW_SST_CONTROL))
456 call ctrl_init_rec ( xx_sst_file,
457 I xx_sststartdate1, xx_sststartdate2, xx_sstperiod, 1,
458 O xx_sststartdate, diffrec, startrec, endrec,
459 I myThid )
460 call ctrl_init_ctrlvar (
461 & xx_sst_file, 18, 118, diffrec, startrec, endrec,
462 & snx, sny, 1, 'c', 'xy', myThid )
463
464 #elif (defined (ALLOW_SST0_CONTROL))
465 call ctrl_init_ctrlvar (
466 & xx_sst_file, 18, 118, 1, 1, 1,
467 & snx, sny, 1, 'c', 'xy', myThid )
468
469 #endif /* ALLOW_SST_CONTROL */
470
471 c----------------------------------------------------------------------
472 c--
473 #if (defined (ALLOW_SSS_CONTROL))
474 call ctrl_init_rec ( xx_sss_file,
475 I xx_sssstartdate1, xx_sssstartdate2, xx_sssperiod, 1,
476 O xx_sssstartdate, diffrec, startrec, endrec,
477 I myThid )
478 call ctrl_init_ctrlvar (
479 & xx_sss_file, 19, 119, diffrec, startrec, endrec,
480 & snx, sny, 1, 'c', 'xy', myThid )
481
482 #elif (defined (ALLOW_SSS0_CONTROL))
483 call ctrl_init_ctrlvar (
484 & xx_sss_file, 19, 119, 1, 1, 1,
485 & snx, sny, 1, 'c', 'xy', myThid )
486
487 #endif /* ALLOW_SSS0_CONTROL */
488
489 c----------------------------------------------------------------------
490 c--
491 #ifdef ALLOW_DEPTH_CONTROL
492 call ctrl_init_ctrlvar (
493 & xx_depth_file, 20, 120, 1, 1, 1,
494 & snx, sny, 1, 'c', 'xy', myThid )
495 #endif /* ALLOW_DEPTH_CONTROL */
496
497 c----------------------------------------------------------------------
498 c--
499 #ifdef ALLOW_EFLUXY0_CONTROL
500 call ctrl_init_ctrlvar (
501 & xx_efluxy_file, 21, 121, 1, 1, 1,
502 & snx, sny, nr, 's', '3d', myThid )
503 #endif /* ALLOW_EFLUXY0_CONTROL */
504
505 c----------------------------------------------------------------------
506 c--
507 #ifdef ALLOW_EFLUXP0_CONTROL
508 call ctrl_init_ctrlvar (
509 & xx_efluxp_file, 22, 122, 1, 1, 1,
510 & snx, sny, nr, 'v', '3d', myThid )
511 #endif /* ALLOW_EFLUXP0_CONTROL */
512
513 c----------------------------------------------------------------------
514 c--
515 #ifdef ALLOW_BOTTOMDRAG_CONTROL_NONGENERIC
516 call ctrl_init_ctrlvar (
517 & xx_bottomdrag_file, 23, 123, 1, 1, 1,
518 & snx, sny, 1, 'c', 'xy', myThid )
519 #endif /* ALLOW_BOTTOMDRAG_CONTROL */
520
521 c----------------------------------------------------------------------
522 c--
523 #ifdef ALLOW_HFLUXM_CONTROL
524 call ctrl_init_ctrlvar (
525 & xx_hfluxm_file, 24, 124, 1, 1, 1,
526 & snx, sny, 1, 'c', 'xy', myThid )
527 #endif /* ALLOW_HFLUXM_CONTROL */
528
529 c----------------------------------------------------------------------
530 c--
531 #ifdef ALLOW_EDDYPSI_CONTROL
532 call ctrl_init_ctrlvar (
533 & xx_edtaux_file, 25, 125, 1, 1, 1,
534 & snx, sny, nr, 'w', '3d', myThid )
535
536 call ctrl_init_ctrlvar (
537 & xx_edtauy_file, 26, 126, 1, 1, 1,
538 & snx, sny, nr, 's', '3d', myThid )
539 #endif /* ALLOW_EDDYPSI_CONTROL */
540
541 c----------------------------------------------------------------------
542 c--
543 #ifdef ALLOW_UVEL0_CONTROL
544 call ctrl_init_ctrlvar (
545 & xx_uvel_file, 27, 127, 1, 1, 1,
546 & snx, sny, nr, 'w', '3d', myThid )
547 #endif /* ALLOW_UVEL0_CONTROL */
548
549 c----------------------------------------------------------------------
550 c--
551 #ifdef ALLOW_VVEL0_CONTROL
552 call ctrl_init_ctrlvar (
553 & xx_vvel_file, 28, 128, 1, 1, 1,
554 & snx, sny, nr, 's', '3d', myThid )
555 #endif /* ALLOW_VVEL0_CONTROL */
556
557 c----------------------------------------------------------------------
558 c--
559 #ifdef ALLOW_ETAN0_CONTROL
560 call ctrl_init_ctrlvar (
561 & xx_etan_file, 29, 129, 1, 1, 1,
562 & snx, sny, 1, 'c', 'xy', myThid )
563 #endif /* ALLOW_VVEL0_CONTROL */
564
565 c----------------------------------------------------------------------
566 c--
567 #ifdef ALLOW_GEN2D_CONTROL
568 call ctrl_init_ctrlvar (
569 & xx_gen2d_file, 30, 130, 1, 1, 1,
570 & snx, sny, 1, 'c', 'xy', myThid )
571 #endif /* ALLOW_GEN2D_CONTROL */
572
573 c----------------------------------------------------------------------
574 c--
575 #ifdef ALLOW_GEN3D_CONTROL
576 call ctrl_init_ctrlvar (
577 & xx_gen3d_file, 31, 131, 1, 1, 1,
578 & snx, sny, nr, 'c', '3d', myThid )
579 #endif /* ALLOW_GEN3D_CONTROL */
580
581 c----------------------------------------------------------------------
582 c--
583 #ifdef ALLOW_PRECIP_CONTROL
584 c-- Atmos. precipitation
585 call ctrl_init_rec ( xx_precip_file,
586 I xx_precipstartdate1, xx_precipstartdate2, xx_precipperiod,1,
587 O xx_precipstartdate, diffrec, startrec, endrec,
588 I myThid )
589 call ctrl_init_ctrlvar (
590 & xx_precip_file, 32, 132, diffrec, startrec, endrec,
591 & snx, sny, 1, 'c', 'xy', myThid )
592
593 #endif /* ALLOW_PRECIP_CONTROL */
594
595 c----------------------------------------------------------------------
596 c--
597 #ifdef ALLOW_SWFLUX_CONTROL
598 c-- Atmos. swflux
599 call ctrl_init_rec ( xx_swflux_file,
600 I xx_swfluxstartdate1, xx_swfluxstartdate2, xx_swfluxperiod, 1,
601 O xx_swfluxstartdate, diffrec, startrec, endrec,
602 I myThid )
603 call ctrl_init_ctrlvar (
604 & xx_swflux_file, 33, 133, diffrec, startrec, endrec,
605 & snx, sny, 1, 'c', 'xy', myThid )
606
607 #endif /* ALLOW_SWFLUX_CONTROL */
608
609 c----------------------------------------------------------------------
610 c--
611 #ifdef ALLOW_SWDOWN_CONTROL
612 c-- Atmos. swdown
613 call ctrl_init_rec ( xx_swdown_file,
614 I xx_swdownstartdate1, xx_swdownstartdate2, xx_swdownperiod, 1,
615 O xx_swdownstartdate, diffrec, startrec, endrec,
616 I myThid )
617 call ctrl_init_ctrlvar (
618 & xx_swdown_file, 34, 134, diffrec, startrec, endrec,
619 & snx, sny, 1, 'c', 'xy', myThid )
620
621 #endif /* ALLOW_SWDOWN_CONTROL */
622
623 c----------------------------------------------------------------------
624 c--
625 #ifdef ALLOW_LWFLUX_CONTROL
626 c-- Atmos. lwflux
627 call ctrl_init_rec ( xx_lwflux_file,
628 I xx_lwfluxstartdate1, xx_lwfluxstartdate2, xx_lwfluxperiod, 1,
629 O xx_lwfluxstartdate, diffrec, startrec, endrec,
630 I myThid )
631 call ctrl_init_ctrlvar (
632 & xx_lwflux_file, 35, 135, diffrec, startrec, endrec,
633 & snx, sny, 1, 'c', 'xy', myThid )
634
635 #endif /* ALLOW_LWFLUX_CONTROL */
636
637 c----------------------------------------------------------------------
638 c--
639 #ifdef ALLOW_LWDOWN_CONTROL
640 c-- Atmos. lwdown
641 call ctrl_init_rec ( xx_lwdown_file,
642 I xx_lwdownstartdate1, xx_lwdownstartdate2, xx_lwdownperiod, 1,
643 O xx_lwdownstartdate, diffrec, startrec, endrec,
644 I myThid )
645 call ctrl_init_ctrlvar (
646 & xx_lwdown_file, 36, 136, diffrec, startrec, endrec,
647 & snx, sny, 1, 'c', 'xy', myThid )
648
649 #endif /* ALLOW_LWDOWN_CONTROL */
650
651 c----------------------------------------------------------------------
652 c--
653 #ifdef ALLOW_EVAP_CONTROL
654 c-- Atmos. evap
655 call ctrl_init_rec ( xx_evap_file,
656 I xx_evapstartdate1, xx_evapstartdate2, xx_evapperiod, 1,
657 O xx_evapstartdate, diffrec, startrec, endrec,
658 I myThid )
659 call ctrl_init_ctrlvar (
660 & xx_evap_file, 37, 137, diffrec, startrec, endrec,
661 & snx, sny, 1, 'c', 'xy', myThid )
662
663 #endif /* ALLOW_EVAP_CONTROL */
664
665 c----------------------------------------------------------------------
666 c--
667 #ifdef ALLOW_SNOWPRECIP_CONTROL
668 c-- Atmos. snowprecip
669 call ctrl_init_rec ( xx_snowprecip_file,
670 I xx_snowprecipstartdate1, xx_snowprecipstartdate2,
671 I xx_snowprecipperiod, 1,
672 O xx_snowprecipstartdate, diffrec, startrec, endrec,
673 I myThid )
674 call ctrl_init_ctrlvar (
675 & xx_snowprecip_file, 38, 138, diffrec, startrec, endrec,
676 & snx, sny, 1, 'c', 'xy', myThid )
677
678 #endif /* ALLOW_SNOWPRECIP_CONTROL */
679
680 c----------------------------------------------------------------------
681 c--
682 #ifdef ALLOW_APRESSURE_CONTROL
683 c-- Atmos. apressure
684 call ctrl_init_rec ( xx_apressure_file,
685 I xx_apressurestartdate1, xx_apressurestartdate2,
686 I xx_apressureperiod, 1,
687 O xx_apressurestartdate, diffrec, startrec, endrec,
688 I myThid )
689 call ctrl_init_ctrlvar (
690 & xx_apressure_file, 39, 139, diffrec, startrec, endrec,
691 & snx, sny, 1, 'c', 'xy', myThid )
692
693 #endif /* ALLOW_APRESSURE_CONTROL */
694
695 c----------------------------------------------------------------------
696 c--
697 #ifdef ALLOW_RUNOFF_CONTROL
698 c-- Atmos. runoff
699 call ctrl_init_rec ( xx_runoff_file,
700 I xx_runoffstartdate1, xx_runoffstartdate2, xx_runoffperiod, 1,
701 O xx_runoffstartdate, diffrec, startrec, endrec,
702 I myThid )
703 call ctrl_init_ctrlvar (
704 & xx_runoff_file, 40, 140, diffrec, startrec, endrec,
705 & snx, sny, 1, 'c', 'xy', myThid )
706 #endif /* ALLOW_RUNOFF_CONTROL */
707
708 c----------------------------------------------------------------------
709 c--
710 #ifdef ALLOW_SIAREA_CONTROL
711 C-- so far there are no xx_siareastartdate1, etc., so we need to fudge it.
712 CML call ctrl_init_rec ( xx_siarea_file,
713 CML I xx_siareastartdate1, xx_siareastartdate2, xx_siareaperiod, 1,
714 CML O xx_siareastartdate, diffrec, startrec, endrec,
715 CML I myThid )
716 startrec = 1
717 endrec = 1
718 diffrec = endrec - startrec + 1
719 call ctrl_init_ctrlvar (
720 & xx_siarea_file, 41, 141, diffrec, startrec, endrec,
721 & snx, sny, 1, 'c', 'xy', myThid )
722 #endif /* ALLOW_siarea_CONTROL */
723
724 c----------------------------------------------------------------------
725 c--
726 #ifdef ALLOW_SIHEFF_CONTROL
727 C-- so far there are no xx_siheffstartdate1, etc., so we need to fudge it.
728 CML call ctrl_init_rec ( xx_siheff_file,
729 CML I xx_siheffstartdate1, xx_siheffstartdate2, xx_siheffperiod, 1,
730 CML O xx_siheffstartdate, diffrec, startrec, endrec,
731 CML I myThid )
732 startrec = 1
733 endrec = 1
734 diffrec = endrec - startrec + 1
735 call ctrl_init_ctrlvar (
736 & xx_siheff_file, 42, 142, diffrec, startrec, endrec,
737 & snx, sny, 1, 'c', 'xy', myThid )
738 #endif /* ALLOW_siheff_CONTROL */
739
740 c----------------------------------------------------------------------
741 c--
742 #ifdef ALLOW_SIHSNOW_CONTROL
743 C-- so far there are no xx_sihsnowstartdate1, etc., so we need to fudge it.
744 CML call ctrl_init_rec ( xx_sihsnow_file,
745 CML I xx_sihsnowstartdate1, xx_sihsnowstartdate2, xx_sihsnowperiod, 1,
746 CML O xx_sihsnowstartdate, diffrec, startrec, endrec,
747 CML I myThid )
748 startrec = 1
749 endrec = 1
750 diffrec = endrec - startrec + 1
751 call ctrl_init_ctrlvar (
752 & xx_sihsnow_file, 43, 143, diffrec, startrec, endrec,
753 & snx, sny, 1, 'c', 'xy', myThid )
754 #endif /* ALLOW_sihsnow_CONTROL */
755
756
757 c----------------------------------------------------------------------
758 c--
759 #ifdef ALLOW_KAPREDI_CONTROL
760 call ctrl_init_ctrlvar (
761 & xx_kapredi_file, 44, 144, 1, 1, 1,
762 & snx, sny, nr, 'c', '3d', myThid )
763 #endif /* ALLOW_KAPREDI_CONTROL */
764
765 c----------------------------------------------------------------------
766 c----------------------------------------------------------------------
767
768 #ifdef ALLOW_SHIFWFLX_CONTROL
769 c-- freshwater flux underneath ice-shelves
770 call ctrl_init_rec ( xx_shifwflx_file,
771 I xx_shifwflxstartdate1, xx_shifwflxstartdate2,
772 I xx_shifwflxperiod, 1,
773 O xx_shifwflxstartdate, diffrec, startrec, endrec,
774 I myThid )
775 call ctrl_init_ctrlvar (
776 & xx_shifwflx_file, 45, 145, diffrec, startrec, endrec,
777 & snx, sny, 1, 'i', 'xy', myThid )
778 #endif /* ALLOW_SHIFWFLX_CONTROL */
779
780 c----------------------------------------------------------------------
781 c--
782 #ifdef ALLOW_ATM_MEAN_CONTROL
783 # ifdef ALLOW_ATEMP_CONTROL
784 call ctrl_init_ctrlvar (
785 & xx_atemp_mean_file, 47, 147, 1, 1, 1,
786 & snx, sny, 1, 'c', 'xy', myThid )
787 # endif
788 # ifdef ALLOW_AQH_CONTROL
789 call ctrl_init_ctrlvar (
790 & xx_aqh_mean_file, 48, 148, 1, 1, 1,
791 & snx, sny, 1, 'c', 'xy', myThid )
792 # endif
793 # ifdef ALLOW_UWIND_CONTROL
794 call ctrl_init_ctrlvar (
795 & xx_uwind_mean_file, 49, 149, 1, 1, 1,
796 & snx, sny, 1, 'c', 'xy', myThid )
797 # endif
798 # ifdef ALLOW_VWIND_CONTROL
799 call ctrl_init_ctrlvar (
800 & xx_vwind_mean_file, 50, 150, 1, 1, 1,
801 & snx, sny, 1, 'c', 'xy', myThid )
802 # endif
803 # ifdef ALLOW_PRECIP_CONTROL
804 call ctrl_init_ctrlvar (
805 & xx_precip_mean_file,51, 151, 1, 1, 1,
806 & snx, sny, 1, 'c', 'xy', myThid )
807 # endif
808 # ifdef ALLOW_SWDOWN_CONTROL
809 call ctrl_init_ctrlvar (
810 & xx_swdown_mean_file,52, 152, 1, 1, 1,
811 & snx, sny, 1, 'c', 'xy', myThid )
812 # endif
813 #endif /* ALLOW_ATM_MEAN_CONTROL */
814
815 #endif /* ECCO_CTRL_DEPRECATED */
816
817 c----------------------------------------------------------------------
818 c--
819 #ifdef ALLOW_GENARR2D_CONTROL
820 do iarr = 1, maxCtrlArr2D
821 #ifndef ALLOW_OPENAD
822 if (xx_genarr2d_weight(iarr).NE.' ')
823 & call ctrl_init_ctrlvar (
824 #else
825 call ctrl_init_ctrlvar (
826 #endif
827 & xx_genarr2d_file(iarr)(1:MAX_LEN_FNAM),
828 & 100+iarr, 200+iarr, 1, 1, 1,
829 & snx, sny, 1, 'c', 'xy', myThid )
830
831 enddo
832 #endif /* ALLOW_GENARR2D_CONTROL */
833
834 c----------------------------------------------------------------------
835 c--
836 #ifdef ALLOW_GENARR3D_CONTROL
837 do iarr = 1, maxCtrlArr3D
838 #ifndef ALLOW_OPENAD
839 if (xx_genarr3d_weight(iarr).NE.' ')
840 & call ctrl_init_ctrlvar (
841 #else
842 call ctrl_init_ctrlvar (
843 #endif
844 & xx_genarr3d_file(iarr)(1:MAX_LEN_FNAM),
845 & 200+iarr, 300+iarr, 1, 1, 1,
846 & snx, sny, nr, 'c', '3d', myThid )
847 enddo
848 #endif /* ALLOW_GENARR3D_CONTROL */
849
850 c----------------------------------------------------------------------
851 c--
852 #ifdef ALLOW_GENTIM2D_CONTROL
853 do iarr = 1, maxCtrlTim2D
854
855 if (xx_gentim2d_weight(iarr).NE.' ')
856 & call mdsreadfield( xx_gentim2d_weight(iarr), ctrlprec, 'RL',
857 & 1, wgentim2d(1-Olx,1-Oly,1,1,iarr), 1, myThid )
858
859 #ifdef ALLOW_CAL
860 if (xx_gentim2d_startdate1(iarr).EQ.0) then
861 xx_gentim2d_startdate1(iarr)=startdate_1
862 xx_gentim2d_startdate2(iarr)=startdate_2
863 endif
864 #endif
865
866 call ctrl_init_rec ( xx_gentim2d_file(iarr)(1:MAX_LEN_FNAM),
867 I xx_gentim2d_startdate1(iarr),
868 I xx_gentim2d_startdate2(iarr),
869 I xx_gentim2d_period(iarr),
870 I 1,
871 O xx_gentim2d_startdate(1,iarr),
872 O diffrec, startrec, endrec,
873 I myThid )
874 C
875
876 #ifndef ALLOW_OPENAD
877 if (xx_gentim2d_weight(iarr).NE.' ') then
878 #endif
879 do k2 = 1, maxCtrlProc
880 if (xx_gentim2d_preproc(k2,iarr).EQ.'replicate')
881 & xx_gentim2d_preproc(k2,iarr)='docycle'
882 if (xx_gentim2d_preproc(k2,iarr).EQ.'doglomean')
883 & xx_gentim2d_glosum(iarr) = .TRUE.
884 if (xx_gentim2d_preproc(k2,iarr).EQ.'documul')
885 & xx_gentim2d_cumsum(iarr) = .TRUE.
886 enddo
887 C
888 diffrecFull=diffrec
889 endrecFull=endrec
890 do k2 = 1, maxCtrlProc
891 if (xx_gentim2d_preproc(k2,iarr).EQ.'docycle') then
892 if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
893 diffrec=min(diffrec,xx_gentim2d_preproc_i(k2,iarr))
894 endrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr))
895 endif
896 endif
897 enddo
898 C
899 ilgen=ilnblnk( xx_gentim2d_file(iarr) )
900 write(fnamegen(1:MAX_LEN_FNAM),'(2a)')
901 & xx_gentim2d_file(iarr)(1:ilgen),'.effective'
902 call ctrl_init_ctrlvar (
903 & fnamegen(1:MAX_LEN_FNAM),
904 & 300+iarr, 400+iarr,
905 & diffrecFull, startrec, endrecFull,
906 & snx, sny, 1, 'c', 'xy', myThid )
907 C
908 ilgen=ilnblnk( xx_gentim2d_file(iarr) )
909 write(fnamegen(1:MAX_LEN_FNAM),'(2a)')
910 & xx_gentim2d_file(iarr)(1:ilgen),'.tmp'
911 call ctrl_init_ctrlvar (
912 & fnamegen(1:MAX_LEN_FNAM),
913 & 300+iarr, 400+iarr,
914 & diffrecFull, startrec, endrecFull,
915 & snx, sny, 1, 'c', 'xy', myThid )
916 C
917 call ctrl_init_ctrlvar (
918 & xx_gentim2d_file(iarr)(1:MAX_LEN_FNAM),
919 & 300+iarr, 400+iarr,
920 & diffrec, startrec, endrec,
921 & snx, sny, 1, 'c', 'xy', myThid )
922 C
923 #ifndef ALLOW_OPENAD
924 endif
925 #endif
926 C
927 enddo
928 #endif /* ALLOW_GENTIM2D_CONTROL */
929
930 c----------------------------------------------------------------------
931 c----------------------------------------------------------------------
932
933 call ctrl_init_wet( myThid )
934
935 c----------------------------------------------------------------------
936 c----------------------------------------------------------------------
937
938 #ifdef ALLOW_DIC_CONTROL
939 do i = 1, dic_n_control
940 xx_dic(i) = 0. _d 0
941 enddo
942 #endif
943
944 c----------------------------------------------------------------------
945 c----------------------------------------------------------------------
946
947 do bj = jtlo,jthi
948 do bi = itlo,ithi
949 do j = jmin,jmax
950 do i = imin,imax
951 wareaunit (i,j,bi,bj) = 1.0
952 #ifndef ALLOW_ECCO
953 whflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
954 wsflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
955 wtauu (i,j,bi,bj) = maskW(i,j,1,bi,bj)
956 wtauv (i,j,bi,bj) = maskS(i,j,1,bi,bj)
957 watemp (i,j,bi,bj) = maskC(i,j,1,bi,bj)
958 waqh (i,j,bi,bj) = maskC(i,j,1,bi,bj)
959 wprecip (i,j,bi,bj) = maskC(i,j,1,bi,bj)
960 wswflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
961 wswdown (i,j,bi,bj) = maskC(i,j,1,bi,bj)
962 wuwind (i,j,bi,bj) = maskC(i,j,1,bi,bj)
963 wvwind (i,j,bi,bj) = maskC(i,j,1,bi,bj)
964 wlwflux (i,j,bi,bj) = maskC(i,j,1,bi,bj)
965 wlwdown (i,j,bi,bj) = maskC(i,j,1,bi,bj)
966 wevap (i,j,bi,bj) = maskC(i,j,1,bi,bj)
967 wsnowprecip(i,j,bi,bj) = maskC(i,j,1,bi,bj)
968 wapressure(i,j,bi,bj) = maskC(i,j,1,bi,bj)
969 wrunoff (i,j,bi,bj) = maskC(i,j,1,bi,bj)
970 wsst (i,j,bi,bj) = maskC(i,j,1,bi,bj)
971 wsss (i,j,bi,bj) = maskC(i,j,1,bi,bj)
972 #endif
973 enddo
974 enddo
975 enddo
976 enddo
977
978 _BARRIER
979
980 c-- Summarize the cost function setup.
981 _BEGIN_MASTER( myThid )
982 call ctrl_summary( myThid )
983 _END_MASTER( myThid )
984
985 return
986 end

  ViewVC Help
Powered by ViewVC 1.1.22