/[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.8 - (hide annotations) (download)
Mon Jun 23 22:29:05 2003 UTC (20 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint50i_post
Changes since 1.7: +1 -193 lines
Preparing next differentiable checkpoint and sync
of MAIN vs. ecco-branch

1 heimbach 1.8 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_init.F,v 1.7 2003/03/07 02:45:48 heimbach Exp $
2 heimbach 1.1
3     #include "CTRL_CPPOPTIONS.h"
4    
5    
6 heimbach 1.5 subroutine ctrl_init( mythid )
7 heimbach 1.1
8     c ==================================================================
9 heimbach 1.5 c SUBROUTINE ctrl_init
10 heimbach 1.1 c ==================================================================
11     c
12     c o Set parts of the vector of control variables and initialize the
13     c rest to zero.
14     c
15     c The vector of control variables is initialized here. The
16     c temperature and salinity contributions are read from file.
17     c Subsequently, the latter are dimensionalized and the tile
18     c edges are updated.
19     c
20     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
21     c
22     c changed: Christian Eckert eckert@mit.edu 23-Feb-2000
23     c - Restructured the code in order to create a package
24     c for the MITgcmUV.
25     c
26     c Patrick Heimbach heimbach@mit.edu 30-May-2000
27     c - diffsec was falsely declared.
28     c
29     c Patrick Heimbach heimbach@mit.edu 06-Jun-2000
30     c - Transferred some filename declarations
31     c from ctrl_pack/ctrl_unpack to here
32     c - Transferred mask-per-tile to here
33     c - computation of control vector length here
34     c
35     c Patrick Heimbach heimbach@mit.edu 16-Jun-2000
36     c - Added call to ctrl_pack
37     c - Alternatively: transfer writing of scale files to
38     c ctrl_unpack
39     c
40     c ==================================================================
41 heimbach 1.5 c SUBROUTINE ctrl_init
42 heimbach 1.1 c ==================================================================
43    
44     implicit none
45    
46     c == global variables ==
47    
48     #include "EEPARAMS.h"
49     #include "SIZE.h"
50     #include "PARAMS.h"
51     #include "GRID.h"
52     #include "ctrl.h"
53    
54 heimbach 1.5 #ifdef ALLOW_CALENDAR
55     #include "cal.h"
56     #endif
57     #ifdef ALLOW_OBCS_CONTROL
58     # include "OBCS.h"
59     #endif
60     #ifdef ALLOW_ECCO_OPTIMIZATION
61     #include "optim.h"
62     #endif
63    
64 heimbach 1.1 c == routine arguments ==
65    
66     integer mythid
67    
68     c == local variables ==
69    
70     integer bi,bj
71     integer i,j,k
72     integer itlo,ithi
73     integer jtlo,jthi
74     integer jmin,jmax
75     integer imin,imax
76     integer ntmp
77 heimbach 1.5 integer ivarindex
78 heimbach 1.1
79 heimbach 1.5 integer iobcs
80 heimbach 1.1 integer il
81     integer errio
82     integer startrec
83     integer endrec
84 heimbach 1.5 integer difftime(4)
85     _RL diffsecs
86     _RL dummy
87 heimbach 1.1
88 heimbach 1.5 character*(80) ymaskobcs
89 heimbach 1.1 character*(max_len_prec) record
90     character*(max_len_mbuf) msgbuf
91    
92 heimbach 1.5 integer nwetc3d
93    
94 heimbach 1.1 c == external ==
95    
96     integer ilnblnk
97     external ilnblnk
98    
99     c == end of interface ==
100    
101     jtlo = mybylo(mythid)
102     jthi = mybyhi(mythid)
103     itlo = mybxlo(mythid)
104     ithi = mybxhi(mythid)
105     jmin = 1-oly
106     jmax = sny+oly
107     imin = 1-olx
108     imax = snx+olx
109    
110     _BEGIN_MASTER( myThid )
111 heimbach 1.5
112 heimbach 1.1 c-- Set default values.
113 heimbach 1.5 do ivarindex = 1,maxcvars
114     ncvarindex(ivarindex) = -1
115     ncvarrecs(ivarindex) = 0
116     ncvarxmax(ivarindex) = 0
117     ncvarymax(ivarindex) = 0
118     ncvarnrmax(ivarindex) = 0
119     ncvargrd(ivarindex) = '?'
120 heimbach 1.1 enddo
121    
122     write(msgbuf,'(a)') ' '
123     call print_message( msgbuf, standardmessageunit,
124     & SQUEEZE_RIGHT , mythid)
125     write(msgbuf,'(a)')
126     & ' ctrl_init: Initializing temperature and salinity'
127     call print_message( msgbuf, standardmessageunit,
128     & SQUEEZE_RIGHT , mythid)
129     write(msgbuf,'(a)')
130     & ' part of the control vector.'
131     call print_message( msgbuf, standardmessageunit,
132     & SQUEEZE_RIGHT , mythid)
133     write(msgbuf,'(a,a)')
134     & ' The initial surface fluxes are set',
135     & ' to zero.'
136     call print_message( msgbuf, standardmessageunit,
137     & SQUEEZE_RIGHT , mythid)
138     write(msgbuf,'(a)') ' '
139     call print_message( msgbuf, standardmessageunit,
140     & SQUEEZE_RIGHT , mythid)
141     _END_MASTER( mythid )
142    
143     _BARRIER
144    
145     c-- =====================
146     c-- Initial state fields.
147     c-- =====================
148    
149 heimbach 1.5 cph(
150     cph index 7-10 reserved for atmos. state,
151     cph index 11-14 reserved for open boundaries,
152     cph index 15-16 reserved for mixing coeff.
153     cph index 17 reserved for passive tracer TR1
154     cph index 18,19 reserved for sst, sss
155     cph index 20 for hFacC
156 heimbach 1.6 cph index 21-22 for efluxy, efluxp
157     cph index 23-24 for bottom drag
158 heimbach 1.5 cph)
159    
160 heimbach 1.6 c-------------------------------------------------------------------------------------------
161     c--
162 heimbach 1.1 #ifdef ALLOW_THETA0_CONTROL
163 heimbach 1.5 c-- Initial state temperature contribution.
164    
165 heimbach 1.1 _BEGIN_MASTER( mythid )
166 heimbach 1.5 ivarindex = 1
167     ncvarindex(ivarindex) = 101
168     ncvarrecs(ivarindex) = 1
169     ncvarxmax(ivarindex) = snx
170     ncvarymax(ivarindex) = sny
171     ncvarnrmax(ivarindex) = nr
172     ncvargrd(ivarindex) = 'c'
173 heimbach 1.1 _END_MASTER( mythid )
174 heimbach 1.5
175 heimbach 1.1 #endif /* ALLOW_THETA0_CONTROL */
176    
177 heimbach 1.6 c-------------------------------------------------------------------------------------------
178     c--
179 heimbach 1.1 #ifdef ALLOW_SALT0_CONTROL
180 heimbach 1.5 c-- Initial state salinity contribution.
181    
182 heimbach 1.1 _BEGIN_MASTER( mythid )
183 heimbach 1.5 ivarindex = 2
184     ncvarindex(ivarindex) = 102
185     ncvarrecs(ivarindex) = 1
186     ncvarxmax(ivarindex) = snx
187     ncvarymax(ivarindex) = sny
188     ncvarnrmax(ivarindex) = nr
189     ncvargrd(ivarindex) = 'c'
190 heimbach 1.1 _END_MASTER( mythid )
191 heimbach 1.5
192 heimbach 1.1 #endif /* ALLOW_SALT0_CONTROL */
193    
194 heimbach 1.5 c-- ===========================
195     c-- Surface flux contributions.
196     c-- ===========================
197    
198 heimbach 1.6 c-------------------------------------------------------------------------------------------
199     c--
200 heimbach 1.5 #if (defined (ALLOW_HFLUX_CONTROL))
201     c-- Heat flux.
202    
203     _BEGIN_MASTER( mythid )
204     #ifdef ALLOW_CALENDAR
205     call cal_TimePassed( xx_hfluxstartdate, modelstartdate,
206     & difftime, mythid )
207     call cal_ToSeconds ( difftime, diffsecs, mythid )
208     startrec = int((modelstart - diffsecs)/
209     & xx_hfluxperiod) + 1
210     endrec = int((modelend - diffsecs - modelstep)/
211     & xx_hfluxperiod) + 2
212     #else
213     startrec = 1
214     endrec = 1
215     #endif
216     ivarindex = 3
217     ncvarindex(ivarindex) = 103
218     ncvarrecs(ivarindex) = endrec - startrec + 1
219     ncvarrecstart(ivarindex) = startrec
220     ncvarrecsend(ivarindex) = endrec
221     ncvarxmax(ivarindex) = snx
222     ncvarymax(ivarindex) = sny
223     ncvarnrmax(ivarindex) = 1
224     ncvargrd(ivarindex) = 'c'
225     _END_MASTER( mythid )
226    
227     #elif (defined (ALLOW_ATEMP_CONTROL))
228     c-- Atmos. temperature
229    
230     _BEGIN_MASTER( mythid )
231     #ifdef ALLOW_CALENDAR
232     call cal_TimePassed( xx_atempstartdate, modelstartdate,
233     & difftime, mythid )
234     call cal_ToSeconds ( difftime, diffsecs, mythid )
235     startrec = int((modelstart - diffsecs)/
236     & xx_atempperiod) + 1
237     endrec = int((modelend - diffsecs - modelstep)/
238     & xx_atempperiod) + 2
239     #else
240     startrec = 1
241     endrec = 1
242     #endif
243     ivarindex = 7
244     ncvarindex(ivarindex) = 107
245     ncvarrecs(ivarindex) = endrec - startrec + 1
246     ncvarrecstart(ivarindex) = startrec
247     ncvarrecsend(ivarindex) = endrec
248     ncvarxmax(ivarindex) = snx
249     ncvarymax(ivarindex) = sny
250     ncvarnrmax(ivarindex) = 1
251     ncvargrd(ivarindex) = 'c'
252     _END_MASTER( mythid )
253    
254     #elif (defined (ALLOW_HFLUX0_CONTROL))
255     c-- initial forcing only
256 heimbach 1.1 _BEGIN_MASTER( mythid )
257     ncvarindex(3) = 103
258     ncvarrecs(3) = 1
259     ncvarxmax(3) = snx
260     ncvarymax(3) = sny
261     ncvarnrmax(3) = 1
262     ncvargrd(3) = 'c'
263     _END_MASTER( mythid )
264    
265 heimbach 1.5 #endif /* ALLOW_HFLUX_CONTROL */
266    
267 heimbach 1.6 c-------------------------------------------------------------------------------------------
268     c--
269 heimbach 1.5 #if (defined (ALLOW_SFLUX_CONTROL))
270     c-- Salt flux.
271    
272     _BEGIN_MASTER( mythid )
273     #ifdef ALLOW_CALENDAR
274     call cal_TimePassed( xx_sfluxstartdate, modelstartdate,
275     & difftime, mythid )
276     call cal_ToSeconds ( difftime, diffsecs, mythid )
277     startrec = int((modelstart - diffsecs)/
278     & xx_sfluxperiod) + 1
279     endrec = int((modelend - diffsecs - modelstep)/
280     & xx_sfluxperiod) + 2
281     #else
282     startrec = 1
283     endrec = 1
284     #endif
285     ivarindex = 4
286     ncvarindex(ivarindex) = 104
287     ncvarrecs(ivarindex) = endrec - startrec + 1
288     ncvarrecstart(ivarindex) = startrec
289     ncvarrecsend(ivarindex) = endrec
290     ncvarxmax(ivarindex) = snx
291     ncvarymax(ivarindex) = sny
292     ncvarnrmax(ivarindex) = 1
293     ncvargrd(ivarindex) = 'c'
294     _END_MASTER( mythid )
295    
296     #elif (defined (ALLOW_AQH_CONTROL))
297     c-- Atmos. humidity
298    
299     _BEGIN_MASTER( mythid )
300     #ifdef ALLOW_CALENDAR
301     call cal_TimePassed( xx_aqhstartdate, modelstartdate,
302     & difftime, mythid )
303     call cal_ToSeconds ( difftime, diffsecs, mythid )
304     startrec = int((modelstart - diffsecs)/
305     & xx_aqhperiod) + 1
306     endrec = int((modelend - diffsecs - modelstep)/
307     & xx_aqhperiod) + 2
308     #else
309     startrec = 1
310     endrec = 1
311     #endif
312     ivarindex = 8
313     ncvarindex(ivarindex) = 108
314     ncvarrecs(ivarindex) = endrec - startrec + 1
315     ncvarrecstart(ivarindex) = startrec
316     ncvarrecsend(ivarindex) = endrec
317     ncvarxmax(ivarindex) = snx
318     ncvarymax(ivarindex) = sny
319     ncvarnrmax(ivarindex) = 1
320     ncvargrd(ivarindex) = 'c'
321     _END_MASTER( mythid )
322    
323     #elif (defined (ALLOW_SFLUX0_CONTROL))
324     c-- initial forcing only
325 heimbach 1.1 _BEGIN_MASTER( mythid )
326     ncvarindex(4) = 104
327     ncvarrecs(4) = 1
328     ncvarxmax(4) = snx
329     ncvarymax(4) = sny
330     ncvarnrmax(4) = 1
331     ncvargrd(4) = 'c'
332     _END_MASTER( mythid )
333    
334 heimbach 1.5 #endif /* ALLOW_SFLUX_CONTROL */
335    
336 heimbach 1.6 c-------------------------------------------------------------------------------------------
337     c--
338 heimbach 1.5 #if (defined (ALLOW_USTRESS_CONTROL))
339     c-- Zonal wind stress.
340    
341     _BEGIN_MASTER( mythid )
342     #ifdef ALLOW_CALENDAR
343     call cal_TimePassed( xx_tauustartdate, modelstartdate,
344     & difftime, mythid )
345     call cal_ToSeconds ( difftime, diffsecs, mythid )
346     startrec = int((modelstart - diffsecs)/
347     & xx_tauuperiod) + 1
348     endrec = int((modelend - diffsecs - modelstep)/
349     & xx_tauuperiod) + 2
350     #else
351     startrec = 1
352     endrec = 1
353     #endif
354     ivarindex = 5
355     ncvarindex(ivarindex) = 105
356     ncvarrecs(ivarindex) = endrec - startrec + 1
357     ncvarrecstart(ivarindex) = startrec
358     ncvarrecsend(ivarindex) = endrec
359     ncvarxmax(ivarindex) = snx
360     ncvarymax(ivarindex) = sny
361     ncvarnrmax(ivarindex) = 1
362     ncvargrd(ivarindex) = 'w'
363     _END_MASTER( mythid )
364    
365     #elif (defined (ALLOW_UWIND_CONTROL))
366     c-- Zonal wind speed.
367    
368     _BEGIN_MASTER( mythid )
369     #ifdef ALLOW_CALENDAR
370     call cal_TimePassed( xx_uwindstartdate, modelstartdate,
371     & difftime, mythid )
372     call cal_ToSeconds ( difftime, diffsecs, mythid )
373     startrec = int((modelstart - diffsecs)/
374     & xx_uwindperiod) + 1
375     endrec = int((modelend - diffsecs - modelstep)/
376     & xx_uwindperiod) + 2
377     #else
378     startrec = 1
379     endrec = 1
380     #endif
381     ivarindex = 9
382     ncvarindex(ivarindex) = 109
383     ncvarrecs(ivarindex) = endrec - startrec + 1
384     ncvarrecstart(ivarindex) = startrec
385     ncvarrecsend(ivarindex) = endrec
386     ncvarxmax(ivarindex) = snx
387     ncvarymax(ivarindex) = sny
388     ncvarnrmax(ivarindex) = 1
389     ncvargrd(ivarindex) = 'w'
390     _END_MASTER( mythid )
391    
392     #elif (defined (ALLOW_TAUU0_CONTROL))
393     c-- initial forcing only
394 heimbach 1.1 _BEGIN_MASTER( mythid )
395     ncvarindex(5) = 105
396     ncvarrecs(5) = 1
397     ncvarxmax(5) = snx
398     ncvarymax(5) = sny
399     ncvarnrmax(5) = 1
400     ncvargrd(5) = 'w'
401     _END_MASTER( mythid )
402    
403 heimbach 1.5 #endif /* ALLOW_USTRESS_CONTROL */
404    
405 heimbach 1.6 c-------------------------------------------------------------------------------------------
406     c--
407 heimbach 1.5 #if (defined (ALLOW_VSTRESS_CONTROL))
408     c-- Meridional wind stress.
409    
410     _BEGIN_MASTER( mythid )
411     #ifdef ALLOW_CALENDAR
412     call cal_TimePassed( xx_tauvstartdate, modelstartdate,
413     & difftime, mythid )
414     call cal_ToSeconds ( difftime, diffsecs, mythid )
415     startrec = int((modelstart - diffsecs)/
416     & xx_tauvperiod) + 1
417     endrec = int((modelend - diffsecs - modelstep)/
418     & xx_tauvperiod) + 2
419     #else
420     startrec = 1
421     endrec = 1
422     #endif
423     ivarindex = 6
424     ncvarindex(ivarindex) = 106
425     ncvarrecs(ivarindex) = endrec - startrec + 1
426     ncvarrecstart(ivarindex) = startrec
427     ncvarrecsend(ivarindex) = endrec
428     ncvarxmax(ivarindex) = snx
429     ncvarymax(ivarindex) = sny
430     ncvarnrmax(ivarindex) = 1
431     ncvargrd(ivarindex) = 's'
432     _END_MASTER( mythid )
433    
434     #elif (defined (ALLOW_VWIND_CONTROL))
435     c-- Meridional wind speed.
436    
437     _BEGIN_MASTER( mythid )
438     #ifdef ALLOW_CALENDAR
439     call cal_TimePassed( xx_vwindstartdate, modelstartdate,
440     & difftime, mythid )
441     call cal_ToSeconds ( difftime, diffsecs, mythid )
442     startrec = int((modelstart - diffsecs)/
443     & xx_vwindperiod) + 1
444     endrec = int((modelend - diffsecs - modelstep)/
445     & xx_vwindperiod) + 2
446     #else
447     startrec = 1
448     endrec = 1
449     #endif
450     ivarindex = 10
451     ncvarindex(ivarindex) = 110
452     ncvarrecs(ivarindex) = endrec - startrec + 1
453     ncvarrecstart(ivarindex) = startrec
454     ncvarrecsend(ivarindex) = endrec
455     ncvarxmax(ivarindex) = snx
456     ncvarymax(ivarindex) = sny
457     ncvarnrmax(ivarindex) = 1
458     ncvargrd(ivarindex) = 's'
459     _END_MASTER( mythid )
460    
461     #elif (defined (ALLOW_TAUV0_CONTROL))
462     c-- initial forcing only
463 heimbach 1.1 _BEGIN_MASTER( mythid )
464     ncvarindex(6) = 106
465     ncvarrecs(6) = 1
466     ncvarxmax(6) = snx
467     ncvarymax(6) = sny
468     ncvarnrmax(6) = 1
469     ncvargrd(6) = 's'
470     _END_MASTER( mythid )
471    
472 heimbach 1.5 #endif /* ALLOW_VSTRESS_CONTROL */
473    
474 heimbach 1.6 c-------------------------------------------------------------------------------------------
475     c--
476 heimbach 1.5 #ifdef ALLOW_OBCSN_CONTROL
477     c-- Northern obc.
478    
479     _BEGIN_MASTER( mythid )
480     #ifdef ALLOW_CALENDAR
481     call cal_TimePassed( xx_obcsnstartdate, modelstartdate,
482     & difftime, mythid )
483     call cal_ToSeconds ( difftime, diffsecs, mythid )
484     startrec = int((modelstart - diffsecs)/
485     & xx_obcsnperiod) + 1
486     endrec = int((modelend - diffsecs)/
487     & xx_obcsnperiod) + 2
488     #else
489     startrec = 1
490     endrec = 1
491     #endif
492     ivarindex = 11
493     ncvarindex(ivarindex) = 111
494     ncvarrecs(ivarindex) = (endrec - startrec + 1)*nobcs
495     ncvarrecstart(ivarindex) = (startrec - 1)*nobcs + 1
496     ncvarrecsend(ivarindex) = endrec*nobcs
497     ncvarxmax(ivarindex) = snx
498     ncvarymax(ivarindex) = 1
499     ncvarnrmax(ivarindex) = nr
500     ncvargrd(ivarindex) = 'm'
501     _END_MASTER( mythid )
502    
503     #endif /* ALLOW_OBCSN_CONTROL */
504    
505     #ifdef ALLOW_OBCSS_CONTROL
506     c-- Southern obc.
507    
508 heimbach 1.6 c-------------------------------------------------------------------------------------------
509     c--
510 heimbach 1.7 _BEGIN_MASTER( mythid )
511 heimbach 1.5 #ifdef ALLOW_CALENDAR
512     call cal_TimePassed( xx_obcssstartdate, modelstartdate,
513     & difftime, mythid )
514     call cal_ToSeconds ( difftime, diffsecs, mythid )
515     startrec = int((modelstart - diffsecs)/
516     & xx_obcssperiod) + 1
517     endrec = int((modelend - diffsecs)/
518     & xx_obcssperiod) + 2
519     #else
520     startrec = 1
521     endrec = 1
522     #endif
523     ivarindex = 12
524     ncvarindex(ivarindex) = 112
525     ncvarrecs(ivarindex) = (endrec - startrec + 1)*nobcs
526     ncvarrecstart(ivarindex) = (startrec - 1)*nobcs + 1
527     ncvarrecsend(ivarindex) = endrec*nobcs
528     ncvarxmax(ivarindex) = snx
529     ncvarymax(ivarindex) = 1
530     ncvarnrmax(ivarindex) = nr
531     ncvargrd(ivarindex) = 'm'
532     _END_MASTER( mythid )
533    
534     #endif /* ALLOW_OBCSS_CONTROL */
535    
536 heimbach 1.6 c-------------------------------------------------------------------------------------------
537     c--
538 heimbach 1.5 #ifdef ALLOW_OBCSW_CONTROL
539     c-- Western obc.
540    
541     _BEGIN_MASTER( mythid )
542     #ifdef ALLOW_CALENDAR
543     call cal_TimePassed( xx_obcswstartdate, modelstartdate,
544     & difftime, mythid )
545     call cal_ToSeconds ( difftime, diffsecs, mythid )
546     startrec = int((modelstart - diffsecs)/
547     & xx_obcswperiod) + 1
548     endrec = int((modelend - diffsecs)/
549     & xx_obcswperiod) + 2
550     #else
551     startrec = 1
552     endrec = 1
553     #endif
554     ivarindex = 13
555     ncvarindex(ivarindex) = 113
556     ncvarrecs(ivarindex) = (endrec - startrec + 1)*nobcs
557     ncvarrecstart(ivarindex) = (startrec - 1)*nobcs + 1
558     ncvarrecsend(ivarindex) = endrec*nobcs
559     ncvarxmax(ivarindex) = 1
560     ncvarymax(ivarindex) = sny
561     ncvarnrmax(ivarindex) = nr
562     ncvargrd(ivarindex) = 'm'
563     _END_MASTER( mythid )
564    
565     #endif /* ALLOW_OBCSW_CONTROL */
566    
567 heimbach 1.6 c-------------------------------------------------------------------------------------------
568     c--
569 heimbach 1.5 #ifdef ALLOW_OBCSE_CONTROL
570     c-- Eastern obc.
571    
572     _BEGIN_MASTER( mythid )
573     #ifdef ALLOW_CALENDAR
574     call cal_TimePassed( xx_obcsestartdate, modelstartdate,
575     & difftime, mythid )
576     call cal_ToSeconds ( difftime, diffsecs, mythid )
577     startrec = int((modelstart - diffsecs)/
578     & xx_obcseperiod) + 1
579     endrec = int((modelend - diffsecs)/
580     & xx_obcseperiod) + 2
581     #else
582     startrec = 1
583     endrec = 1
584     #endif
585     ivarindex = 14
586     ncvarindex(ivarindex) = 114
587     ncvarrecs(ivarindex) = (endrec - startrec + 1)*nobcs
588     ncvarrecstart(ivarindex) = (startrec - 1)*nobcs + 1
589     ncvarrecsend(ivarindex) = endrec*nobcs
590     ncvarxmax(ivarindex) = 1
591     ncvarymax(ivarindex) = sny
592     ncvarnrmax(ivarindex) = nr
593     ncvargrd(ivarindex) = 'm'
594     _END_MASTER( mythid )
595    
596     #endif /* ALLOW_OBCSE_CONTROL */
597 heimbach 1.2
598 heimbach 1.6 c-------------------------------------------------------------------------------------------
599     c--
600 heimbach 1.3 #ifdef ALLOW_DIFFKR_CONTROL
601     _BEGIN_MASTER( mythid )
602 heimbach 1.5 ivarindex = 15
603     ncvarindex(ivarindex) = 115
604     ncvarrecs (ivarindex) = 1
605     ncvarxmax (ivarindex) = snx
606     ncvarymax (ivarindex) = sny
607     ncvarnrmax(ivarindex) = nr
608     ncvargrd (ivarindex) = 'c'
609 heimbach 1.3 _END_MASTER( mythid )
610     #endif /* ALLOW_DIFFKR_CONTROL */
611    
612 heimbach 1.6 c-------------------------------------------------------------------------------------------
613     c--
614 heimbach 1.3 #ifdef ALLOW_KAPGM_CONTROL
615     _BEGIN_MASTER( mythid )
616 heimbach 1.5 ivarindex = 16
617     ncvarindex(ivarindex) = 116
618     ncvarrecs (ivarindex) = 1
619     ncvarxmax (ivarindex) = snx
620     ncvarymax (ivarindex) = sny
621     ncvarnrmax(ivarindex) = nr
622     ncvargrd (ivarindex) = 'c'
623 heimbach 1.3 _END_MASTER( mythid )
624     #endif /* ALLOW_KAPGM_CONTROL */
625    
626 heimbach 1.6 c-------------------------------------------------------------------------------------------
627     c--
628 heimbach 1.2 #ifdef ALLOW_TR10_CONTROL
629     _BEGIN_MASTER( mythid )
630 heimbach 1.5 ivarindex = 17
631     ncvarindex(ivarindex) = 117
632     ncvarrecs (ivarindex) = 1
633     ncvarxmax (ivarindex) = snx
634     ncvarymax (ivarindex) = sny
635     ncvarnrmax(ivarindex) = nr
636     ncvargrd (ivarindex) = 'c'
637 heimbach 1.2 _END_MASTER( mythid )
638     #endif /* ALLOW_TR10_CONTROL */
639    
640 heimbach 1.6 c-------------------------------------------------------------------------------------------
641     c--
642     #ifdef ALLOW_SST0_CONTROL
643     _BEGIN_MASTER( mythid )
644     ivarindex = 18
645     ncvarindex(ivarindex) = 118
646     ncvarrecs (ivarindex) = 1
647     ncvarxmax (ivarindex) = snx
648     ncvarymax (ivarindex) = sny
649     ncvarnrmax(ivarindex) = 1
650     ncvargrd (ivarindex) = 'c'
651     _END_MASTER( mythid )
652     #endif /* ALLOW_SST0_CONTROL */
653    
654     c-------------------------------------------------------------------------------------------
655     c--
656     #ifdef ALLOW_SSS0_CONTROL
657     _BEGIN_MASTER( mythid )
658     ivarindex = 19
659     ncvarindex(ivarindex) = 119
660     ncvarrecs (ivarindex) = 1
661     ncvarxmax (ivarindex) = snx
662     ncvarymax (ivarindex) = sny
663     ncvarnrmax(ivarindex) = 1
664     ncvargrd (ivarindex) = 'c'
665     _END_MASTER( mythid )
666     #endif /* ALLOW_SSS0_CONTROL */
667    
668     c-------------------------------------------------------------------------------------------
669     c--
670     #ifdef ALLOW_HFACC_CONTROL
671     _BEGIN_MASTER( mythid )
672     ivarindex = 20
673     ncvarindex(ivarindex) = 120
674     ncvarrecs (ivarindex) = 1
675     ncvarxmax (ivarindex) = snx
676     ncvarymax (ivarindex) = sny
677     ncvargrd (ivarindex) = 'c'
678     #ifdef ALLOW_HFACC3D_CONTROL
679     ncvarnrmax(ivarindex) = nr
680     #else
681     ncvarnrmax(ivarindex) = 1
682     #endif /*ALLOW_HFACC3D_CONTROL*/
683     _END_MASTER( mythid )
684     #endif /* ALLOW_HFACC_CONTROL */
685    
686     c-------------------------------------------------------------------------------------------
687     c--
688 heimbach 1.5 #ifdef ALLOW_EFLUXY0_CONTROL
689 heimbach 1.1 _BEGIN_MASTER( mythid )
690 heimbach 1.5 ivarindex = 21
691     ncvarindex(ivarindex) = 121
692     ncvarrecs(ivarindex) = 1
693     ncvarxmax(ivarindex) = snx
694     ncvarymax(ivarindex) = sny
695     ncvarnrmax(ivarindex) = nr
696     ncvargrd(ivarindex) = 's'
697 heimbach 1.1 _END_MASTER( mythid )
698 heimbach 1.5 #endif /* ALLOW_EFLUXY0_CONTROL */
699    
700 heimbach 1.6 c-------------------------------------------------------------------------------------------
701     c--
702 heimbach 1.5 #ifdef ALLOW_EFLUXP0_CONTROL
703     _BEGIN_MASTER( mythid )
704     ivarindex = 22
705     ncvarindex(ivarindex) = 122
706     ncvarrecs(ivarindex) = 1
707     ncvarxmax(ivarindex) = snx
708     ncvarymax(ivarindex) = sny
709     ncvarnrmax(ivarindex) = nr
710     ncvargrd(ivarindex) = 'v'
711     _END_MASTER( mythid )
712     #endif /* ALLOW_EFLUXP0_CONTROL */
713 heimbach 1.6
714     c-------------------------------------------------------------------------------------------
715     c--
716     #ifdef ALLOW_BOTTOMDRAG_CONTROL
717     _BEGIN_MASTER( mythid )
718     ivarindex = 23
719     ncvarindex(ivarindex) = 123
720     ncvarrecs (ivarindex) = 1
721     ncvarxmax (ivarindex) = snx
722     ncvarymax (ivarindex) = sny
723     ncvarnrmax(ivarindex) = 1
724     ncvargrd (ivarindex) = 'c'
725     _END_MASTER( mythid )
726     #endif /* ALLOW_BOTTOMDRAG_CONTROL */
727    
728     c-------------------------------------------------------------------------------------------
729     c-------------------------------------------------------------------------------------------
730     c-------------------------------------------------------------------------------------------
731 heimbach 1.1
732     c-- Determine the number of wet points in each tile:
733     c-- maskc, masks, and maskw.
734    
735     c-- Set loop ranges.
736     jmin = 1
737     jmax = sny
738     imin = 1
739     imax = snx
740    
741     c-- Initialise the counters.
742     do bj = jtlo,jthi
743     do bi = itlo,ithi
744     do k = 1,nr
745     nwetctile(bi,bj,k) = 0
746     nwetstile(bi,bj,k) = 0
747     nwetwtile(bi,bj,k) = 0
748 heimbach 1.5 nwetvtile(bi,bj,k) = 0
749     enddo
750     enddo
751     enddo
752    
753     #ifdef ALLOW_OBCS_CONTROL
754     c-- Initialise obcs counters.
755     do bj = jtlo,jthi
756     do bi = itlo,ithi
757     do k = 1,nr
758     do iobcs = 1,nobcs
759     #ifdef ALLOW_OBCSN_CONTROL
760     nwetobcsn(bi,bj,k,iobcs) = 0
761     #endif
762     #ifdef ALLOW_OBCSS_CONTROL
763     nwetobcss(bi,bj,k,iobcs) = 0
764     #endif
765     #ifdef ALLOW_OBCSW_CONTROL
766     nwetobcsw(bi,bj,k,iobcs) = 0
767     #endif
768     #ifdef ALLOW_OBCSE_CONTROL
769     nwetobcse(bi,bj,k,iobcs) = 0
770     #endif
771     enddo
772 heimbach 1.1 enddo
773     enddo
774     enddo
775 heimbach 1.5 #endif
776 heimbach 1.1
777     c-- Count wet points on each tile.
778     do bj = jtlo,jthi
779     do bi = itlo,ithi
780     do k = 1,nr
781     do j = jmin,jmax
782     do i = imin,imax
783     c-- Center mask.
784     if (hFacC(i,j,k,bi,bj) .ne. 0.) then
785     nwetctile(bi,bj,k) = nwetctile(bi,bj,k) + 1
786     endif
787     c-- South mask.
788     if (maskS(i,j,k,bi,bj) .eq. 1.) then
789     nwetstile(bi,bj,k) = nwetstile(bi,bj,k) + 1
790     endif
791     c-- West mask.
792     if (maskW(i,j,k,bi,bj) .eq. 1.) then
793     nwetwtile(bi,bj,k) = nwetwtile(bi,bj,k) + 1
794     endif
795 heimbach 1.5 #if (defined (ALLOW_EFLUXP0_CONTROL))
796     c-- Vertical mask.
797     if (hFacV(i,j,k,bi,bj) .ne. 0.) then
798     nwetvtile(bi,bj,k) = nwetvtile(bi,bj,k) + 1
799     endif
800     #endif
801 heimbach 1.1 enddo
802     enddo
803     enddo
804     enddo
805     enddo
806    
807 heimbach 1.5 #ifdef ALLOW_OBCSN_CONTROL
808     c-- Count wet points at Northern boundary.
809     c-- mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
810     ymaskobcs = 'maskobcsn'
811     call ctrl_mask_set_xz(
812     & 0, OB_Jn, nwetobcsn, ymaskobcs, mythid
813     & )
814     #endif
815    
816     #ifdef ALLOW_OBCSS_CONTROL
817     c-- Count wet points at Northern boundary.
818     c-- mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
819     ymaskobcs = 'maskobcss'
820     call ctrl_mask_set_xz(
821     & 1, OB_Js, nwetobcss, ymaskobcs, mythid
822     & )
823     #endif
824    
825     #ifdef ALLOW_OBCSW_CONTROL
826     c-- Count wet points at Northern boundary.
827     c-- mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
828     ymaskobcs = 'maskobcsw'
829     call ctrl_mask_set_yz(
830     & 1, OB_Iw, nwetobcsw, ymaskobcs, mythid
831     & )
832     #endif
833    
834     #ifdef ALLOW_OBCSE_CONTROL
835     c-- Count wet points at Northern boundary.
836     c-- mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
837     ymaskobcs = 'maskobcse'
838     call ctrl_mask_set_yz(
839     & 0, OB_Ie, nwetobcse, ymaskobcs, mythid
840     & )
841     #endif
842 heimbach 1.1
843     _BEGIN_MASTER( mythid )
844     c-- Determine the total number of control variables.
845     nvartype = 0
846     nvarlength = 0
847     do i = 1,maxcvars
848 heimbach 1.5 c
849 heimbach 1.1 if ( ncvarindex(i) .ne. -1 ) then
850     nvartype = nvartype + 1
851     do bj = jtlo,jthi
852     do bi = itlo,ithi
853 heimbach 1.5 do k = 1,ncvarnrmax(i)
854     if ( ncvargrd(i) .eq. 'c' ) then
855 heimbach 1.1 nvarlength = nvarlength +
856     & ncvarrecs(i)*nwetctile(bi,bj,k)
857 heimbach 1.5 else if ( ncvargrd(i) .eq. 's' ) then
858 heimbach 1.1 nvarlength = nvarlength +
859     & ncvarrecs(i)*nwetstile(bi,bj,k)
860 heimbach 1.5 else if ( ncvargrd(i) .eq. 'w' ) then
861 heimbach 1.1 nvarlength = nvarlength +
862     & ncvarrecs(i)*nwetwtile(bi,bj,k)
863 heimbach 1.5 else if ( ncvargrd(i) .eq. 'v' ) then
864     nvarlength = nvarlength +
865     & ncvarrecs(i)*nwetvtile(bi,bj,k)
866     else if ( ncvargrd(i) .eq. 'm' ) then
867     #ifdef ALLOW_OBCS_CONTROL
868     do iobcs = 1, nobcs
869     if ( i .eq. 11 ) then
870     #ifdef ALLOW_OBCSN_CONTROL
871     nvarlength = nvarlength +
872     & (ncvarrecs(i)/nobcs)
873     & *nwetobcsn(bi,bj,k,iobcs)
874     #endif
875     else if ( i .eq. 12 ) then
876     #ifdef ALLOW_OBCSS_CONTROL
877     nvarlength = nvarlength +
878     & (ncvarrecs(i)/nobcs)
879     & *nwetobcss(bi,bj,k,iobcs)
880     #endif
881     else if ( i .eq. 13 ) then
882     #ifdef ALLOW_OBCSW_CONTROL
883     nvarlength = nvarlength +
884     & (ncvarrecs(i)/nobcs)
885     & *nwetobcsw(bi,bj,k,iobcs)
886     #endif
887     else if ( i .eq. 14 ) then
888     #ifdef ALLOW_OBCSE_CONTROL
889     nvarlength = nvarlength +
890     & (ncvarrecs(i)/nobcs)
891     & *nwetobcse(bi,bj,k,iobcs)
892     #endif
893     end if
894     enddo
895     #endif
896     else
897     print*,'ctrl_init: invalid grid location'
898     print*,' control variable = ',ncvarindex(i)
899     print*,' grid location = ',ncvargrd(i)
900     stop ' ... stopped in ctrl_init'
901     endif
902     enddo
903 heimbach 1.1 enddo
904     enddo
905     endif
906     enddo
907 heimbach 1.5
908 heimbach 1.2 cph(
909     print *, 'ph-wet 1: nvarlength = ', nvarlength
910     print *, 'ph-wet 2: surface wet C = ', nwetctile(1,1,1)
911     print *, 'ph-wet 3: surface wet W = ', nwetwtile(1,1,1)
912     print *, 'ph-wet 4: surface wet S = ', nwetstile(1,1,1)
913 heimbach 1.5 print *, 'ph-wet 4a:surface wet V = ', nwetvtile(1,1,1)
914 heimbach 1.2 nwetc3d = 0
915     do k = 1, Nr
916     nwetc3d = nwetc3d + nwetctile(1,1,k)
917     end do
918 heimbach 1.5 print *, 'ph-wet 5: 3D wet points = ', nwetc3d
919     do i = 1, maxcvars
920 heimbach 1.2 print *, 'ph-wet 6: no recs for i = ', i, ncvarrecs(i)
921     end do
922     print *, 'ph-wet 7: ',
923 heimbach 1.5 & 2*nwetc3d +
924 heimbach 1.2 & ncvarrecs(3)*nwetctile(1,1,1) +
925     & ncvarrecs(4)*nwetctile(1,1,1) +
926     & ncvarrecs(5)*nwetwtile(1,1,1) +
927     & ncvarrecs(6)*nwetstile(1,1,1)
928 heimbach 1.5 print *, 'ph-wet 8: ',
929     & 2*nwetc3d +
930     & ncvarrecs(7)*nwetctile(1,1,1) +
931     & ncvarrecs(8)*nwetctile(1,1,1) +
932     & ncvarrecs(9)*nwetwtile(1,1,1) +
933     & ncvarrecs(10)*nwetstile(1,1,1)
934     #ifdef ALLOW_OBCSN_CONTROL
935     print *, 'ph-wet 9: surface wet obcsn = '
936     & , nwetobcsn(1,1,1,1), nwetobcsn(1,1,1,2)
937     & , nwetobcsn(1,1,1,3), nwetobcsn(1,1,1,4)
938     #endif
939     #ifdef ALLOW_OBCSS_CONTROL
940     print *, 'ph-wet 10: surface wet obcss = '
941     & , nwetobcss(1,1,1,1), nwetobcss(1,1,1,2)
942     & , nwetobcss(1,1,1,3), nwetobcss(1,1,1,4)
943     #endif
944     #ifdef ALLOW_OBCSW_CONTROL
945     print *, 'ph-wet 11: surface wet obcsw = '
946     & , nwetobcsw(1,1,1,1), nwetobcsw(1,1,1,2)
947     & , nwetobcsw(1,1,1,3), nwetobcsw(1,1,1,4)
948     #endif
949     #ifdef ALLOW_OBCSE_CONTROL
950     print *, 'ph-wet 12: surface wet obcse = '
951     & , nwetobcse(1,1,1,1), nwetobcse(1,1,1,2)
952     & , nwetobcse(1,1,1,3), nwetobcse(1,1,1,4)
953     #endif
954 heimbach 1.2 cph)
955 heimbach 1.5
956     CALL GLOBAL_SUM_INT( nvarlength, myThid )
957    
958     print *, 'ph-wet 13: global nvarlength vor k=', k, nvarlength
959 heimbach 1.2
960 heimbach 1.1 c
961     c Summation of wet point counters
962     c
963 heimbach 1.5 do k = 1, nr
964    
965 heimbach 1.4 ntmp=0
966     do bj=1,nSy
967     do bi=1,nSx
968     ntmp=ntmp+nWetcTile(bi,bj,k)
969     enddo
970 heimbach 1.1 enddo
971 heimbach 1.4 CALL GLOBAL_SUM_INT( ntmp, myThid )
972 heimbach 1.5 nWetcGlobal(k)=ntmp
973    
974     print *, 'ph-wet 14a: global nWet... vor k=', k, ntmp
975    
976 heimbach 1.4 ntmp=0
977     do bj=1,nSy
978     do bi=1,nSx
979     ntmp=ntmp+nWetsTile(bi,bj,k)
980     enddo
981 heimbach 1.1 enddo
982 heimbach 1.4 CALL GLOBAL_SUM_INT( ntmp, myThid )
983 heimbach 1.5 nWetsGlobal(k)=ntmp
984    
985     print *, 'ph-wet 14b: global nWet... vor k=', k, ntmp
986    
987 heimbach 1.4 ntmp=0
988     do bj=1,nSy
989     do bi=1,nSx
990     ntmp=ntmp+nWetwTile(bi,bj,k)
991     enddo
992 heimbach 1.1 enddo
993 heimbach 1.4 CALL GLOBAL_SUM_INT( ntmp, myThid )
994 heimbach 1.5 nWetwGlobal(k)=ntmp
995    
996     print *, 'ph-wet 14c: global nWet... vor k=', k, ntmp
997    
998     ntmp=0
999     do bj=1,nSy
1000     do bi=1,nSx
1001     ntmp=ntmp+nWetvTile(bi,bj,k)
1002     enddo
1003     enddo
1004     CALL GLOBAL_SUM_INT( ntmp, myThid )
1005     nWetvGlobal(k)=ntmp
1006    
1007     print *, 'ph-wet 14d: global nWet... vor k=', k, ntmp
1008    
1009     #ifdef ALLOW_OBCSN_CONTROL
1010     do iobcs = 1, nobcs
1011     ntmp=0
1012     do bj=1,nSy
1013     do bi=1,nSx
1014     ntmp=ntmp+nwetobcsn(bi,bj,k,iobcs)
1015     enddo
1016     enddo
1017     CALL GLOBAL_SUM_INT( ntmp, myThid )
1018     nwetobcsnglo(k,iobcs)=ntmp
1019     enddo
1020     #endif
1021     #ifdef ALLOW_OBCSS_CONTROL
1022     do iobcs = 1, nobcs
1023     ntmp=0
1024     do bj=1,nSy
1025     do bi=1,nSx
1026     ntmp=ntmp+nwetobcss(bi,bj,k,iobcs)
1027     enddo
1028     enddo
1029     CALL GLOBAL_SUM_INT( ntmp, myThid )
1030     nwetobcssglo(k,iobcs)=ntmp
1031     enddo
1032     #endif
1033     #ifdef ALLOW_OBCSW_CONTROL
1034     do iobcs = 1, nobcs
1035     ntmp=0
1036     do bj=1,nSy
1037     do bi=1,nSx
1038     ntmp=ntmp+nwetobcsw(bi,bj,k,iobcs)
1039     enddo
1040     enddo
1041     CALL GLOBAL_SUM_INT( ntmp, myThid )
1042     nwetobcswglo(k,iobcs)=ntmp
1043     enddo
1044     #endif
1045     #ifdef ALLOW_OBCSE_CONTROL
1046     do iobcs = 1, nobcs
1047     ntmp=0
1048     do bj=1,nSy
1049     do bi=1,nSx
1050     ntmp=ntmp+nwetobcse(bi,bj,k,iobcs)
1051     enddo
1052     enddo
1053     CALL GLOBAL_SUM_INT( ntmp, myThid )
1054     nwetobcseglo(k,iobcs)=ntmp
1055     enddo
1056     #endif
1057    
1058 heimbach 1.1 enddo
1059    
1060     print*, 'ctrl_init: no. of control variables: ', nvartype
1061     print*, 'ctrl_init: control vector length: ', nvarlength
1062 heimbach 1.5 _END_MASTER( mythid )
1063    
1064     c write masks and weights to files to be read by a master process
1065     c
1066     call active_write_xyz( 'hFacC', hFacC, 1, 0, mythid, dummy)
1067     call active_write_xyz( 'maskW', maskW, 1, 0, mythid, dummy)
1068     call active_write_xyz( 'maskS', maskS, 1, 0, mythid, dummy)
1069     #if (defined (ALLOW_EFLUXP0_CONTROL))
1070     call active_write_xyz( 'hFacV', hFacV, 1, 0, mythid, dummy)
1071     #endif
1072    
1073     c-- Summarize the control vector's setup.
1074     _BEGIN_MASTER( mythid )
1075     cph call ctrl_Summary( mythid )
1076 heimbach 1.1 _END_MASTER( mythid )
1077    
1078     _BARRIER
1079    
1080     return
1081     end
1082    

  ViewVC Help
Powered by ViewVC 1.1.22