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

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

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


Revision 1.42 - (show 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 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getadxx.F,v 1.41 2015/01/28 12:33:35 heimbach Exp $
2 C $Name: $
3
4 #include "GRDCHK_OPTIONS.h"
5 #ifdef ALLOW_CTRL
6 # include "CTRL_OPTIONS.h"
7 #endif
8
9 subroutine grdchk_getadxx(
10 I icvrec,
11 I itile,
12 I jtile,
13 I layer,
14 I itilepos,
15 I jtilepos,
16 I xx_comp,
17 I ierr,
18 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 #include "CTRL_SIZE.h"
41 #include "ctrl.h"
42 #include "CTRL_GENARR.h"
43 #include "CTRL_OBCS.h"
44 #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 _RL xx_comp
56 integer ierr
57 integer mythid
58
59 #ifdef ALLOW_GRDCHK
60 c == local variables ==
61
62 integer iarr
63 integer il
64 integer dumiter
65 _RL dumtime
66 _RL dummy
67
68 logical doglobalread
69 logical ladinit
70
71 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
72 _RL tmpfldxz (1-olx:snx+olx,nr,nsx,nsy)
73 #endif
74 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
75 _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy)
76 #endif
77 _RL loctmp2d (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
78 _RL loctmp3d (1-olx:snx+olx,1-oly:sny+oly,Nr,nsx,nsy)
79
80 character*(80) fname
81
82 integer i,j,k
83
84 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 if ( grdchkvarindex .eq. 0 ) then
97 STOP 'GRDCHK INDEX 0 NOT ALLOWED'
98
99 #ifdef ECCO_CTRL_DEPRECATED
100
101 #ifdef ALLOW_THETA0_CONTROL
102 else if ( grdchkvarindex .eq. 1 ) then
103 il=ilnblnk( xx_theta_file )
104 write(fname(1:80),'(80a)') ' '
105 write(fname(1:80),'(3a,i10.10)')
106 & yadmark, xx_theta_file(1:il),'.',optimcycle
107 #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 & yadmark, xx_salt_file(1:il),'.',optimcycle
115 #endif /* ALLOW_SALT0_CONTROL */
116
117 #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 #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 & yadmark, xx_hflux_file(1:il),'.',optimcycle
139 #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 & yadmark, xx_sflux_file(1:il),'.',optimcycle
147 #endif /* ALLOW_SFLUX_CONTROL */
148
149 #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
150 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 & yadmark, xx_tauu_file(1:il),'.',optimcycle
155 #endif /* ALLOW_USTRESS_CONTROL */
156
157 #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
158 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 & yadmark, xx_tauv_file(1:il),'.',optimcycle
163 #endif /* ALLOW_VSTRESS_CONTROL */
164
165 #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
197 #endif /* ECCO_CTRL_DEPRECATED */
198
199 #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
231 #ifdef ECCO_CTRL_DEPRECATED
232
233 #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 #ifdef ALLOW_KAPREDI_CONTROL
250 else if ( grdchkvarindex .eq. 44 ) then
251 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 #ifdef ALLOW_TR10_CONTROL
258 else if ( grdchkvarindex .eq. 17 ) then
259 il=ilnblnk( xx_tr1_file )
260 write(fname(1:80),'(80a)') ' '
261 write(fname(1:80),'(3a,i10.10)')
262 & yadmark, xx_tr1_file(1:il),'.',optimcycle
263 #endif /* ALLOW_TR10_CONTROL */
264
265 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
266 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 & yadmark, xx_sst_file(1:il),'.',optimcycle
271 #endif /* ALLOW_SST0_CONTROL */
272
273 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
274 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 & yadmark, xx_sss_file(1:il),'.',optimcycle
279 #endif /* ALLOW_SSS0_CONTROL */
280
281 #ifdef ALLOW_DEPTH_CONTROL
282 else if ( grdchkvarindex .eq. 20 ) then
283 il=ilnblnk( xx_depth_file )
284 write(fname(1:80),'(80a)') ' '
285 write(fname(1:80),'(3a,i10.10)')
286 & yadmark, xx_depth_file(1:il),'.',optimcycle
287 #endif /* ALLOW_DEPTH_CONTROL */
288
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 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
295 #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 & yadmark, xx_efluxp_file(1:il),'.',optimcycle
303 #endif /* ALLOW_EFLUXP0_CONTROL */
304
305 #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 #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 #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 #ifdef ALLOW_PRECIP_CONTROL
338 else if ( grdchkvarindex .eq. 32 ) then
339 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 write(fname(1:80),'(80a)') ' '
349 write(fname(1:80),'(3a,i10.10)')
350 & yadmark, xx_swflux_file(1:il),'.',optimcycle
351 #endif /* ALLOW_SWFLUX_CONTROL */
352
353 #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 #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
385 #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
401 #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
409 #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 #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 #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 #endif /* ECCO_CTRL_DEPRECATED */
450
451 #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 endif
474 enddo
475 #endif /* ALLOW_GENARR3D_CONTROL */
476
477 #ifdef ALLOW_GENTIM2D_CONTROL
478 else if ( grdchkvarindex .ge. 301 .and.
479 & grdchkvarindex .le. 300+maxCtrlTim2D ) then
480 do iarr = 1, maxCtrlTim2D
481 if ( grdchkvarindex .eq. 300+iarr ) then
482 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 else
491 STOP 'grdchk_getadxx: grdchkvarindex not implemented'
492 endif
493
494 if (ierr .EQ. 0 ) then
495 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 & grdchkvarindex.EQ.22 .OR. grdchkvarindex.EQ.31 .OR.
500 & grdchkvarindex.EQ.44
501 #ifdef ALLOW_GENARR3D_CONTROL
502 & .OR. ( grdchkvarindex .ge. 201 .and.
503 & grdchkvarindex .le. 200+maxCtrlArr3D )
504 #endif
505 & ) then
506
507 call active_read_xyz( fname, loctmp3d, 1,
508 & doglobalread, ladinit, optimcycle,
509 & mythid, dummy)
510 if ( myProcId .EQ. grdchkwhichproc )
511 & xx_comp = loctmp3d( itilepos,jtilepos,layer,itile,jtile )
512
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 if ( myProcId .EQ. grdchkwhichproc )
519 & 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 if ( myProcId .EQ. grdchkwhichproc )
528 & xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
529 #endif
530
531 else
532
533 call active_read_xy( fname, loctmp2d, icvrec,
534 & doglobalread, ladinit, optimcycle,
535 & mythid, dummy)
536 if ( myProcId .EQ. grdchkwhichproc )
537 & xx_comp = loctmp2d( itilepos,jtilepos,itile,jtile )
538
539 endif
540 endif
541
542 #endif /* ALLOW_GRDCHK */
543
544 return
545 end

  ViewVC Help
Powered by ViewVC 1.1.22