/[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.4 - (hide annotations) (download)
Sun Mar 24 02:13:45 2002 UTC (22 years, 2 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint45d_post, checkpoint45a_post, checkpoint45b_post, checkpoint45c_post, checkpoint44h_post, checkpoint45
Changes since 1.3: +24 -22 lines
Bug fix for K loop.

1 heimbach 1.4 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_init.F,v 1.3 2001/08/13 18:10:26 heimbach Exp $
2 heimbach 1.1
3     #include "CTRL_CPPOPTIONS.h"
4    
5    
6     subroutine ctrl_Init(
7     I mythid
8     & )
9    
10     c ==================================================================
11     c SUBROUTINE ctrl_Init
12     c ==================================================================
13     c
14     c o Set parts of the vector of control variables and initialize the
15     c rest to zero.
16     c
17     c The vector of control variables is initialized here. The
18     c temperature and salinity contributions are read from file.
19     c Subsequently, the latter are dimensionalized and the tile
20     c edges are updated.
21     c
22     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
23     c
24     c changed: Christian Eckert eckert@mit.edu 23-Feb-2000
25     c - Restructured the code in order to create a package
26     c for the MITgcmUV.
27     c
28     c Patrick Heimbach heimbach@mit.edu 30-May-2000
29     c - diffsec was falsely declared.
30     c
31     c Patrick Heimbach heimbach@mit.edu 06-Jun-2000
32     c - Transferred some filename declarations
33     c from ctrl_pack/ctrl_unpack to here
34     c - Transferred mask-per-tile to here
35     c - computation of control vector length here
36     c
37     c Patrick Heimbach heimbach@mit.edu 16-Jun-2000
38     c - Added call to ctrl_pack
39     c - Alternatively: transfer writing of scale files to
40     c ctrl_unpack
41     c
42     c ==================================================================
43     c SUBROUTINE ctrl_Init
44     c ==================================================================
45    
46     implicit none
47    
48     c == global variables ==
49    
50     #include "EEPARAMS.h"
51     #include "SIZE.h"
52     #include "PARAMS.h"
53     #include "GRID.h"
54     #include "ctrl.h"
55    
56     c == routine arguments ==
57    
58     integer mythid
59    
60     c == local variables ==
61    
62     integer bi,bj
63     integer i,j,k
64     integer itlo,ithi
65     integer jtlo,jthi
66     integer jmin,jmax
67     integer imin,imax
68     integer ntmp
69    
70     integer il
71     integer errio
72     integer startrec
73     integer endrec
74    
75 heimbach 1.2 _RL nwetc3d
76    
77 heimbach 1.1 character*(max_len_prec) record
78     character*(max_len_mbuf) msgbuf
79    
80     c == external ==
81    
82     integer ilnblnk
83     external ilnblnk
84    
85     c == end of interface ==
86    
87     c-- Read the namelist input.
88     namelist /ctrl_nml/
89     & xx_theta_file,
90     & xx_salt_file,
91 heimbach 1.2 & xx_tr1_file,
92 heimbach 1.1 & xx_tauu_file,
93     & xx_tauv_file,
94     & xx_sflux_file,
95     & xx_hflux_file,
96     & xx_sss_file,
97     & xx_sst_file,
98     & xx_diffkr_file,
99     & xx_kapgm_file
100    
101     namelist /ctrl_packnames/
102     & yadmark, expId,
103     & ctrlname, costname, scalname, maskname, metaname
104    
105     jtlo = mybylo(mythid)
106     jthi = mybyhi(mythid)
107     itlo = mybxlo(mythid)
108     ithi = mybxhi(mythid)
109     jmin = 1-oly
110     jmax = sny+oly
111     imin = 1-olx
112     imax = snx+olx
113    
114     _BEGIN_MASTER( myThid )
115    
116     c-- Set default values.
117     xx_theta_file = ' '
118     xx_salt_file = ' '
119 heimbach 1.2 xx_tr1_file = ' '
120 heimbach 1.1 xx_tauu_file = ' '
121     xx_tauv_file = ' '
122     xx_sflux_file = ' '
123     xx_hflux_file = ' '
124     xx_sss_file = ' '
125     xx_sst_file = ' '
126     xx_diffkr_file = ' '
127     xx_kapgm_file = ' '
128     yadmark = 'ad'
129     expId = ' '
130     ctrlname = ' '
131     costname = ' '
132     scalname = ' '
133     maskname = ' '
134     metaname = ' '
135    
136     c-- Check versions.
137    
138     open(unit=scrunit1,status='scratch')
139    
140     c-- Next, read the ecco data file.
141     open(unit = modeldataunit,file = 'data.ctrl',
142     & status = 'old', iostat = errio)
143     if ( errio .lt. 0 ) then
144     stop ' stopped in ctrl_init'
145     endif
146    
147     do while ( .true. )
148     read(modeldataunit, fmt='(a)', end=1001) record
149     il = max(ilnblnk(record),1)
150     if ( record(1:1) .ne. commentcharacter )
151     & write(unit=scrunit1, fmt='(a)') record(:il)
152     enddo
153     1001 continue
154     close( modeldataunit )
155    
156     rewind( scrunit1 )
157     read(unit = scrunit1, nml = ctrl_nml)
158     read(unit = scrunit1, nml = ctrl_packnames)
159     close( scrunit1 )
160    
161     c-- Set default values.
162     do i = 1,maxcvars
163     ncvarindex(i) = -1
164     ncvarrecs(i) = 0
165     ncvarxmax(i) = 0
166     ncvarymax(i) = 0
167     ncvarnrmax(i) = 0
168     ncvargrd(i) = '?'
169     enddo
170    
171     write(msgbuf,'(a)') ' '
172     call print_message( msgbuf, standardmessageunit,
173     & SQUEEZE_RIGHT , mythid)
174     write(msgbuf,'(a)')
175     & ' ctrl_init: Initializing temperature and salinity'
176     call print_message( msgbuf, standardmessageunit,
177     & SQUEEZE_RIGHT , mythid)
178     write(msgbuf,'(a)')
179     & ' part of the control vector.'
180     call print_message( msgbuf, standardmessageunit,
181     & SQUEEZE_RIGHT , mythid)
182     write(msgbuf,'(a,a)')
183     & ' The initial surface fluxes are set',
184     & ' to zero.'
185     call print_message( msgbuf, standardmessageunit,
186     & SQUEEZE_RIGHT , mythid)
187     write(msgbuf,'(a)') ' '
188     call print_message( msgbuf, standardmessageunit,
189     & SQUEEZE_RIGHT , mythid)
190     _END_MASTER( mythid )
191    
192     _BARRIER
193    
194     c-- =====================
195     c-- Initial state fields.
196     c-- =====================
197    
198     #ifdef ALLOW_THETA0_CONTROL
199     _BEGIN_MASTER( mythid )
200     ncvarindex(1) = 101
201     ncvarrecs(1) = 1
202     ncvarxmax(1) = snx
203     ncvarymax(1) = sny
204     ncvarnrmax(1) = nr
205     ncvargrd(1) = 'c'
206     _END_MASTER( mythid )
207     #endif /* ALLOW_THETA0_CONTROL */
208    
209     #ifdef ALLOW_SALT0_CONTROL
210     _BEGIN_MASTER( mythid )
211     ncvarindex(2) = 102
212     ncvarrecs(2) = 1
213     ncvarxmax(2) = snx
214     ncvarymax(2) = sny
215     ncvarnrmax(2) = nr
216     ncvargrd(2) = 'c'
217     _END_MASTER( mythid )
218     #endif /* ALLOW_SALT0_CONTROL */
219    
220     #ifdef ALLOW_HFLUX0_CONTROL
221     _BEGIN_MASTER( mythid )
222     ncvarindex(3) = 103
223     ncvarrecs(3) = 1
224     ncvarxmax(3) = snx
225     ncvarymax(3) = sny
226     ncvarnrmax(3) = 1
227     ncvargrd(3) = 'c'
228     _END_MASTER( mythid )
229     #endif /* ALLOW_HFLUX0_CONTROL */
230    
231     #ifdef ALLOW_SFLUX0_CONTROL
232     _BEGIN_MASTER( mythid )
233     ncvarindex(4) = 104
234     ncvarrecs(4) = 1
235     ncvarxmax(4) = snx
236     ncvarymax(4) = sny
237     ncvarnrmax(4) = 1
238     ncvargrd(4) = 'c'
239     _END_MASTER( mythid )
240     #endif /* ALLOW_SFLUX0_CONTROL */
241    
242     #ifdef ALLOW_TAUU0_CONTROL
243     _BEGIN_MASTER( mythid )
244     ncvarindex(5) = 105
245     ncvarrecs(5) = 1
246     ncvarxmax(5) = snx
247     ncvarymax(5) = sny
248     ncvarnrmax(5) = 1
249     ncvargrd(5) = 'w'
250     _END_MASTER( mythid )
251     #endif /* ALLOW_TAUU0_CONTROL */
252    
253     #ifdef ALLOW_TAUV0_CONTROL
254     _BEGIN_MASTER( mythid )
255     ncvarindex(6) = 106
256     ncvarrecs(6) = 1
257     ncvarxmax(6) = snx
258     ncvarymax(6) = sny
259     ncvarnrmax(6) = 1
260     ncvargrd(6) = 's'
261     _END_MASTER( mythid )
262     #endif /* ALLOW_TAUV0_CONTROL */
263    
264 heimbach 1.2 cph(
265     cph index 7-10 reserved for atmos. state,
266     cph index 11-14 reserved for open boundaries,
267     cph index 15-16 reserved for mixing coeff.
268     cph index 17 reserved for passive tracer TR1
269     cph index 18,19 reserved for sst, sss
270     cph)
271    
272 heimbach 1.3 #ifdef ALLOW_DIFFKR_CONTROL
273     _BEGIN_MASTER( mythid )
274     ncvarindex(15) = 115
275     ncvarrecs (15) = 1
276     ncvarxmax (15) = snx
277     ncvarymax (15) = sny
278     ncvarnrmax(15) = nr
279     ncvargrd (15) = 'c'
280     _END_MASTER( mythid )
281     #endif /* ALLOW_DIFFKR_CONTROL */
282    
283     #ifdef ALLOW_KAPGM_CONTROL
284     _BEGIN_MASTER( mythid )
285     ncvarindex(16) = 116
286     ncvarrecs (16) = 1
287     ncvarxmax (16) = snx
288     ncvarymax (16) = sny
289     ncvarnrmax(16) = nr
290     ncvargrd (16) = 'c'
291     _END_MASTER( mythid )
292     #endif /* ALLOW_KAPGM_CONTROL */
293    
294 heimbach 1.2 #ifdef ALLOW_TR10_CONTROL
295     _BEGIN_MASTER( mythid )
296     ncvarindex(17) = 117
297 heimbach 1.3 ncvarrecs (17) = 1
298     ncvarxmax (17) = snx
299     ncvarymax (17) = sny
300 heimbach 1.2 ncvarnrmax(17) = nr
301 heimbach 1.3 ncvargrd (17) = 'c'
302 heimbach 1.2 _END_MASTER( mythid )
303     #endif /* ALLOW_TR10_CONTROL */
304    
305 heimbach 1.1 #ifdef ALLOW_SST0_CONTROL
306     _BEGIN_MASTER( mythid )
307 heimbach 1.2 ncvarindex(18) = 118
308 heimbach 1.3 ncvarrecs (18) = 1
309     ncvarxmax (18) = snx
310     ncvarymax (18) = sny
311 heimbach 1.2 ncvarnrmax(18) = 1
312 heimbach 1.3 ncvargrd (18) = 'c'
313 heimbach 1.1 _END_MASTER( mythid )
314     #endif /* ALLOW_SST0_CONTROL */
315    
316     #ifdef ALLOW_SSS0_CONTROL
317     _BEGIN_MASTER( mythid )
318 heimbach 1.2 ncvarindex(19) = 119
319 heimbach 1.3 ncvarrecs (19) = 1
320     ncvarxmax (19) = snx
321     ncvarymax (19) = sny
322 heimbach 1.2 ncvarnrmax(19) = 1
323 heimbach 1.3 ncvargrd (19) = 'c'
324 heimbach 1.1 _END_MASTER( mythid )
325     #endif /* ALLOW_SSS0_CONTROL */
326    
327     c-- Determine the number of wet points in each tile:
328     c-- maskc, masks, and maskw.
329    
330     c-- Set loop ranges.
331     jmin = 1
332     jmax = sny
333     imin = 1
334     imax = snx
335    
336     c-- Initialise the counters.
337     do bj = jtlo,jthi
338     do bi = itlo,ithi
339     do k = 1,nr
340     nwetctile(bi,bj,k) = 0
341     nwetstile(bi,bj,k) = 0
342     nwetwtile(bi,bj,k) = 0
343     enddo
344     enddo
345     enddo
346    
347     c-- Count wet points on each tile.
348     do bj = jtlo,jthi
349     do bi = itlo,ithi
350     do k = 1,nr
351     do j = jmin,jmax
352     do i = imin,imax
353     c-- Center mask.
354     if (hFacC(i,j,k,bi,bj) .ne. 0.) then
355     nwetctile(bi,bj,k) = nwetctile(bi,bj,k) + 1
356     endif
357     c-- South mask.
358     if (maskS(i,j,k,bi,bj) .eq. 1.) then
359     nwetstile(bi,bj,k) = nwetstile(bi,bj,k) + 1
360     endif
361     c-- West mask.
362     if (maskW(i,j,k,bi,bj) .eq. 1.) then
363     nwetwtile(bi,bj,k) = nwetwtile(bi,bj,k) + 1
364     endif
365     enddo
366     enddo
367     enddo
368     enddo
369     enddo
370    
371    
372     _BEGIN_MASTER( mythid )
373     c-- Determine the total number of control variables.
374     nvartype = 0
375     nvarlength = 0
376     do i = 1,maxcvars
377     if ( ncvarindex(i) .ne. -1 ) then
378     nvartype = nvartype + 1
379     do bj = jtlo,jthi
380     do bi = itlo,ithi
381     if ( ncvargrd(i) .eq. 'c' ) then
382     do k = 1,ncvarnrmax(i)
383     nvarlength = nvarlength +
384     & ncvarrecs(i)*nwetctile(bi,bj,k)
385     enddo
386     else if ( ncvargrd(i) .eq. 's' ) then
387     do k = 1,ncvarnrmax(i)
388     nvarlength = nvarlength +
389     & ncvarrecs(i)*nwetstile(bi,bj,k)
390     enddo
391     else if ( ncvargrd(i) .eq. 'w' ) then
392     do k = 1,ncvarnrmax(i)
393     nvarlength = nvarlength +
394     & ncvarrecs(i)*nwetwtile(bi,bj,k)
395     enddo
396     else
397     print*,'ctrl_init: invalid grid location'
398     print*,' control variable = ',ncvarindex(i)
399     print*,' grid location = ',ncvargrd(i)
400     stop ' ... stopped in ctrl_init'
401     endif
402     enddo
403     enddo
404     endif
405     enddo
406    
407 heimbach 1.2 cph(
408     print *, 'ph-wet 1: nvarlength = ', nvarlength
409     print *, 'ph-wet 2: surface wet C = ', nwetctile(1,1,1)
410     print *, 'ph-wet 3: surface wet W = ', nwetwtile(1,1,1)
411     print *, 'ph-wet 4: surface wet S = ', nwetstile(1,1,1)
412     nwetc3d = 0
413     do k = 1, Nr
414     nwetc3d = nwetc3d + nwetctile(1,1,k)
415     end do
416     print *, 'ph-wet 5: 3D center wet points = ', nwetc3d
417     do i = 1, 6
418     print *, 'ph-wet 6: no recs for i = ', i, ncvarrecs(i)
419     end do
420     print *, 'ph-wet 7: ',
421     & 2*nwetc3d +
422     & ncvarrecs(3)*nwetctile(1,1,1) +
423     & ncvarrecs(4)*nwetctile(1,1,1) +
424     & ncvarrecs(5)*nwetwtile(1,1,1) +
425     & ncvarrecs(6)*nwetstile(1,1,1)
426     cph)
427    
428 heimbach 1.1 c
429     c Summation of wet point counters
430     c
431 heimbach 1.4 do k = 1, Nr
432     CALL GLOBAL_SUM_INT( nvarlength, myThid )
433     ntmp=0
434     do bj=1,nSy
435     do bi=1,nSx
436     ntmp=ntmp+nWetcTile(bi,bj,k)
437     enddo
438 heimbach 1.1 enddo
439 heimbach 1.4 CALL GLOBAL_SUM_INT( ntmp, myThid )
440     nWetcTile(1,1,k)=ntmp
441     ntmp=0
442     do bj=1,nSy
443     do bi=1,nSx
444     ntmp=ntmp+nWetsTile(bi,bj,k)
445     enddo
446 heimbach 1.1 enddo
447 heimbach 1.4 CALL GLOBAL_SUM_INT( ntmp, myThid )
448     nWetsTile(1,1,k)=ntmp
449     ntmp=0
450     do bj=1,nSy
451     do bi=1,nSx
452     ntmp=ntmp+nWetwTile(bi,bj,k)
453     enddo
454 heimbach 1.1 enddo
455 heimbach 1.4 CALL GLOBAL_SUM_INT( ntmp, myThid )
456     nWetwTile(1,1,k)=ntmp
457 heimbach 1.1 enddo
458    
459     print*, 'ctrl_init: no. of control variables: ', nvartype
460     print*, 'ctrl_init: control vector length: ', nvarlength
461     _END_MASTER( mythid )
462    
463     _BARRIER
464    
465     return
466     end
467    

  ViewVC Help
Powered by ViewVC 1.1.22