/[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.20 - (hide annotations) (download)
Tue Oct 9 00:05:45 2007 UTC (16 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59k, checkpoint59j
Changes since 1.19: +3 -2 lines
add missing cvs $Header:$ or $Name:$

1 jmc 1.20 C $Header: $
2     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 heimbach 1.12 #ifdef ALLOW_TR10_CONTROL
295 heimbach 1.2 else if ( grdchkvarindex .eq. 17 ) then
296 heimbach 1.12 il=ilnblnk( xx_tr1_file )
297 heimbach 1.2 write(fname(1:80),'(80a)') ' '
298     write(fname(1:80),'(3a,i10.10)')
299 heimbach 1.12 & yadmark, xx_tr1_file(1:il),'.',optimcycle
300 jmc 1.20
301 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
302 heimbach 1.12 & doglobalread, ladinit, optimcycle,
303     & mythid, dummy)
304 heimbach 1.11
305 heimbach 1.12 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
306 heimbach 1.2
307 heimbach 1.12 #endif /* ALLOW_TR10_CONTROL */
308 heimbach 1.2
309 heimbach 1.14 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
310 heimbach 1.2 else if ( grdchkvarindex .eq. 18 ) then
311     il=ilnblnk( xx_sst_file )
312     write(fname(1:80),'(80a)') ' '
313     write(fname(1:80),'(3a,i10.10)')
314 heimbach 1.7 & yadmark, xx_sst_file(1:il),'.',optimcycle
315 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
316 heimbach 1.2 & doglobalread, ladinit, optimcycle,
317     & mythid, dummy)
318 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
319 heimbach 1.2 #endif /* ALLOW_SST0_CONTROL */
320    
321 heimbach 1.14 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
322 heimbach 1.2 else if ( grdchkvarindex .eq. 19 ) then
323     il=ilnblnk( xx_sss_file )
324     write(fname(1:80),'(80a)') ' '
325     write(fname(1:80),'(3a,i10.10)')
326 heimbach 1.7 & yadmark, xx_sss_file(1:il),'.',optimcycle
327 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
328 heimbach 1.2 & doglobalread, ladinit, optimcycle,
329     & mythid, dummy)
330 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
331 heimbach 1.2 #endif /* ALLOW_SSS0_CONTROL */
332 heimbach 1.3
333 heimbach 1.16 #ifdef ALLOW_DEPTH_CONTROL
334 heimbach 1.3 else if ( grdchkvarindex .eq. 20 ) then
335 heimbach 1.16 il=ilnblnk( xx_depth_file )
336 heimbach 1.3 write(fname(1:80),'(80a)') ' '
337     write(fname(1:80),'(3a,i10.10)')
338 heimbach 1.16 & yadmark, xx_depth_file(1:il),'.',optimcycle
339 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
340 heimbach 1.3 & doglobalread, ladinit, optimcycle,
341     & mythid, dummy)
342 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
343 heimbach 1.16 #endif /* ALLOW_DEPTH_CONTROL */
344 heimbach 1.4
345     #ifdef ALLOW_EFLUXY0_CONTROL
346     else if ( grdchkvarindex .eq. 21 ) then
347     il=ilnblnk( xx_efluxy_file )
348     write(fname(1:80),'(80a)') ' '
349     write(fname(1:80),'(3a,i10.10)')
350 heimbach 1.7 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
351 heimbach 1.4
352 heimbach 1.18 call active_read_xyz( fname, tmpfld3d, 1,
353 heimbach 1.4 & doglobalread, ladinit, optimcycle,
354     & mythid, dummy)
355    
356 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
357 heimbach 1.4
358     #endif /* ALLOW_EFLUXY0_CONTROL */
359    
360     #ifdef ALLOW_EFLUXP0_CONTROL
361     else if ( grdchkvarindex .eq. 22 ) then
362     il=ilnblnk( xx_efluxp_file )
363     write(fname(1:80),'(80a)') ' '
364     write(fname(1:80),'(3a,i10.10)')
365 heimbach 1.7 & yadmark, xx_efluxp_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_EFLUXP0_CONTROL */
374 heimbach 1.2
375 heimbach 1.12 #ifdef ALLOW_PRECIP_CONTROL
376 heimbach 1.11 else if ( grdchkvarindex .eq. 32 ) then
377 heimbach 1.12 il=ilnblnk( xx_precip_file )
378     write(fname(1:80),'(80a)') ' '
379     write(fname(1:80),'(3a,i10.10)')
380     & yadmark, xx_precip_file(1:il),'.',optimcycle
381 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
382 heimbach 1.12 & doglobalread, ladinit, optimcycle,
383     & mythid, dummy)
384     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
385     #endif /* ALLOW_PRECIP_CONTROL */
386    
387     #ifdef ALLOW_SWFLUX_CONTROL
388     else if ( grdchkvarindex .eq. 33 ) then
389     il=ilnblnk( xx_swflux_file )
390 heimbach 1.11 write(fname(1:80),'(80a)') ' '
391     write(fname(1:80),'(3a,i10.10)')
392 heimbach 1.12 & yadmark, xx_swflux_file(1:il),'.',optimcycle
393 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
394 heimbach 1.12 & doglobalread, ladinit, optimcycle,
395     & mythid, dummy)
396     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
397     #endif /* ALLOW_SWFLUX_CONTROL */
398 heimbach 1.11
399 heimbach 1.13 #ifdef ALLOW_SWDOWN_CONTROL
400     else if ( grdchkvarindex .eq. 34 ) then
401     il=ilnblnk( xx_swdown_file )
402     write(fname(1:80),'(80a)') ' '
403     write(fname(1:80),'(3a,i10.10)')
404     & yadmark, xx_swdown_file(1:il),'.',optimcycle
405 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
406 heimbach 1.17 & doglobalread, ladinit, optimcycle,
407     & mythid, dummy)
408     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
409     #endif /* ALLOW_SWDOWN_CONTROL */
410    
411     #ifdef ALLOW_LWFLUX_CONTROL
412     else if ( grdchkvarindex .eq. 35 ) then
413     il=ilnblnk( xx_lwflux_file )
414     write(fname(1:80),'(80a)') ' '
415     write(fname(1:80),'(3a,i10.10)')
416     & yadmark, xx_lwflux_file(1:il),'.',optimcycle
417 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
418 heimbach 1.17 & doglobalread, ladinit, optimcycle,
419     & mythid, dummy)
420     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
421     #endif /* ALLOW_LWFLUX_CONTROL */
422    
423     #ifdef ALLOW_LWDOWN_CONTROL
424     else if ( grdchkvarindex .eq. 36 ) then
425     il=ilnblnk( xx_lwdown_file )
426     write(fname(1:80),'(80a)') ' '
427     write(fname(1:80),'(3a,i10.10)')
428     & yadmark, xx_lwdown_file(1:il),'.',optimcycle
429 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
430 heimbach 1.17 & doglobalread, ladinit, optimcycle,
431     & mythid, dummy)
432     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
433     #endif /* ALLOW_LWDOWN_CONTROL */
434    
435     #ifdef ALLOW_EVAP_CONTROL
436     else if ( grdchkvarindex .eq. 37 ) then
437     il=ilnblnk( xx_evap_file )
438     write(fname(1:80),'(80a)') ' '
439     write(fname(1:80),'(3a,i10.10)')
440     & yadmark, xx_evap_file(1:il),'.',optimcycle
441 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
442 heimbach 1.17 & doglobalread, ladinit, optimcycle,
443     & mythid, dummy)
444     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
445     #endif /* ALLOW_EVAP_CONTROL */
446 heimbach 1.13
447 heimbach 1.17 #ifdef ALLOW_SNOWPRECIP_CONTROL
448     else if ( grdchkvarindex .eq. 38 ) then
449     il=ilnblnk( xx_snowprecip_file )
450     write(fname(1:80),'(80a)') ' '
451     write(fname(1:80),'(3a,i10.10)')
452     & yadmark, xx_snowprecip_file(1:il),'.',optimcycle
453 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
454 heimbach 1.13 & doglobalread, ladinit, optimcycle,
455     & mythid, dummy)
456 heimbach 1.17 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
457     #endif /* ALLOW_SNOWPRECIP_CONTROL */
458    
459     #ifdef ALLOW_APRESSURE_CONTROL
460     else if ( grdchkvarindex .eq. 39 ) then
461     il=ilnblnk( xx_apressure_file )
462     write(fname(1:80),'(80a)') ' '
463     write(fname(1:80),'(3a,i10.10)')
464     & yadmark, xx_apressure_file(1:il),'.',optimcycle
465 heimbach 1.13
466 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
467 heimbach 1.17 & doglobalread, ladinit, optimcycle,
468     & mythid, dummy)
469 heimbach 1.13 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
470 heimbach 1.17 #endif /* ALLOW_APRESSURE_CONTROL */
471 heimbach 1.13
472 heimbach 1.17 #ifdef ALLOW_RUNOFF_CONTROL
473     else if ( grdchkvarindex .eq. 40 ) then
474     il=ilnblnk( xx_runoff_file )
475     write(fname(1:80),'(80a)') ' '
476     write(fname(1:80),'(3a,i10.10)')
477     & yadmark, xx_runoff_file(1:il),'.',optimcycle
478 heimbach 1.18 call active_read_xy( fname, tmpfld2d, icvrec,
479 heimbach 1.17 & doglobalread, ladinit, optimcycle,
480     & mythid, dummy)
481     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
482     #endif /* ALLOW_RUNOFF_CONTROL */
483 heimbach 1.13
484 heimbach 1.19 #ifdef ALLOW_SIAREA_CONTROL
485     else if ( grdchkvarindex .eq. 41 ) then
486     il=ilnblnk( xx_siarea_file )
487     write(fname(1:80),'(80a)') ' '
488     write(fname(1:80),'(3a,i10.10)')
489     & yadmark, xx_siarea_file(1:il),'.',optimcycle
490     call active_read_xy( fname, tmpfld2d, icvrec,
491     & doglobalread, ladinit, optimcycle,
492     & mythid, dummy)
493     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
494     #endif /* ALLOW_SIAREA_CONTROL */
495    
496     #ifdef ALLOW_SIHEFF_CONTROL
497     else if ( grdchkvarindex .eq. 42 ) then
498     il=ilnblnk( xx_siheff_file )
499     write(fname(1:80),'(80a)') ' '
500     write(fname(1:80),'(3a,i10.10)')
501     & yadmark, xx_siheff_file(1:il),'.',optimcycle
502     call active_read_xy( fname, tmpfld2d, icvrec,
503     & doglobalread, ladinit, optimcycle,
504     & mythid, dummy)
505     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
506     #endif /* ALLOW_SIHEFF_CONTROL */
507    
508     #ifdef ALLOW_SIHSNOW_CONTROL
509     else if ( grdchkvarindex .eq. 43 ) then
510     il=ilnblnk( xx_sihsnow_file )
511     write(fname(1:80),'(80a)') ' '
512     write(fname(1:80),'(3a,i10.10)')
513     & yadmark, xx_sihsnow_file(1:il),'.',optimcycle
514     call active_read_xy( fname, tmpfld2d, icvrec,
515     & doglobalread, ladinit, optimcycle,
516     & mythid, dummy)
517     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
518     #endif /* ALLOW_SIHSNOW_CONTROL */
519    
520 heimbach 1.2 else
521     ce --> this index does not exist yet.
522     endif
523    
524 heimbach 1.10 #endif /* ALLOW_GRDCHK */
525 heimbach 1.2
526     end
527    

  ViewVC Help
Powered by ViewVC 1.1.22