/[MITgcm]/MITgcm/pkg/grdchk/grdchk_getadxx.F
ViewVC logotype

Annotation of /MITgcm/pkg/grdchk/grdchk_getadxx.F

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


Revision 1.16 - (hide annotations) (download)
Wed Jun 7 01:55:14 2006 UTC (17 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint58m_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58n_post, checkpoint58k_post, checkpoint58l_post, checkpoint58h_post, checkpoint58j_post, checkpoint58i_post
Changes since 1.15: +5 -16 lines
Modifications for bottom topography control
o replace hFacC by _hFacC at various places
o replace ALLOW_HFACC_CONTROL by ALLOW_DEPTH_CONTROL
o add non-self-adjoint cg2d_nsa
o update autodiff support routines
o re-initialise hfac after ctrl_depth_ini
o works for 5x5 box, doesnt work for global_ocean.90x40x15

1 heimbach 1.16 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getadxx.F,v 1.15 2006/05/12 02:17:03 heimbach Exp $
2 heimbach 1.2
3     #include "CTRL_CPPOPTIONS.h"
4    
5    
6     subroutine grdchk_getadxx(
7     I icvrec,
8     I itile,
9     I jtile,
10     I layer,
11     I itilepos,
12     I jtilepos,
13 heimbach 1.7 I xx_comp,
14 heimbach 1.2 I mythid
15     & )
16    
17     c ==================================================================
18     c SUBROUTINE grdchk_getadxx
19     c ==================================================================
20     c
21     c o Set component a component of the control vector; xx(loc)
22     c
23     c started: Christian Eckert eckert@mit.edu 08-Mar-2000
24     c continued: heimbach@mit.edu: 13-Jun-2001
25     c
26     c ==================================================================
27     c SUBROUTINE grdchk_getadxx
28     c ==================================================================
29    
30     implicit none
31    
32     c == global variables ==
33    
34     #include "EEPARAMS.h"
35     #include "SIZE.h"
36     #include "ctrl.h"
37     #include "optim.h"
38     #include "grdchk.h"
39    
40     c == routine arguments ==
41    
42     integer icvrec
43     integer jtile
44     integer itile
45     integer layer
46     integer itilepos
47     integer jtilepos
48 heimbach 1.7 _RL xx_comp
49 heimbach 1.2 integer mythid
50    
51 heimbach 1.10 #ifdef ALLOW_GRDCHK
52 heimbach 1.2 c == local variables ==
53    
54     integer il
55     integer dumiter
56     _RL dumtime
57     _RL dummy
58    
59     logical doglobalread
60     logical ladinit
61    
62     character*(80) fname
63    
64 heimbach 1.9 integer i,j,k
65    
66 heimbach 1.2 c-- == external ==
67    
68     integer ilnblnk
69     external ilnblnk
70    
71     c-- == end of interface ==
72    
73     doglobalread = .false.
74     ladinit = .false.
75     dumiter = 0
76     dumtime = 0. _d 0
77    
78 heimbach 1.4 if ( grdchkvarindex .eq. 0 ) then
79     STOP 'GRDCHK INDEX 0 NOT ALLOWED'
80    
81 heimbach 1.2 #ifdef ALLOW_THETA0_CONTROL
82 heimbach 1.4 else if ( grdchkvarindex .eq. 1 ) then
83 heimbach 1.2 il=ilnblnk( xx_theta_file )
84     write(fname(1:80),'(80a)') ' '
85     write(fname(1:80),'(3a,i10.10)')
86 heimbach 1.7 & yadmark, xx_theta_file(1:il),'.',optimcycle
87 heimbach 1.2
88 heimbach 1.9 call active_read_xyz_loc( fname, tmpfld3d, 1,
89 heimbach 1.2 & doglobalread, ladinit, optimcycle,
90     & mythid, dummy)
91    
92 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
93 heimbach 1.2
94     #endif /* ALLOW_THETA0_CONTROL */
95    
96     #ifdef ALLOW_SALT0_CONTROL
97     else if ( grdchkvarindex .eq. 2 ) then
98     il=ilnblnk( xx_salt_file )
99     write(fname(1:80),'(80a)') ' '
100     write(fname(1:80),'(3a,i10.10)')
101 heimbach 1.7 & yadmark, xx_salt_file(1:il),'.',optimcycle
102 heimbach 1.2
103 heimbach 1.9 call active_read_xyz_loc( fname, tmpfld3d, 1,
104 heimbach 1.2 & doglobalread, ladinit, optimcycle,
105     & mythid, dummy)
106    
107 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
108 heimbach 1.2
109     #endif /* ALLOW_SALT0_CONTROL */
110    
111     #ifdef ALLOW_HFLUX_CONTROL
112     else if ( grdchkvarindex .eq. 3 ) then
113     il=ilnblnk( xx_hflux_file )
114     write(fname(1:80),'(80a)') ' '
115     write(fname(1:80),'(3a,i10.10)')
116 heimbach 1.7 & yadmark, xx_hflux_file(1:il),'.',optimcycle
117 heimbach 1.2
118 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
119 heimbach 1.2 & doglobalread, ladinit, optimcycle,
120     & mythid, dummy)
121    
122 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
123 heimbach 1.2
124     #endif /* ALLOW_HFLUX_CONTROL */
125    
126     #ifdef ALLOW_SFLUX_CONTROL
127     else if ( grdchkvarindex .eq. 4 ) then
128     il=ilnblnk( xx_sflux_file )
129     write(fname(1:80),'(80a)') ' '
130     write(fname(1:80),'(3a,i10.10)')
131 heimbach 1.7 & yadmark, xx_sflux_file(1:il),'.',optimcycle
132 heimbach 1.2
133 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
134 heimbach 1.2 & doglobalread, ladinit, optimcycle,
135     & mythid, dummy)
136    
137 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
138 heimbach 1.2
139     #endif /* ALLOW_SFLUX_CONTROL */
140    
141     #ifdef ALLOW_USTRESS_CONTROL
142     else if ( grdchkvarindex .eq. 5 ) then
143     il=ilnblnk( xx_tauu_file )
144     write(fname(1:80),'(80a)') ' '
145     write(fname(1:80),'(3a,i10.10)')
146 heimbach 1.7 & yadmark, xx_tauu_file(1:il),'.',optimcycle
147 heimbach 1.2
148 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
149 heimbach 1.2 & doglobalread, ladinit, optimcycle,
150     & mythid, dummy)
151    
152 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
153 heimbach 1.2
154     #endif /* ALLOW_USTRESS_CONTROL */
155    
156     #ifdef ALLOW_VSTRESS_CONTROL
157     else if ( grdchkvarindex .eq. 6 ) then
158     il=ilnblnk( xx_tauv_file )
159     write(fname(1:80),'(80a)') ' '
160     write(fname(1:80),'(3a,i10.10)')
161 heimbach 1.7 & yadmark, xx_tauv_file(1:il),'.',optimcycle
162 heimbach 1.2
163 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
164 heimbach 1.2 & doglobalread, ladinit, optimcycle,
165     & mythid, dummy)
166    
167 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
168 heimbach 1.2
169     #endif /* ALLOW_VSTRESS_CONTROL */
170    
171 heimbach 1.7 #ifdef ALLOW_ATEMP_CONTROL
172     else if ( grdchkvarindex .eq. 7 ) then
173     il=ilnblnk( xx_atemp_file )
174     write(fname(1:80),'(80a)') ' '
175     write(fname(1:80),'(3a,i10.10)')
176     & yadmark, xx_atemp_file(1:il),'.',optimcycle
177    
178 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
179 heimbach 1.7 & doglobalread, ladinit, optimcycle,
180     & mythid, dummy)
181    
182     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
183    
184     #endif /* ALLOW_ATEMP_CONTROL */
185    
186     #ifdef ALLOW_AQH_CONTROL
187     else if ( grdchkvarindex .eq. 8 ) then
188     il=ilnblnk( xx_aqh_file )
189     write(fname(1:80),'(80a)') ' '
190     write(fname(1:80),'(3a,i10.10)')
191     & yadmark, xx_aqh_file(1:il),'.',optimcycle
192    
193 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
194 heimbach 1.7 & doglobalread, ladinit, optimcycle,
195     & mythid, dummy)
196    
197     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
198    
199     #endif /* ALLOW_AQH_CONTROL */
200    
201     #ifdef ALLOW_UWIND_CONTROL
202     else if ( grdchkvarindex .eq. 9 ) then
203     il=ilnblnk( xx_uwind_file )
204     write(fname(1:80),'(80a)') ' '
205     write(fname(1:80),'(3a,i10.10)')
206     & yadmark, xx_uwind_file(1:il),'.',optimcycle
207    
208 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
209 heimbach 1.7 & doglobalread, ladinit, optimcycle,
210     & mythid, dummy)
211    
212     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
213    
214     #endif /* ALLOW_UWIND_CONTROL */
215    
216     #ifdef ALLOW_VWIND_CONTROL
217     else if ( grdchkvarindex .eq. 10 ) then
218     il=ilnblnk( xx_vwind_file )
219     write(fname(1:80),'(80a)') ' '
220     write(fname(1:80),'(3a,i10.10)')
221     & yadmark, xx_vwind_file(1:il),'.',optimcycle
222    
223 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
224 heimbach 1.7 & doglobalread, ladinit, optimcycle,
225     & mythid, dummy)
226    
227     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
228    
229     #endif /* ALLOW_VWIND_CONTROL */
230 heimbach 1.8
231     #ifdef ALLOW_OBCSN_CONTROL
232     else if ( grdchkvarindex .eq. 11 ) then
233     il=ilnblnk( xx_obcsn_file )
234     write(fname(1:80),'(80a)') ' '
235     write(fname(1:80),'(3a,i10.10)')
236     & yadmark, xx_obcsn_file(1:il),'.',optimcycle
237    
238 heimbach 1.9 call active_read_xz_loc( fname, tmpfldxz, icvrec,
239 heimbach 1.8 & doglobalread, ladinit, optimcycle,
240     & mythid, dummy)
241    
242     xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
243    
244     #endif /* ALLOW_OBCSN_CONTROL */
245    
246     #ifdef ALLOW_OBCSS_CONTROL
247     else if ( grdchkvarindex .eq. 12 ) then
248     il=ilnblnk( xx_obcss_file )
249     write(fname(1:80),'(80a)') ' '
250     write(fname(1:80),'(3a,i10.10)')
251     & yadmark, xx_obcss_file(1:il),'.',optimcycle
252    
253 heimbach 1.9 call active_read_xz_loc( fname, tmpfldxz, icvrec,
254 heimbach 1.8 & doglobalread, ladinit, optimcycle,
255     & mythid, dummy)
256    
257     xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
258    
259     #endif /* ALLOW_OBCSS_CONTROL */
260    
261     #ifdef ALLOW_OBCSW_CONTROL
262     else if ( grdchkvarindex .eq. 13 ) then
263     il=ilnblnk( xx_obcsw_file )
264     write(fname(1:80),'(80a)') ' '
265     write(fname(1:80),'(3a,i10.10)')
266     & yadmark, xx_obcsw_file(1:il),'.',optimcycle
267    
268 heimbach 1.9 call active_read_yz_loc( fname, tmpfldyz, icvrec,
269 heimbach 1.8 & doglobalread, ladinit, optimcycle,
270     & mythid, dummy)
271    
272     xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
273    
274     #endif /* ALLOW_OBCSW_CONTROL */
275    
276     #ifdef ALLOW_OBCSE_CONTROL
277     else if ( grdchkvarindex .eq. 14 ) then
278     il=ilnblnk( xx_obcse_file )
279     write(fname(1:80),'(80a)') ' '
280     write(fname(1:80),'(3a,i10.10)')
281     & yadmark, xx_obcse_file(1:il),'.',optimcycle
282    
283 heimbach 1.9 call active_read_yz_loc( fname, tmpfldyz, icvrec,
284 heimbach 1.8 & doglobalread, ladinit, optimcycle,
285     & mythid, dummy)
286    
287     xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
288    
289     #endif /* ALLOW_OBCSE_CONTROL */
290 heimbach 1.7
291 heimbach 1.15 #ifdef ALLOW_DIFFKR_CONTROL
292     else if ( grdchkvarindex .eq. 15 ) then
293     il=ilnblnk( xx_diffkr_file )
294     write(fname(1:80),'(80a)') ' '
295     write(fname(1:80),'(3a,i10.10)')
296     & yadmark, xx_diffkr_file(1:il),'.',optimcycle
297    
298     call active_read_xyz_loc( fname, tmpfld3d, 1,
299     & doglobalread, ladinit, optimcycle,
300     & mythid, dummy)
301    
302     xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
303    
304     #endif /* ALLOW_DIFFKR_CONTROL */
305    
306     #ifdef ALLOW_KAPGM_CONTROL
307     else if ( grdchkvarindex .eq. 16 ) then
308     il=ilnblnk( xx_kapgm_file )
309     write(fname(1:80),'(80a)') ' '
310     write(fname(1:80),'(3a,i10.10)')
311     & yadmark, xx_kapgm_file(1:il),'.',optimcycle
312    
313     call active_read_xyz_loc( fname, tmpfld3d, 1,
314     & doglobalread, ladinit, optimcycle,
315     & mythid, dummy)
316    
317     xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
318    
319     #endif /* ALLOW_KAPGM_CONTROL */
320    
321 heimbach 1.12 #ifdef ALLOW_TR10_CONTROL
322 heimbach 1.2 else if ( grdchkvarindex .eq. 17 ) then
323 heimbach 1.12 il=ilnblnk( xx_tr1_file )
324 heimbach 1.2 write(fname(1:80),'(80a)') ' '
325     write(fname(1:80),'(3a,i10.10)')
326 heimbach 1.12 & yadmark, xx_tr1_file(1:il),'.',optimcycle
327    
328     call active_read_xyz_loc( fname, tmpfld3d, 1,
329     & doglobalread, ladinit, optimcycle,
330     & mythid, dummy)
331 heimbach 1.11
332 heimbach 1.12 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
333 heimbach 1.2
334 heimbach 1.12 #endif /* ALLOW_TR10_CONTROL */
335 heimbach 1.2
336 heimbach 1.14 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
337 heimbach 1.2 else if ( grdchkvarindex .eq. 18 ) then
338     il=ilnblnk( xx_sst_file )
339     write(fname(1:80),'(80a)') ' '
340     write(fname(1:80),'(3a,i10.10)')
341 heimbach 1.7 & yadmark, xx_sst_file(1:il),'.',optimcycle
342 heimbach 1.2
343 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
344 heimbach 1.2 & doglobalread, ladinit, optimcycle,
345     & mythid, dummy)
346    
347 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
348 heimbach 1.2
349     #endif /* ALLOW_SST0_CONTROL */
350    
351 heimbach 1.14 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
352 heimbach 1.2 else if ( grdchkvarindex .eq. 19 ) then
353     il=ilnblnk( xx_sss_file )
354     write(fname(1:80),'(80a)') ' '
355     write(fname(1:80),'(3a,i10.10)')
356 heimbach 1.7 & yadmark, xx_sss_file(1:il),'.',optimcycle
357 heimbach 1.2
358 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
359 heimbach 1.2 & doglobalread, ladinit, optimcycle,
360     & mythid, dummy)
361    
362 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
363 heimbach 1.2
364     #endif /* ALLOW_SSS0_CONTROL */
365 heimbach 1.3
366 heimbach 1.16 #ifdef ALLOW_DEPTH_CONTROL
367 heimbach 1.3 else if ( grdchkvarindex .eq. 20 ) then
368 heimbach 1.16 il=ilnblnk( xx_depth_file )
369 heimbach 1.3 write(fname(1:80),'(80a)') ' '
370     write(fname(1:80),'(3a,i10.10)')
371 heimbach 1.16 & yadmark, xx_depth_file(1:il),'.',optimcycle
372 heimbach 1.3
373 heimbach 1.9 call active_read_xy_loc( fname, tmpfld2d, icvrec,
374 heimbach 1.3 & doglobalread, ladinit, optimcycle,
375     & mythid, dummy)
376    
377 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
378 heimbach 1.3
379 heimbach 1.16 #endif /* ALLOW_DEPTH_CONTROL */
380 heimbach 1.4
381     #ifdef ALLOW_EFLUXY0_CONTROL
382     else if ( grdchkvarindex .eq. 21 ) then
383     il=ilnblnk( xx_efluxy_file )
384     write(fname(1:80),'(80a)') ' '
385     write(fname(1:80),'(3a,i10.10)')
386 heimbach 1.7 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
387 heimbach 1.4
388 heimbach 1.9 call active_read_xyz_loc( fname, tmpfld3d, 1,
389 heimbach 1.4 & doglobalread, ladinit, optimcycle,
390     & mythid, dummy)
391    
392 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
393 heimbach 1.4
394     #endif /* ALLOW_EFLUXY0_CONTROL */
395    
396     #ifdef ALLOW_EFLUXP0_CONTROL
397     else if ( grdchkvarindex .eq. 22 ) then
398     il=ilnblnk( xx_efluxp_file )
399     write(fname(1:80),'(80a)') ' '
400     write(fname(1:80),'(3a,i10.10)')
401 heimbach 1.7 & yadmark, xx_efluxp_file(1:il),'.',optimcycle
402 heimbach 1.4
403 heimbach 1.9 call active_read_xyz_loc( fname, tmpfld3d, 1,
404 heimbach 1.4 & doglobalread, ladinit, optimcycle,
405     & mythid, dummy)
406    
407 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
408 heimbach 1.4
409     #endif /* ALLOW_EFLUXP0_CONTROL */
410 heimbach 1.2
411 heimbach 1.12 #ifdef ALLOW_PRECIP_CONTROL
412 heimbach 1.11 else if ( grdchkvarindex .eq. 32 ) then
413 heimbach 1.12 il=ilnblnk( xx_precip_file )
414     write(fname(1:80),'(80a)') ' '
415     write(fname(1:80),'(3a,i10.10)')
416     & yadmark, xx_precip_file(1:il),'.',optimcycle
417    
418     call active_read_xy_loc( fname, tmpfld2d, icvrec,
419     & doglobalread, ladinit, optimcycle,
420     & mythid, dummy)
421    
422     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
423    
424     #endif /* ALLOW_PRECIP_CONTROL */
425    
426     #ifdef ALLOW_SWFLUX_CONTROL
427     else if ( grdchkvarindex .eq. 33 ) then
428     il=ilnblnk( xx_swflux_file )
429 heimbach 1.11 write(fname(1:80),'(80a)') ' '
430     write(fname(1:80),'(3a,i10.10)')
431 heimbach 1.12 & yadmark, xx_swflux_file(1:il),'.',optimcycle
432    
433     call active_read_xy_loc( fname, tmpfld2d, icvrec,
434     & doglobalread, ladinit, optimcycle,
435     & mythid, dummy)
436 heimbach 1.11
437 heimbach 1.12 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
438 heimbach 1.11
439 heimbach 1.12 #endif /* ALLOW_SWFLUX_CONTROL */
440 heimbach 1.11
441 heimbach 1.13 #ifdef ALLOW_SWDOWN_CONTROL
442     else if ( grdchkvarindex .eq. 34 ) then
443     il=ilnblnk( xx_swdown_file )
444     write(fname(1:80),'(80a)') ' '
445     write(fname(1:80),'(3a,i10.10)')
446     & yadmark, xx_swdown_file(1:il),'.',optimcycle
447    
448     call active_read_xy_loc( fname, tmpfld2d, icvrec,
449     & doglobalread, ladinit, optimcycle,
450     & mythid, dummy)
451    
452     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
453    
454     #endif /* ALLOW_SWDOWN_CONTROL */
455    
456 heimbach 1.2 else
457     ce --> this index does not exist yet.
458     endif
459    
460 heimbach 1.10 #endif /* ALLOW_GRDCHK */
461 heimbach 1.2
462     end
463    

  ViewVC Help
Powered by ViewVC 1.1.22