/[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.42 - (hide annotations) (download)
Wed Feb 18 12:31:10 2015 UTC (9 years, 2 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, HEAD
Changes since 1.41: +4 -3 lines
o change to local arrays
o remove special treatment for OpenAD

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

  ViewVC Help
Powered by ViewVC 1.1.22