/[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.18 - (show annotations) (download)
Mon May 14 21:53:12 2007 UTC (16 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint59d, checkpoint59c, checkpoint59b
Changes since 1.17: +32 -32 lines
Cleanup suggested by M. Mazloff (remove _loc)

1 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getadxx.F,v 1.17 2006/10/27 05:16:54 heimbach Exp $
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 I xx_comp,
14 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 _RL xx_comp
49 integer mythid
50
51 #ifdef ALLOW_GRDCHK
52 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 integer i,j,k
65
66 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 if ( grdchkvarindex .eq. 0 ) then
79 STOP 'GRDCHK INDEX 0 NOT ALLOWED'
80
81 #ifdef ALLOW_THETA0_CONTROL
82 else if ( grdchkvarindex .eq. 1 ) then
83 il=ilnblnk( xx_theta_file )
84 write(fname(1:80),'(80a)') ' '
85 write(fname(1:80),'(3a,i10.10)')
86 & yadmark, xx_theta_file(1:il),'.',optimcycle
87
88 call active_read_xyz( fname, tmpfld3d, 1,
89 & doglobalread, ladinit, optimcycle,
90 & mythid, dummy)
91 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
92 #endif /* ALLOW_THETA0_CONTROL */
93
94 #ifdef ALLOW_SALT0_CONTROL
95 else if ( grdchkvarindex .eq. 2 ) then
96 il=ilnblnk( xx_salt_file )
97 write(fname(1:80),'(80a)') ' '
98 write(fname(1:80),'(3a,i10.10)')
99 & yadmark, xx_salt_file(1:il),'.',optimcycle
100 call active_read_xyz( fname, tmpfld3d, 1,
101 & doglobalread, ladinit, optimcycle,
102 & mythid, dummy)
103 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
104
105 #endif /* ALLOW_SALT0_CONTROL */
106
107 #ifdef ALLOW_HFLUX_CONTROL
108 else if ( grdchkvarindex .eq. 3 ) then
109 il=ilnblnk( xx_hflux_file )
110 write(fname(1:80),'(80a)') ' '
111 write(fname(1:80),'(3a,i10.10)')
112 & yadmark, xx_hflux_file(1:il),'.',optimcycle
113 call active_read_xy( fname, tmpfld2d, icvrec,
114 & doglobalread, ladinit, optimcycle,
115 & mythid, dummy)
116 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
117 #endif /* ALLOW_HFLUX_CONTROL */
118
119 #ifdef ALLOW_SFLUX_CONTROL
120 else if ( grdchkvarindex .eq. 4 ) then
121 il=ilnblnk( xx_sflux_file )
122 write(fname(1:80),'(80a)') ' '
123 write(fname(1:80),'(3a,i10.10)')
124 & yadmark, xx_sflux_file(1:il),'.',optimcycle
125 call active_read_xy( fname, tmpfld2d, icvrec,
126 & doglobalread, ladinit, optimcycle,
127 & mythid, dummy)
128 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
129 #endif /* ALLOW_SFLUX_CONTROL */
130
131 #ifdef ALLOW_USTRESS_CONTROL
132 else if ( grdchkvarindex .eq. 5 ) then
133 il=ilnblnk( xx_tauu_file )
134 write(fname(1:80),'(80a)') ' '
135 write(fname(1:80),'(3a,i10.10)')
136 & yadmark, xx_tauu_file(1:il),'.',optimcycle
137 call active_read_xy( fname, tmpfld2d, icvrec,
138 & doglobalread, ladinit, optimcycle,
139 & mythid, dummy)
140 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
141 #endif /* ALLOW_USTRESS_CONTROL */
142
143 #ifdef ALLOW_VSTRESS_CONTROL
144 else if ( grdchkvarindex .eq. 6 ) then
145 il=ilnblnk( xx_tauv_file )
146 write(fname(1:80),'(80a)') ' '
147 write(fname(1:80),'(3a,i10.10)')
148 & yadmark, xx_tauv_file(1:il),'.',optimcycle
149 call active_read_xy( fname, tmpfld2d, icvrec,
150 & doglobalread, ladinit, optimcycle,
151 & mythid, dummy)
152 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
153 #endif /* ALLOW_VSTRESS_CONTROL */
154
155 #ifdef ALLOW_ATEMP_CONTROL
156 else if ( grdchkvarindex .eq. 7 ) then
157 il=ilnblnk( xx_atemp_file )
158 write(fname(1:80),'(80a)') ' '
159 write(fname(1:80),'(3a,i10.10)')
160 & yadmark, xx_atemp_file(1:il),'.',optimcycle
161 call active_read_xy( fname, tmpfld2d, icvrec,
162 & doglobalread, ladinit, optimcycle,
163 & mythid, dummy)
164 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
165 #endif /* ALLOW_ATEMP_CONTROL */
166
167 #ifdef ALLOW_AQH_CONTROL
168 else if ( grdchkvarindex .eq. 8 ) then
169 il=ilnblnk( xx_aqh_file )
170 write(fname(1:80),'(80a)') ' '
171 write(fname(1:80),'(3a,i10.10)')
172 & yadmark, xx_aqh_file(1:il),'.',optimcycle
173 call active_read_xy( fname, tmpfld2d, icvrec,
174 & doglobalread, ladinit, optimcycle,
175 & mythid, dummy)
176 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
177 #endif /* ALLOW_AQH_CONTROL */
178
179 #ifdef ALLOW_UWIND_CONTROL
180 else if ( grdchkvarindex .eq. 9 ) then
181 il=ilnblnk( xx_uwind_file )
182 write(fname(1:80),'(80a)') ' '
183 write(fname(1:80),'(3a,i10.10)')
184 & yadmark, xx_uwind_file(1:il),'.',optimcycle
185 call active_read_xy( fname, tmpfld2d, icvrec,
186 & doglobalread, ladinit, optimcycle,
187 & mythid, dummy)
188 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
189 #endif /* ALLOW_UWIND_CONTROL */
190
191 #ifdef ALLOW_VWIND_CONTROL
192 else if ( grdchkvarindex .eq. 10 ) then
193 il=ilnblnk( xx_vwind_file )
194 write(fname(1:80),'(80a)') ' '
195 write(fname(1:80),'(3a,i10.10)')
196 & yadmark, xx_vwind_file(1:il),'.',optimcycle
197 call active_read_xy( fname, tmpfld2d, icvrec,
198 & doglobalread, ladinit, optimcycle,
199 & mythid, dummy)
200 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
201 #endif /* ALLOW_VWIND_CONTROL */
202
203 #ifdef ALLOW_OBCSN_CONTROL
204 else if ( grdchkvarindex .eq. 11 ) then
205 il=ilnblnk( xx_obcsn_file )
206 write(fname(1:80),'(80a)') ' '
207 write(fname(1:80),'(3a,i10.10)')
208 & yadmark, xx_obcsn_file(1:il),'.',optimcycle
209
210 call active_read_xz( fname, tmpfldxz, icvrec,
211 & doglobalread, ladinit, optimcycle,
212 & mythid, dummy)
213
214 xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
215
216 #endif /* ALLOW_OBCSN_CONTROL */
217
218 #ifdef ALLOW_OBCSS_CONTROL
219 else if ( grdchkvarindex .eq. 12 ) then
220 il=ilnblnk( xx_obcss_file )
221 write(fname(1:80),'(80a)') ' '
222 write(fname(1:80),'(3a,i10.10)')
223 & yadmark, xx_obcss_file(1:il),'.',optimcycle
224
225 call active_read_xz( fname, tmpfldxz, icvrec,
226 & doglobalread, ladinit, optimcycle,
227 & mythid, dummy)
228
229 xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
230
231 #endif /* ALLOW_OBCSS_CONTROL */
232
233 #ifdef ALLOW_OBCSW_CONTROL
234 else if ( grdchkvarindex .eq. 13 ) then
235 il=ilnblnk( xx_obcsw_file )
236 write(fname(1:80),'(80a)') ' '
237 write(fname(1:80),'(3a,i10.10)')
238 & yadmark, xx_obcsw_file(1:il),'.',optimcycle
239
240 call active_read_yz( fname, tmpfldyz, icvrec,
241 & doglobalread, ladinit, optimcycle,
242 & mythid, dummy)
243
244 xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
245
246 #endif /* ALLOW_OBCSW_CONTROL */
247
248 #ifdef ALLOW_OBCSE_CONTROL
249 else if ( grdchkvarindex .eq. 14 ) then
250 il=ilnblnk( xx_obcse_file )
251 write(fname(1:80),'(80a)') ' '
252 write(fname(1:80),'(3a,i10.10)')
253 & yadmark, xx_obcse_file(1:il),'.',optimcycle
254
255 call active_read_yz( fname, tmpfldyz, icvrec,
256 & doglobalread, ladinit, optimcycle,
257 & mythid, dummy)
258
259 xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
260
261 #endif /* ALLOW_OBCSE_CONTROL */
262
263 #ifdef ALLOW_DIFFKR_CONTROL
264 else if ( grdchkvarindex .eq. 15 ) then
265 il=ilnblnk( xx_diffkr_file )
266 write(fname(1:80),'(80a)') ' '
267 write(fname(1:80),'(3a,i10.10)')
268 & yadmark, xx_diffkr_file(1:il),'.',optimcycle
269
270 call active_read_xyz( fname, tmpfld3d, 1,
271 & doglobalread, ladinit, optimcycle,
272 & mythid, dummy)
273
274 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
275
276 #endif /* ALLOW_DIFFKR_CONTROL */
277
278 #ifdef ALLOW_KAPGM_CONTROL
279 else if ( grdchkvarindex .eq. 16 ) then
280 il=ilnblnk( xx_kapgm_file )
281 write(fname(1:80),'(80a)') ' '
282 write(fname(1:80),'(3a,i10.10)')
283 & yadmark, xx_kapgm_file(1:il),'.',optimcycle
284
285 call active_read_xyz( fname, tmpfld3d, 1,
286 & doglobalread, ladinit, optimcycle,
287 & mythid, dummy)
288
289 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
290
291 #endif /* ALLOW_KAPGM_CONTROL */
292
293 #ifdef ALLOW_TR10_CONTROL
294 else if ( grdchkvarindex .eq. 17 ) then
295 il=ilnblnk( xx_tr1_file )
296 write(fname(1:80),'(80a)') ' '
297 write(fname(1:80),'(3a,i10.10)')
298 & yadmark, xx_tr1_file(1:il),'.',optimcycle
299
300 call active_read_xyz( fname, tmpfld3d, 1,
301 & doglobalread, ladinit, optimcycle,
302 & mythid, dummy)
303
304 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
305
306 #endif /* ALLOW_TR10_CONTROL */
307
308 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
309 else if ( grdchkvarindex .eq. 18 ) then
310 il=ilnblnk( xx_sst_file )
311 write(fname(1:80),'(80a)') ' '
312 write(fname(1:80),'(3a,i10.10)')
313 & yadmark, xx_sst_file(1:il),'.',optimcycle
314 call active_read_xy( fname, tmpfld2d, icvrec,
315 & doglobalread, ladinit, optimcycle,
316 & mythid, dummy)
317 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
318 #endif /* ALLOW_SST0_CONTROL */
319
320 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
321 else if ( grdchkvarindex .eq. 19 ) then
322 il=ilnblnk( xx_sss_file )
323 write(fname(1:80),'(80a)') ' '
324 write(fname(1:80),'(3a,i10.10)')
325 & yadmark, xx_sss_file(1:il),'.',optimcycle
326 call active_read_xy( fname, tmpfld2d, icvrec,
327 & doglobalread, ladinit, optimcycle,
328 & mythid, dummy)
329 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
330 #endif /* ALLOW_SSS0_CONTROL */
331
332 #ifdef ALLOW_DEPTH_CONTROL
333 else if ( grdchkvarindex .eq. 20 ) then
334 il=ilnblnk( xx_depth_file )
335 write(fname(1:80),'(80a)') ' '
336 write(fname(1:80),'(3a,i10.10)')
337 & yadmark, xx_depth_file(1:il),'.',optimcycle
338 call active_read_xy( fname, tmpfld2d, icvrec,
339 & doglobalread, ladinit, optimcycle,
340 & mythid, dummy)
341 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
342 #endif /* ALLOW_DEPTH_CONTROL */
343
344 #ifdef ALLOW_EFLUXY0_CONTROL
345 else if ( grdchkvarindex .eq. 21 ) then
346 il=ilnblnk( xx_efluxy_file )
347 write(fname(1:80),'(80a)') ' '
348 write(fname(1:80),'(3a,i10.10)')
349 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
350
351 call active_read_xyz( fname, tmpfld3d, 1,
352 & doglobalread, ladinit, optimcycle,
353 & mythid, dummy)
354
355 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
356
357 #endif /* ALLOW_EFLUXY0_CONTROL */
358
359 #ifdef ALLOW_EFLUXP0_CONTROL
360 else if ( grdchkvarindex .eq. 22 ) then
361 il=ilnblnk( xx_efluxp_file )
362 write(fname(1:80),'(80a)') ' '
363 write(fname(1:80),'(3a,i10.10)')
364 & yadmark, xx_efluxp_file(1:il),'.',optimcycle
365
366 call active_read_xyz( fname, tmpfld3d, 1,
367 & doglobalread, ladinit, optimcycle,
368 & mythid, dummy)
369
370 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
371
372 #endif /* ALLOW_EFLUXP0_CONTROL */
373
374 #ifdef ALLOW_PRECIP_CONTROL
375 else if ( grdchkvarindex .eq. 32 ) then
376 il=ilnblnk( xx_precip_file )
377 write(fname(1:80),'(80a)') ' '
378 write(fname(1:80),'(3a,i10.10)')
379 & yadmark, xx_precip_file(1:il),'.',optimcycle
380 call active_read_xy( fname, tmpfld2d, icvrec,
381 & doglobalread, ladinit, optimcycle,
382 & mythid, dummy)
383 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
384 #endif /* ALLOW_PRECIP_CONTROL */
385
386 #ifdef ALLOW_SWFLUX_CONTROL
387 else if ( grdchkvarindex .eq. 33 ) then
388 il=ilnblnk( xx_swflux_file )
389 write(fname(1:80),'(80a)') ' '
390 write(fname(1:80),'(3a,i10.10)')
391 & yadmark, xx_swflux_file(1:il),'.',optimcycle
392 call active_read_xy( fname, tmpfld2d, icvrec,
393 & doglobalread, ladinit, optimcycle,
394 & mythid, dummy)
395 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
396 #endif /* ALLOW_SWFLUX_CONTROL */
397
398 #ifdef ALLOW_SWDOWN_CONTROL
399 else if ( grdchkvarindex .eq. 34 ) then
400 il=ilnblnk( xx_swdown_file )
401 write(fname(1:80),'(80a)') ' '
402 write(fname(1:80),'(3a,i10.10)')
403 & yadmark, xx_swdown_file(1:il),'.',optimcycle
404 call active_read_xy( fname, tmpfld2d, icvrec,
405 & doglobalread, ladinit, optimcycle,
406 & mythid, dummy)
407 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
408 #endif /* ALLOW_SWDOWN_CONTROL */
409
410 #ifdef ALLOW_LWFLUX_CONTROL
411 else if ( grdchkvarindex .eq. 35 ) then
412 il=ilnblnk( xx_lwflux_file )
413 write(fname(1:80),'(80a)') ' '
414 write(fname(1:80),'(3a,i10.10)')
415 & yadmark, xx_lwflux_file(1:il),'.',optimcycle
416 call active_read_xy( fname, tmpfld2d, icvrec,
417 & doglobalread, ladinit, optimcycle,
418 & mythid, dummy)
419 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
420 #endif /* ALLOW_LWFLUX_CONTROL */
421
422 #ifdef ALLOW_LWDOWN_CONTROL
423 else if ( grdchkvarindex .eq. 36 ) then
424 il=ilnblnk( xx_lwdown_file )
425 write(fname(1:80),'(80a)') ' '
426 write(fname(1:80),'(3a,i10.10)')
427 & yadmark, xx_lwdown_file(1:il),'.',optimcycle
428 call active_read_xy( fname, tmpfld2d, icvrec,
429 & doglobalread, ladinit, optimcycle,
430 & mythid, dummy)
431 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
432 #endif /* ALLOW_LWDOWN_CONTROL */
433
434 #ifdef ALLOW_EVAP_CONTROL
435 else if ( grdchkvarindex .eq. 37 ) then
436 il=ilnblnk( xx_evap_file )
437 write(fname(1:80),'(80a)') ' '
438 write(fname(1:80),'(3a,i10.10)')
439 & yadmark, xx_evap_file(1:il),'.',optimcycle
440 call active_read_xy( fname, tmpfld2d, icvrec,
441 & doglobalread, ladinit, optimcycle,
442 & mythid, dummy)
443 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
444 #endif /* ALLOW_EVAP_CONTROL */
445
446 #ifdef ALLOW_SNOWPRECIP_CONTROL
447 else if ( grdchkvarindex .eq. 38 ) then
448 il=ilnblnk( xx_snowprecip_file )
449 write(fname(1:80),'(80a)') ' '
450 write(fname(1:80),'(3a,i10.10)')
451 & yadmark, xx_snowprecip_file(1:il),'.',optimcycle
452 call active_read_xy( fname, tmpfld2d, icvrec,
453 & doglobalread, ladinit, optimcycle,
454 & mythid, dummy)
455 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
456 #endif /* ALLOW_SNOWPRECIP_CONTROL */
457
458 #ifdef ALLOW_APRESSURE_CONTROL
459 else if ( grdchkvarindex .eq. 39 ) then
460 il=ilnblnk( xx_apressure_file )
461 write(fname(1:80),'(80a)') ' '
462 write(fname(1:80),'(3a,i10.10)')
463 & yadmark, xx_apressure_file(1:il),'.',optimcycle
464
465 call active_read_xy( fname, tmpfld2d, icvrec,
466 & doglobalread, ladinit, optimcycle,
467 & mythid, dummy)
468 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
469 #endif /* ALLOW_APRESSURE_CONTROL */
470
471 #ifdef ALLOW_RUNOFF_CONTROL
472 else if ( grdchkvarindex .eq. 40 ) then
473 il=ilnblnk( xx_runoff_file )
474 write(fname(1:80),'(80a)') ' '
475 write(fname(1:80),'(3a,i10.10)')
476 & yadmark, xx_runoff_file(1:il),'.',optimcycle
477 call active_read_xy( fname, tmpfld2d, icvrec,
478 & doglobalread, ladinit, optimcycle,
479 & mythid, dummy)
480 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
481 #endif /* ALLOW_RUNOFF_CONTROL */
482
483 else
484 ce --> this index does not exist yet.
485 endif
486
487 #endif /* ALLOW_GRDCHK */
488
489 end
490

  ViewVC Help
Powered by ViewVC 1.1.22