/[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.24 - (hide annotations) (download)
Wed Oct 14 20:10:13 2009 UTC (14 years, 6 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62t, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62, checkpoint62b, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.23: +26 -1 lines
Gradient checks for xx_gen2d, xx_gen3d

1 heimbach 1.24 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getadxx.F,v 1.23 2008/06/11 19:31:41 gforget Exp $
2 jmc 1.20 C $Name: $
3 heimbach 1.2
4     #include "CTRL_CPPOPTIONS.h"
5    
6    
7     subroutine grdchk_getadxx(
8     I icvrec,
9     I itile,
10     I jtile,
11     I layer,
12     I itilepos,
13     I jtilepos,
14 heimbach 1.7 I xx_comp,
15 heimbach 1.2 I mythid
16     & )
17    
18     c ==================================================================
19     c SUBROUTINE grdchk_getadxx
20     c ==================================================================
21     c
22     c o Set component a component of the control vector; xx(loc)
23     c
24     c started: Christian Eckert eckert@mit.edu 08-Mar-2000
25     c continued: heimbach@mit.edu: 13-Jun-2001
26     c
27     c ==================================================================
28     c SUBROUTINE grdchk_getadxx
29     c ==================================================================
30    
31     implicit none
32    
33     c == global variables ==
34    
35     #include "EEPARAMS.h"
36     #include "SIZE.h"
37     #include "ctrl.h"
38     #include "optim.h"
39     #include "grdchk.h"
40    
41     c == routine arguments ==
42    
43     integer icvrec
44     integer jtile
45     integer itile
46     integer layer
47     integer itilepos
48     integer jtilepos
49 heimbach 1.7 _RL xx_comp
50 heimbach 1.2 integer mythid
51    
52 heimbach 1.10 #ifdef ALLOW_GRDCHK
53 heimbach 1.2 c == local variables ==
54    
55     integer il
56     integer dumiter
57     _RL dumtime
58     _RL dummy
59    
60     logical doglobalread
61     logical ladinit
62    
63     character*(80) fname
64    
65 heimbach 1.9 integer i,j,k
66    
67 heimbach 1.2 c-- == external ==
68    
69     integer ilnblnk
70     external ilnblnk
71    
72     c-- == end of interface ==
73    
74     doglobalread = .false.
75     ladinit = .false.
76     dumiter = 0
77     dumtime = 0. _d 0
78    
79 heimbach 1.4 if ( grdchkvarindex .eq. 0 ) then
80     STOP 'GRDCHK INDEX 0 NOT ALLOWED'
81    
82 heimbach 1.2 #ifdef ALLOW_THETA0_CONTROL
83 heimbach 1.4 else if ( grdchkvarindex .eq. 1 ) then
84 heimbach 1.2 il=ilnblnk( xx_theta_file )
85     write(fname(1:80),'(80a)') ' '
86     write(fname(1:80),'(3a,i10.10)')
87 heimbach 1.7 & yadmark, xx_theta_file(1:il),'.',optimcycle
88 heimbach 1.2
89 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
90 heimbach 1.2 & doglobalread, ladinit, optimcycle,
91     & mythid, dummy)
92 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
93 heimbach 1.2 #endif /* ALLOW_THETA0_CONTROL */
94    
95     #ifdef ALLOW_SALT0_CONTROL
96     else if ( grdchkvarindex .eq. 2 ) then
97     il=ilnblnk( xx_salt_file )
98     write(fname(1:80),'(80a)') ' '
99     write(fname(1:80),'(3a,i10.10)')
100 heimbach 1.7 & yadmark, xx_salt_file(1:il),'.',optimcycle
101 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
102 heimbach 1.2 & doglobalread, ladinit, optimcycle,
103     & mythid, dummy)
104 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
105 heimbach 1.2
106     #endif /* ALLOW_SALT0_CONTROL */
107    
108     #ifdef ALLOW_HFLUX_CONTROL
109     else if ( grdchkvarindex .eq. 3 ) then
110     il=ilnblnk( xx_hflux_file )
111     write(fname(1:80),'(80a)') ' '
112     write(fname(1:80),'(3a,i10.10)')
113 heimbach 1.7 & yadmark, xx_hflux_file(1:il),'.',optimcycle
114 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
115 heimbach 1.2 & doglobalread, ladinit, optimcycle,
116     & mythid, dummy)
117 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
118 heimbach 1.2 #endif /* ALLOW_HFLUX_CONTROL */
119    
120     #ifdef ALLOW_SFLUX_CONTROL
121     else if ( grdchkvarindex .eq. 4 ) then
122     il=ilnblnk( xx_sflux_file )
123     write(fname(1:80),'(80a)') ' '
124     write(fname(1:80),'(3a,i10.10)')
125 heimbach 1.7 & yadmark, xx_sflux_file(1:il),'.',optimcycle
126 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
127 heimbach 1.2 & doglobalread, ladinit, optimcycle,
128     & mythid, dummy)
129 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
130 heimbach 1.2 #endif /* ALLOW_SFLUX_CONTROL */
131    
132     #ifdef ALLOW_USTRESS_CONTROL
133     else if ( grdchkvarindex .eq. 5 ) then
134     il=ilnblnk( xx_tauu_file )
135     write(fname(1:80),'(80a)') ' '
136     write(fname(1:80),'(3a,i10.10)')
137 heimbach 1.7 & yadmark, xx_tauu_file(1:il),'.',optimcycle
138 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
139 heimbach 1.2 & doglobalread, ladinit, optimcycle,
140     & mythid, dummy)
141 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
142 heimbach 1.2 #endif /* ALLOW_USTRESS_CONTROL */
143    
144     #ifdef ALLOW_VSTRESS_CONTROL
145     else if ( grdchkvarindex .eq. 6 ) then
146     il=ilnblnk( xx_tauv_file )
147     write(fname(1:80),'(80a)') ' '
148     write(fname(1:80),'(3a,i10.10)')
149 heimbach 1.7 & yadmark, xx_tauv_file(1:il),'.',optimcycle
150 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
151 heimbach 1.2 & doglobalread, ladinit, optimcycle,
152     & mythid, dummy)
153 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
154 heimbach 1.2 #endif /* ALLOW_VSTRESS_CONTROL */
155    
156 heimbach 1.7 #ifdef ALLOW_ATEMP_CONTROL
157     else if ( grdchkvarindex .eq. 7 ) then
158     il=ilnblnk( xx_atemp_file )
159     write(fname(1:80),'(80a)') ' '
160     write(fname(1:80),'(3a,i10.10)')
161     & yadmark, xx_atemp_file(1:il),'.',optimcycle
162 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
163 heimbach 1.7 & doglobalread, ladinit, optimcycle,
164     & mythid, dummy)
165     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
166     #endif /* ALLOW_ATEMP_CONTROL */
167    
168     #ifdef ALLOW_AQH_CONTROL
169     else if ( grdchkvarindex .eq. 8 ) then
170     il=ilnblnk( xx_aqh_file )
171     write(fname(1:80),'(80a)') ' '
172     write(fname(1:80),'(3a,i10.10)')
173     & yadmark, xx_aqh_file(1:il),'.',optimcycle
174 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
175 heimbach 1.7 & doglobalread, ladinit, optimcycle,
176     & mythid, dummy)
177     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
178     #endif /* ALLOW_AQH_CONTROL */
179    
180     #ifdef ALLOW_UWIND_CONTROL
181     else if ( grdchkvarindex .eq. 9 ) then
182     il=ilnblnk( xx_uwind_file )
183     write(fname(1:80),'(80a)') ' '
184     write(fname(1:80),'(3a,i10.10)')
185     & yadmark, xx_uwind_file(1:il),'.',optimcycle
186 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
187 heimbach 1.7 & doglobalread, ladinit, optimcycle,
188     & mythid, dummy)
189     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
190     #endif /* ALLOW_UWIND_CONTROL */
191    
192     #ifdef ALLOW_VWIND_CONTROL
193     else if ( grdchkvarindex .eq. 10 ) then
194     il=ilnblnk( xx_vwind_file )
195     write(fname(1:80),'(80a)') ' '
196     write(fname(1:80),'(3a,i10.10)')
197     & yadmark, xx_vwind_file(1:il),'.',optimcycle
198 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
199 heimbach 1.7 & doglobalread, ladinit, optimcycle,
200     & mythid, dummy)
201     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
202     #endif /* ALLOW_VWIND_CONTROL */
203 heimbach 1.8
204     #ifdef ALLOW_OBCSN_CONTROL
205     else if ( grdchkvarindex .eq. 11 ) then
206     il=ilnblnk( xx_obcsn_file )
207     write(fname(1:80),'(80a)') ' '
208     write(fname(1:80),'(3a,i10.10)')
209     & yadmark, xx_obcsn_file(1:il),'.',optimcycle
210    
211 heimbach 1.18 call active_read_xz( fname, tmpfldxz, icvrec,
212 heimbach 1.8 & doglobalread, ladinit, optimcycle,
213     & mythid, dummy)
214    
215     xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
216    
217     #endif /* ALLOW_OBCSN_CONTROL */
218    
219     #ifdef ALLOW_OBCSS_CONTROL
220     else if ( grdchkvarindex .eq. 12 ) then
221     il=ilnblnk( xx_obcss_file )
222     write(fname(1:80),'(80a)') ' '
223     write(fname(1:80),'(3a,i10.10)')
224     & yadmark, xx_obcss_file(1:il),'.',optimcycle
225    
226 heimbach 1.18 call active_read_xz( fname, tmpfldxz, icvrec,
227 heimbach 1.8 & doglobalread, ladinit, optimcycle,
228     & mythid, dummy)
229    
230     xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
231    
232     #endif /* ALLOW_OBCSS_CONTROL */
233    
234     #ifdef ALLOW_OBCSW_CONTROL
235     else if ( grdchkvarindex .eq. 13 ) then
236     il=ilnblnk( xx_obcsw_file )
237     write(fname(1:80),'(80a)') ' '
238     write(fname(1:80),'(3a,i10.10)')
239     & yadmark, xx_obcsw_file(1:il),'.',optimcycle
240    
241 heimbach 1.18 call active_read_yz( fname, tmpfldyz, icvrec,
242 heimbach 1.8 & doglobalread, ladinit, optimcycle,
243     & mythid, dummy)
244    
245     xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
246    
247     #endif /* ALLOW_OBCSW_CONTROL */
248    
249     #ifdef ALLOW_OBCSE_CONTROL
250     else if ( grdchkvarindex .eq. 14 ) then
251     il=ilnblnk( xx_obcse_file )
252     write(fname(1:80),'(80a)') ' '
253     write(fname(1:80),'(3a,i10.10)')
254     & yadmark, xx_obcse_file(1:il),'.',optimcycle
255    
256 heimbach 1.18 call active_read_yz( fname, tmpfldyz, icvrec,
257 heimbach 1.8 & doglobalread, ladinit, optimcycle,
258     & mythid, dummy)
259    
260     xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
261    
262     #endif /* ALLOW_OBCSE_CONTROL */
263 heimbach 1.7
264 heimbach 1.15 #ifdef ALLOW_DIFFKR_CONTROL
265     else if ( grdchkvarindex .eq. 15 ) then
266     il=ilnblnk( xx_diffkr_file )
267     write(fname(1:80),'(80a)') ' '
268     write(fname(1:80),'(3a,i10.10)')
269     & yadmark, xx_diffkr_file(1:il),'.',optimcycle
270    
271 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
272 heimbach 1.15 & doglobalread, ladinit, optimcycle,
273     & mythid, dummy)
274    
275     xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
276    
277     #endif /* ALLOW_DIFFKR_CONTROL */
278    
279     #ifdef ALLOW_KAPGM_CONTROL
280     else if ( grdchkvarindex .eq. 16 ) then
281     il=ilnblnk( xx_kapgm_file )
282     write(fname(1:80),'(80a)') ' '
283     write(fname(1:80),'(3a,i10.10)')
284     & yadmark, xx_kapgm_file(1:il),'.',optimcycle
285    
286 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
287 heimbach 1.15 & doglobalread, ladinit, optimcycle,
288     & mythid, dummy)
289    
290     xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
291    
292     #endif /* ALLOW_KAPGM_CONTROL */
293    
294 gforget 1.22 #ifdef ALLOW_KAPREDI_CONTROL
295     else if ( grdchkvarindex .eq. 16 ) then
296     il=ilnblnk( xx_kapredi_file )
297     write(fname(1:80),'(80a)') ' '
298     write(fname(1:80),'(3a,i10.10)')
299     & yadmark, xx_kapredi_file(1:il),'.',optimcycle
300    
301     call active_read_xyz( fname, tmpfld3d, 1,
302     & doglobalread, ladinit, optimcycle,
303     & mythid, dummy)
304    
305     xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
306    
307     #endif /* ALLOW_KAPREDI_CONTROL */
308    
309 heimbach 1.12 #ifdef ALLOW_TR10_CONTROL
310 heimbach 1.2 else if ( grdchkvarindex .eq. 17 ) then
311 heimbach 1.12 il=ilnblnk( xx_tr1_file )
312 heimbach 1.2 write(fname(1:80),'(80a)') ' '
313     write(fname(1:80),'(3a,i10.10)')
314 heimbach 1.12 & yadmark, xx_tr1_file(1:il),'.',optimcycle
315 jmc 1.20
316 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
317 heimbach 1.12 & doglobalread, ladinit, optimcycle,
318     & mythid, dummy)
319 heimbach 1.11
320 heimbach 1.12 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
321 heimbach 1.2
322 heimbach 1.12 #endif /* ALLOW_TR10_CONTROL */
323 heimbach 1.2
324 heimbach 1.14 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
325 heimbach 1.2 else if ( grdchkvarindex .eq. 18 ) then
326     il=ilnblnk( xx_sst_file )
327     write(fname(1:80),'(80a)') ' '
328     write(fname(1:80),'(3a,i10.10)')
329 heimbach 1.7 & yadmark, xx_sst_file(1:il),'.',optimcycle
330 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
331 heimbach 1.2 & doglobalread, ladinit, optimcycle,
332     & mythid, dummy)
333 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
334 heimbach 1.2 #endif /* ALLOW_SST0_CONTROL */
335    
336 heimbach 1.14 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
337 heimbach 1.2 else if ( grdchkvarindex .eq. 19 ) then
338     il=ilnblnk( xx_sss_file )
339     write(fname(1:80),'(80a)') ' '
340     write(fname(1:80),'(3a,i10.10)')
341 heimbach 1.7 & yadmark, xx_sss_file(1:il),'.',optimcycle
342 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
343 heimbach 1.2 & doglobalread, ladinit, optimcycle,
344     & mythid, dummy)
345 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
346 heimbach 1.2 #endif /* ALLOW_SSS0_CONTROL */
347 heimbach 1.3
348 heimbach 1.16 #ifdef ALLOW_DEPTH_CONTROL
349 heimbach 1.3 else if ( grdchkvarindex .eq. 20 ) then
350 heimbach 1.16 il=ilnblnk( xx_depth_file )
351 heimbach 1.3 write(fname(1:80),'(80a)') ' '
352     write(fname(1:80),'(3a,i10.10)')
353 heimbach 1.16 & yadmark, xx_depth_file(1:il),'.',optimcycle
354 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
355 heimbach 1.3 & doglobalread, ladinit, optimcycle,
356     & mythid, dummy)
357 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
358 heimbach 1.16 #endif /* ALLOW_DEPTH_CONTROL */
359 heimbach 1.4
360     #ifdef ALLOW_EFLUXY0_CONTROL
361     else if ( grdchkvarindex .eq. 21 ) then
362     il=ilnblnk( xx_efluxy_file )
363     write(fname(1:80),'(80a)') ' '
364     write(fname(1:80),'(3a,i10.10)')
365 heimbach 1.7 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
366 heimbach 1.4
367 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
368 heimbach 1.4 & doglobalread, ladinit, optimcycle,
369     & mythid, dummy)
370    
371 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
372 heimbach 1.4
373     #endif /* ALLOW_EFLUXY0_CONTROL */
374    
375     #ifdef ALLOW_EFLUXP0_CONTROL
376     else if ( grdchkvarindex .eq. 22 ) then
377     il=ilnblnk( xx_efluxp_file )
378     write(fname(1:80),'(80a)') ' '
379     write(fname(1:80),'(3a,i10.10)')
380 heimbach 1.7 & yadmark, xx_efluxp_file(1:il),'.',optimcycle
381 heimbach 1.4
382 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
383 heimbach 1.4 & doglobalread, ladinit, optimcycle,
384     & mythid, dummy)
385    
386 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
387 heimbach 1.4
388     #endif /* ALLOW_EFLUXP0_CONTROL */
389 heimbach 1.2
390 dfer 1.21 #ifdef ALLOW_HFLUXM_CONTROL
391     else if ( grdchkvarindex .eq. 24 ) then
392     il=ilnblnk( xx_hfluxm_file )
393     write(fname(1:80),'(80a)') ' '
394     write(fname(1:80),'(3a,i10.10)')
395     & yadmark, xx_hfluxm_file(1:il),'.',optimcycle
396     call active_read_xy( fname, tmpfld2d, icvrec,
397     & doglobalread, ladinit, optimcycle,
398     & mythid, dummy)
399     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
400     #endif /* ALLOW_HFLUXM_CONTROL */
401    
402 heimbach 1.24 #ifdef ALLOW_GEN2D_CONTROL
403     else if ( grdchkvarindex .eq. 30 ) then
404     il=ilnblnk( xx_gen2d_file )
405     write(fname(1:80),'(80a)') ' '
406     write(fname(1:80),'(3a,i10.10)')
407     & yadmark, xx_gen2d_file(1:il),'.',optimcycle
408     call active_read_xy( fname, tmpfld2d, icvrec,
409     & doglobalread, ladinit, optimcycle,
410     & mythid, dummy)
411     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
412     #endif /* ALLOW_GEN2D_CONTROL */
413    
414     #ifdef ALLOW_GEN3D_CONTROL
415     else if ( grdchkvarindex .eq. 31 ) then
416     il=ilnblnk( xx_gen3d_file )
417     write(fname(1:80),'(80a)') ' '
418     write(fname(1:80),'(3a,i10.10)')
419     & yadmark, xx_gen3d_file(1:il),'.',optimcycle
420    
421     call active_read_xyz( fname, tmpfld3d, 1,
422     & doglobalread, ladinit, optimcycle,
423     & mythid, dummy)
424     xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
425     #endif /* ALLOW_GEN3D_CONTROL */
426    
427 heimbach 1.12 #ifdef ALLOW_PRECIP_CONTROL
428 heimbach 1.11 else if ( grdchkvarindex .eq. 32 ) then
429 heimbach 1.12 il=ilnblnk( xx_precip_file )
430     write(fname(1:80),'(80a)') ' '
431     write(fname(1:80),'(3a,i10.10)')
432     & yadmark, xx_precip_file(1:il),'.',optimcycle
433 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
434 heimbach 1.12 & doglobalread, ladinit, optimcycle,
435     & mythid, dummy)
436     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
437     #endif /* ALLOW_PRECIP_CONTROL */
438    
439     #ifdef ALLOW_SWFLUX_CONTROL
440     else if ( grdchkvarindex .eq. 33 ) then
441     il=ilnblnk( xx_swflux_file )
442 heimbach 1.11 write(fname(1:80),'(80a)') ' '
443     write(fname(1:80),'(3a,i10.10)')
444 heimbach 1.12 & yadmark, xx_swflux_file(1:il),'.',optimcycle
445 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
446 heimbach 1.12 & doglobalread, ladinit, optimcycle,
447     & mythid, dummy)
448     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
449     #endif /* ALLOW_SWFLUX_CONTROL */
450 heimbach 1.11
451 heimbach 1.13 #ifdef ALLOW_SWDOWN_CONTROL
452     else if ( grdchkvarindex .eq. 34 ) then
453     il=ilnblnk( xx_swdown_file )
454     write(fname(1:80),'(80a)') ' '
455     write(fname(1:80),'(3a,i10.10)')
456     & yadmark, xx_swdown_file(1:il),'.',optimcycle
457 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
458 heimbach 1.17 & doglobalread, ladinit, optimcycle,
459     & mythid, dummy)
460     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
461     #endif /* ALLOW_SWDOWN_CONTROL */
462    
463     #ifdef ALLOW_LWFLUX_CONTROL
464     else if ( grdchkvarindex .eq. 35 ) then
465     il=ilnblnk( xx_lwflux_file )
466     write(fname(1:80),'(80a)') ' '
467     write(fname(1:80),'(3a,i10.10)')
468     & yadmark, xx_lwflux_file(1:il),'.',optimcycle
469 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
470 heimbach 1.17 & doglobalread, ladinit, optimcycle,
471     & mythid, dummy)
472     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
473     #endif /* ALLOW_LWFLUX_CONTROL */
474    
475     #ifdef ALLOW_LWDOWN_CONTROL
476     else if ( grdchkvarindex .eq. 36 ) then
477     il=ilnblnk( xx_lwdown_file )
478     write(fname(1:80),'(80a)') ' '
479     write(fname(1:80),'(3a,i10.10)')
480     & yadmark, xx_lwdown_file(1:il),'.',optimcycle
481 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
482 heimbach 1.17 & doglobalread, ladinit, optimcycle,
483     & mythid, dummy)
484     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
485     #endif /* ALLOW_LWDOWN_CONTROL */
486    
487     #ifdef ALLOW_EVAP_CONTROL
488     else if ( grdchkvarindex .eq. 37 ) then
489     il=ilnblnk( xx_evap_file )
490     write(fname(1:80),'(80a)') ' '
491     write(fname(1:80),'(3a,i10.10)')
492     & yadmark, xx_evap_file(1:il),'.',optimcycle
493 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
494 heimbach 1.17 & doglobalread, ladinit, optimcycle,
495     & mythid, dummy)
496     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
497     #endif /* ALLOW_EVAP_CONTROL */
498 heimbach 1.13
499 heimbach 1.17 #ifdef ALLOW_SNOWPRECIP_CONTROL
500     else if ( grdchkvarindex .eq. 38 ) then
501     il=ilnblnk( xx_snowprecip_file )
502     write(fname(1:80),'(80a)') ' '
503     write(fname(1:80),'(3a,i10.10)')
504     & yadmark, xx_snowprecip_file(1:il),'.',optimcycle
505 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
506 heimbach 1.13 & doglobalread, ladinit, optimcycle,
507     & mythid, dummy)
508 heimbach 1.17 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
509     #endif /* ALLOW_SNOWPRECIP_CONTROL */
510    
511     #ifdef ALLOW_APRESSURE_CONTROL
512     else if ( grdchkvarindex .eq. 39 ) then
513     il=ilnblnk( xx_apressure_file )
514     write(fname(1:80),'(80a)') ' '
515     write(fname(1:80),'(3a,i10.10)')
516     & yadmark, xx_apressure_file(1:il),'.',optimcycle
517 heimbach 1.13
518 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
519 heimbach 1.17 & doglobalread, ladinit, optimcycle,
520     & mythid, dummy)
521 heimbach 1.13 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
522 heimbach 1.17 #endif /* ALLOW_APRESSURE_CONTROL */
523 heimbach 1.13
524 heimbach 1.17 #ifdef ALLOW_RUNOFF_CONTROL
525     else if ( grdchkvarindex .eq. 40 ) then
526     il=ilnblnk( xx_runoff_file )
527     write(fname(1:80),'(80a)') ' '
528     write(fname(1:80),'(3a,i10.10)')
529     & yadmark, xx_runoff_file(1:il),'.',optimcycle
530 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
531 heimbach 1.17 & doglobalread, ladinit, optimcycle,
532     & mythid, dummy)
533     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
534     #endif /* ALLOW_RUNOFF_CONTROL */
535 heimbach 1.13
536 heimbach 1.19 #ifdef ALLOW_SIAREA_CONTROL
537     else if ( grdchkvarindex .eq. 41 ) then
538     il=ilnblnk( xx_siarea_file )
539     write(fname(1:80),'(80a)') ' '
540     write(fname(1:80),'(3a,i10.10)')
541     & yadmark, xx_siarea_file(1:il),'.',optimcycle
542     call active_read_xy( fname, tmpfld2d, icvrec,
543     & doglobalread, ladinit, optimcycle,
544     & mythid, dummy)
545     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
546     #endif /* ALLOW_SIAREA_CONTROL */
547    
548     #ifdef ALLOW_SIHEFF_CONTROL
549     else if ( grdchkvarindex .eq. 42 ) then
550     il=ilnblnk( xx_siheff_file )
551     write(fname(1:80),'(80a)') ' '
552     write(fname(1:80),'(3a,i10.10)')
553     & yadmark, xx_siheff_file(1:il),'.',optimcycle
554     call active_read_xy( fname, tmpfld2d, icvrec,
555     & doglobalread, ladinit, optimcycle,
556     & mythid, dummy)
557     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
558     #endif /* ALLOW_SIHEFF_CONTROL */
559    
560     #ifdef ALLOW_SIHSNOW_CONTROL
561     else if ( grdchkvarindex .eq. 43 ) then
562     il=ilnblnk( xx_sihsnow_file )
563     write(fname(1:80),'(80a)') ' '
564     write(fname(1:80),'(3a,i10.10)')
565     & yadmark, xx_sihsnow_file(1:il),'.',optimcycle
566     call active_read_xy( fname, tmpfld2d, icvrec,
567     & doglobalread, ladinit, optimcycle,
568     & mythid, dummy)
569     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
570     #endif /* ALLOW_SIHSNOW_CONTROL */
571    
572 gforget 1.23 #ifdef ALLOW_ETAN0_CONTROL
573     else if ( grdchkvarindex .eq. 29 ) then
574     il=ilnblnk( xx_etan_file )
575     write(fname(1:80),'(80a)') ' '
576     write(fname(1:80),'(3a,i10.10)')
577     & yadmark, xx_etan_file(1:il),'.',optimcycle
578     call active_read_xy( fname, tmpfld2d, 1,
579     & doglobalread, ladinit, optimcycle,
580     & mythid, dummy)
581     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
582     #endif /* ALLOW_ETAN0_CONTROL */
583    
584 heimbach 1.2 else
585     ce --> this index does not exist yet.
586     endif
587    
588 heimbach 1.10 #endif /* ALLOW_GRDCHK */
589 heimbach 1.2
590     end
591    

  ViewVC Help
Powered by ViewVC 1.1.22