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

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

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


Revision 1.22 - (show annotations) (download)
Sat Feb 2 02:36:50 2008 UTC (16 years, 3 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59o, checkpoint59n
Changes since 1.21: +27 -1 lines
introduce isopycnal diffusion coefficient control.

1 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getxx.F,v 1.21 2008/01/17 20:49:27 dfer Exp $
2 C $Name: $
3
4 #include "CTRL_CPPOPTIONS.h"
5
6
7 subroutine grdchk_getxx(
8 I icvrec,
9 I theSimulationMode,
10 I itile,
11 I jtile,
12 I layer,
13 I itilepos,
14 I jtilepos,
15 I xx_comp_ref,
16 I xx_comp_pert,
17 I localEps,
18 I mythid
19 & )
20
21 c ==================================================================
22 c SUBROUTINE grdchk_getxx
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_getxx
32 c ==================================================================
33
34 implicit none
35
36 c == global variables ==
37
38 #include "EEPARAMS.h"
39 #include "SIZE.h"
40 #include "ctrl.h"
41 #include "grdchk.h"
42 #include "optim.h"
43
44 c == routine arguments ==
45
46 integer icvrec
47 integer theSimulationMode
48 integer jtile
49 integer itile
50 integer layer
51 integer itilepos
52 integer jtilepos
53 _RL xx_comp_ref
54 _RL xx_comp_pert
55 _RL localEps
56 integer mythid
57
58 #ifdef ALLOW_GRDCHK
59 c == local variables ==
60
61 integer il
62 integer dumiter
63 _RL dumtime
64 _RL dummy
65
66 logical doglobalread
67 logical ladinit
68
69 character*(80) fname
70
71 c-- == external ==
72
73 integer ilnblnk
74 external ilnblnk
75
76 c-- == end of interface ==
77
78 doglobalread = .false.
79 ladinit = .false.
80 dumiter = 0
81 dumtime = 0. _d 0
82 write(fname(1:80),'(80a)') ' '
83
84 if ( grdchkvarindex .eq. 0 ) then
85 STOP 'GRDCHK INDEX 0 NOT ALLOWED'
86
87 #ifdef ALLOW_THETA0_CONTROL
88 else if ( grdchkvarindex .eq. 1 ) then
89 il=ilnblnk( xx_theta_file )
90 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
91 write(fname(1:80),'(3a,i10.10)')
92 & yadmark, xx_theta_file(1:il),'.',optimcycle
93 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
94 write(fname(1:80),'(2a,i10.10)')
95 & xx_theta_file(1:il),'.',optimcycle
96 end if
97 call active_read_xyz( fname, tmpfld3d, 1,
98 & doglobalread, ladinit, optimcycle,
99 & mythid, dummy)
100 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
101 xx_comp_pert = xx_comp_ref + localEps
102 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
103 call active_write_xyz( fname, tmpfld3d, 1,
104 & optimcycle,
105 & mythid, dummy)
106 #endif /* ALLOW_THETA0_CONTROL */
107
108 #ifdef ALLOW_SALT0_CONTROL
109 else if ( grdchkvarindex .eq. 2 ) then
110 il=ilnblnk( xx_salt_file )
111 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
112 write(fname(1:80),'(3a,i10.10)')
113 & yadmark, xx_salt_file(1:il),'.',optimcycle
114 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
115 write(fname(1:80),'(2a,i10.10)')
116 & xx_salt_file(1:il),'.',optimcycle
117 end if
118 call active_read_xyz( fname, tmpfld3d, 1,
119 & doglobalread, ladinit, optimcycle,
120 & mythid, dummy)
121 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
122 xx_comp_pert = xx_comp_ref + localEps
123 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
124 call active_write_xyz( fname, tmpfld3d, 1,
125 & optimcycle,
126 & mythid, dummy)
127 #endif /* ALLOW_SALT0_CONTROL */
128
129 #ifdef ALLOW_HFLUX_CONTROL
130 else if ( grdchkvarindex .eq. 3 ) then
131 il=ilnblnk( xx_hflux_file )
132 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
133 write(fname(1:80),'(3a,i10.10)')
134 & yadmark, xx_hflux_file(1:il),'.',optimcycle
135 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
136 write(fname(1:80),'(2a,i10.10)')
137 & xx_hflux_file(1:il),'.',optimcycle
138 end if
139 call active_read_xy( fname, tmpfld2d, icvrec,
140 & doglobalread, ladinit, optimcycle,
141 & mythid, dummy)
142 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
143 xx_comp_pert = xx_comp_ref + localEps
144 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
145 call active_write_xy( fname, tmpfld2d, icvrec,
146 & optimcycle,
147 & mythid, dummy)
148 #endif /* ALLOW_HFLUX_CONTROL */
149
150 #ifdef ALLOW_SFLUX_CONTROL
151 else if ( grdchkvarindex .eq. 4 ) then
152 il=ilnblnk( xx_sflux_file )
153 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
154 write(fname(1:80),'(3a,i10.10)')
155 & yadmark, xx_sflux_file(1:il),'.',optimcycle
156 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
157 write(fname(1:80),'(2a,i10.10)')
158 & xx_sflux_file(1:il),'.',optimcycle
159 end if
160 call active_read_xy( fname, tmpfld2d, icvrec,
161 & doglobalread, ladinit, optimcycle,
162 & mythid, dummy)
163 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
164 xx_comp_pert = xx_comp_ref + localEps
165 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
166 call active_write_xy( fname, tmpfld2d, icvrec,
167 & optimcycle,
168 & mythid, dummy)
169 #endif /* ALLOW_SFLUX_CONTROL */
170
171 #ifdef ALLOW_USTRESS_CONTROL
172 else if ( grdchkvarindex .eq. 5 ) then
173 il=ilnblnk( xx_tauu_file )
174 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
175 write(fname(1:80),'(3a,i10.10)')
176 & yadmark, xx_tauu_file(1:il),'.',optimcycle
177 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
178 write(fname(1:80),'(2a,i10.10)')
179 & xx_tauu_file(1:il),'.',optimcycle
180 end if
181 call active_read_xy( fname, tmpfld2d, icvrec,
182 & doglobalread, ladinit, optimcycle,
183 & mythid, dummy)
184 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
185 xx_comp_pert = xx_comp_ref + localEps
186 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
187 call active_write_xy( fname, tmpfld2d, icvrec,
188 & optimcycle,
189 & mythid, dummy)
190 #endif /* ALLOW_USTRESS_CONTROL */
191
192 #ifdef ALLOW_VSTRESS_CONTROL
193 else if ( grdchkvarindex .eq. 6 ) then
194 il=ilnblnk( xx_tauv_file )
195 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
196 write(fname(1:80),'(3a,i10.10)')
197 & yadmark, xx_tauv_file(1:il),'.',optimcycle
198 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
199 write(fname(1:80),'(2a,i10.10)')
200 & xx_tauv_file(1:il),'.',optimcycle
201 end if
202 call active_read_xy( fname, tmpfld2d, icvrec,
203 & doglobalread, ladinit, optimcycle,
204 & mythid, dummy)
205 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
206 xx_comp_pert = xx_comp_ref + localEps
207 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
208 call active_write_xy( fname, tmpfld2d, icvrec,
209 & optimcycle,
210 & mythid, dummy)
211 #endif /* ALLOW_VSTRESS_CONTROL */
212
213 #ifdef ALLOW_ATEMP_CONTROL
214 else if ( grdchkvarindex .eq. 7 ) then
215 il=ilnblnk( xx_atemp_file )
216 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
217 write(fname(1:80),'(3a,i10.10)')
218 & yadmark, xx_atemp_file(1:il),'.',optimcycle
219 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
220 write(fname(1:80),'(2a,i10.10)')
221 & xx_atemp_file(1:il),'.',optimcycle
222 end if
223 call active_read_xy( fname, tmpfld2d, icvrec,
224 & doglobalread, ladinit, optimcycle,
225 & mythid, dummy)
226 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
227 xx_comp_pert = xx_comp_ref + localEps
228 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
229 call active_write_xy( fname, tmpfld2d, icvrec,
230 & optimcycle,
231 & mythid, dummy)
232 #endif /* ALLOW_ATEMP_CONTROL */
233
234 #ifdef ALLOW_AQH_CONTROL
235 else if ( grdchkvarindex .eq. 8 ) then
236 il=ilnblnk( xx_aqh_file )
237 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
238 write(fname(1:80),'(3a,i10.10)')
239 & yadmark, xx_aqh_file(1:il),'.',optimcycle
240 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
241 write(fname(1:80),'(2a,i10.10)')
242 & xx_aqh_file(1:il),'.',optimcycle
243 end if
244 call active_read_xy( fname, tmpfld2d, icvrec,
245 & doglobalread, ladinit, optimcycle,
246 & mythid, dummy)
247 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
248 xx_comp_pert = xx_comp_ref + localEps
249 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
250 call active_write_xy( fname, tmpfld2d, icvrec,
251 & optimcycle,
252 & mythid, dummy)
253 #endif /* ALLOW_AQH_CONTROL */
254
255 #ifdef ALLOW_UWIND_CONTROL
256 else if ( grdchkvarindex .eq. 9 ) then
257 il=ilnblnk( xx_uwind_file )
258 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
259 write(fname(1:80),'(3a,i10.10)')
260 & yadmark, xx_uwind_file(1:il),'.',optimcycle
261 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
262 write(fname(1:80),'(2a,i10.10)')
263 & xx_uwind_file(1:il),'.',optimcycle
264 end if
265 call active_read_xy( fname, tmpfld2d, icvrec,
266 & doglobalread, ladinit, optimcycle,
267 & mythid, dummy)
268 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
269 xx_comp_pert = xx_comp_ref + localEps
270 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
271 call active_write_xy( fname, tmpfld2d, icvrec,
272 & optimcycle,
273 & mythid, dummy)
274 #endif /* ALLOW_UWIND_CONTROL */
275
276 #ifdef ALLOW_VWIND_CONTROL
277 else if ( grdchkvarindex .eq. 10 ) then
278 il=ilnblnk( xx_vwind_file )
279 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
280 write(fname(1:80),'(3a,i10.10)')
281 & yadmark, xx_vwind_file(1:il),'.',optimcycle
282 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
283 write(fname(1:80),'(2a,i10.10)')
284 & xx_vwind_file(1:il),'.',optimcycle
285 end if
286 call active_read_xy( fname, tmpfld2d, icvrec,
287 & doglobalread, ladinit, optimcycle,
288 & mythid, dummy)
289 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
290 xx_comp_pert = xx_comp_ref + localEps
291 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
292 call active_write_xy( fname, tmpfld2d, icvrec,
293 & optimcycle,
294 & mythid, dummy)
295 #endif /* ALLOW_VWIND_CONTROL */
296
297 #ifdef ALLOW_OBCSN_CONTROL
298 else if ( grdchkvarindex .eq. 11 ) then
299 il=ilnblnk( xx_obcsn_file )
300 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
301 write(fname(1:80),'(3a,i10.10)')
302 & yadmark, xx_obcsn_file(1:il),'.',optimcycle
303 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
304 write(fname(1:80),'(2a,i10.10)')
305 & xx_obcsn_file(1:il),'.',optimcycle
306 end if
307
308 call active_read_xz( fname, tmpfldxz, icvrec,
309 & doglobalread, ladinit, optimcycle,
310 & mythid, dummy)
311
312 xx_comp_ref = tmpfldxz( itilepos,layer,itile,jtile )
313 xx_comp_pert = xx_comp_ref + localEps
314 tmpfldxz( itilepos,layer,itile,jtile ) = xx_comp_pert
315
316 call active_write_xz( fname, tmpfldxz, icvrec,
317 & optimcycle,
318 & mythid, dummy)
319
320 #endif /* ALLOW_OBCSN_CONTROL */
321
322 #ifdef ALLOW_OBCSS_CONTROL
323 else if ( grdchkvarindex .eq. 12 ) then
324 il=ilnblnk( xx_obcss_file )
325 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
326 write(fname(1:80),'(3a,i10.10)')
327 & yadmark, xx_obcss_file(1:il),'.',optimcycle
328 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
329 write(fname(1:80),'(2a,i10.10)')
330 & xx_obcss_file(1:il),'.',optimcycle
331 end if
332
333 call active_read_xz( fname, tmpfldxz, icvrec,
334 & doglobalread, ladinit, optimcycle,
335 & mythid, dummy)
336
337 xx_comp_ref = tmpfldxz( itilepos,layer,itile,jtile )
338 xx_comp_pert = xx_comp_ref + localEps
339 tmpfldxz( itilepos,layer,itile,jtile ) = xx_comp_pert
340
341 call active_write_xz( fname, tmpfldxz, icvrec,
342 & optimcycle,
343 & mythid, dummy)
344
345 #endif /* ALLOW_OBCSS_CONTROL */
346
347 #ifdef ALLOW_OBCSW_CONTROL
348 else if ( grdchkvarindex .eq. 13 ) then
349 il=ilnblnk( xx_obcsw_file )
350 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
351 write(fname(1:80),'(3a,i10.10)')
352 & yadmark, xx_obcsw_file(1:il),'.',optimcycle
353 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
354 write(fname(1:80),'(2a,i10.10)')
355 & xx_obcsw_file(1:il),'.',optimcycle
356 end if
357
358 call active_read_yz( fname, tmpfldyz, icvrec,
359 & doglobalread, ladinit, optimcycle,
360 & mythid, dummy)
361
362 xx_comp_ref = tmpfldyz( jtilepos,layer,itile,jtile )
363 xx_comp_pert = xx_comp_ref + localEps
364 tmpfldyz( jtilepos,layer,itile,jtile ) = xx_comp_pert
365
366 call active_write_yz( fname, tmpfldyz, icvrec,
367 & optimcycle,
368 & mythid, dummy)
369
370 #endif /* ALLOW_OBCSW_CONTROL */
371
372 #ifdef ALLOW_OBCSE_CONTROL
373 else if ( grdchkvarindex .eq. 14 ) then
374 il=ilnblnk( xx_obcse_file )
375 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
376 write(fname(1:80),'(3a,i10.10)')
377 & yadmark, xx_obcse_file(1:il),'.',optimcycle
378 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
379 write(fname(1:80),'(2a,i10.10)')
380 & xx_obcse_file(1:il),'.',optimcycle
381 end if
382
383 call active_read_yz( fname, tmpfldyz, icvrec,
384 & doglobalread, ladinit, optimcycle,
385 & mythid, dummy)
386
387 xx_comp_ref = tmpfldyz( jtilepos,layer,itile,jtile )
388 xx_comp_pert = xx_comp_ref + localEps
389 tmpfldyz( jtilepos,layer,itile,jtile ) = xx_comp_pert
390
391 call active_write_yz( fname, tmpfldyz, icvrec,
392 & optimcycle,
393 & mythid, dummy)
394
395 #endif /* ALLOW_OBCSE_CONTROL */
396
397 #ifdef ALLOW_DIFFKR_CONTROL
398 else if ( grdchkvarindex .eq. 15 ) then
399 il=ilnblnk( xx_diffkr_file )
400 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
401 write(fname(1:80),'(3a,i10.10)')
402 & yadmark, xx_diffkr_file(1:il),'.',optimcycle
403 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
404 write(fname(1:80),'(2a,i10.10)')
405 & xx_diffkr_file(1:il),'.',optimcycle
406 end if
407
408 call active_read_xyz( fname, tmpfld3d, 1,
409 & doglobalread, ladinit, optimcycle,
410 & mythid, dummy)
411
412 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
413 xx_comp_pert = xx_comp_ref + localEps
414 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
415
416 call active_write_xyz( fname, tmpfld3d, 1,
417 & optimcycle,
418 & mythid, dummy)
419
420 #endif /* ALLOW_DIFFKR_CONTROL */
421
422 #ifdef ALLOW_KAPGM_CONTROL
423 else if ( grdchkvarindex .eq. 16 ) then
424 il=ilnblnk( xx_kapgm_file )
425 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
426 write(fname(1:80),'(3a,i10.10)')
427 & yadmark, xx_kapgm_file(1:il),'.',optimcycle
428 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
429 write(fname(1:80),'(2a,i10.10)')
430 & xx_kapgm_file(1:il),'.',optimcycle
431 end if
432
433 call active_read_xyz( fname, tmpfld3d, 1,
434 & doglobalread, ladinit, optimcycle,
435 & mythid, dummy)
436
437 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
438 xx_comp_pert = xx_comp_ref + localEps
439 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
440
441 call active_write_xyz( fname, tmpfld3d, 1,
442 & optimcycle,
443 & mythid, dummy)
444
445 #endif /* ALLOW_KAPGM_CONTROL */
446
447 #ifdef ALLOW_KAPREDI_CONTROL
448 else if ( grdchkvarindex .eq. 16 ) then
449 il=ilnblnk( xx_kapredi_file )
450 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
451 write(fname(1:80),'(3a,i10.10)')
452 & yadmark, xx_kapredi_file(1:il),'.',optimcycle
453 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
454 write(fname(1:80),'(2a,i10.10)')
455 & xx_kapredi_file(1:il),'.',optimcycle
456 end if
457
458 call active_read_xyz( fname, tmpfld3d, 1,
459 & doglobalread, ladinit, optimcycle,
460 & mythid, dummy)
461
462 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
463 xx_comp_pert = xx_comp_ref + localEps
464 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
465
466 call active_write_xyz( fname, tmpfld3d, 1,
467 & optimcycle,
468 & mythid, dummy)
469
470 #endif /* ALLOW_KAPREDI_CONTROL */
471
472
473 #ifdef ALLOW_TR10_CONTROL
474 else if ( grdchkvarindex .eq. 17 ) then
475 il=ilnblnk( xx_tr1_file )
476 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
477 write(fname(1:80),'(3a,i10.10)')
478 & yadmark, xx_tr1_file(1:il),'.',optimcycle
479 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
480 write(fname(1:80),'(2a,i10.10)')
481 & xx_tr1_file(1:il),'.',optimcycle
482 end if
483
484 call active_read_xyz( fname, tmpfld3d, icvrec,
485 & doglobalread, ladinit, optimcycle,
486 & mythid, dummy)
487
488 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
489 xx_comp_pert = xx_comp_ref + localEps
490 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
491
492 call active_write_xyz( fname, tmpfld3d, icvrec,
493 & optimcycle,
494 & mythid, dummy)
495
496 #endif /* ALLOW_TR10_CONTROL */
497
498 #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
499 else if ( grdchkvarindex .eq. 18 ) then
500 il=ilnblnk( xx_sst_file )
501 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
502 write(fname(1:80),'(3a,i10.10)')
503 & yadmark, xx_sst_file(1:il),'.',optimcycle
504 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
505 write(fname(1:80),'(2a,i10.10)')
506 & xx_sst_file(1:il),'.',optimcycle
507 end if
508 call active_read_xy( fname, tmpfld2d, icvrec,
509 & doglobalread, ladinit, optimcycle,
510 & mythid, dummy)
511 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
512 xx_comp_pert = xx_comp_ref + localEps
513 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
514 call active_write_xy( fname, tmpfld2d, icvrec,
515 & optimcycle,
516 & mythid, dummy)
517 #endif /* ALLOW_SST0_CONTROL */
518
519 #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
520 else if ( grdchkvarindex .eq. 19 ) then
521 il=ilnblnk( xx_sss_file )
522 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
523 write(fname(1:80),'(3a,i10.10)')
524 & yadmark, xx_sss_file(1:il),'.',optimcycle
525 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
526 write(fname(1:80),'(2a,i10.10)')
527 & xx_sss_file(1:il),'.',optimcycle
528 end if
529 call active_read_xy( fname, tmpfld2d, icvrec,
530 & doglobalread, ladinit, optimcycle,
531 & mythid, dummy)
532 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
533 xx_comp_pert = xx_comp_ref + localEps
534 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
535 call active_write_xy( fname, tmpfld2d, icvrec,
536 & optimcycle,
537 & mythid, dummy)
538 #endif /* ALLOW_SSS0_CONTROL */
539
540 #ifdef ALLOW_DEPTH_CONTROL
541 else if ( grdchkvarindex .eq. 20 ) then
542 il=ilnblnk( xx_depth_file )
543 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
544 write(fname(1:80),'(3a,i10.10)')
545 & yadmark, xx_depth_file(1:il),'.',optimcycle
546 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
547 write(fname(1:80),'(2a,i10.10)')
548 & xx_depth_file(1:il),'.',optimcycle
549 end if
550 call active_read_xy( fname, tmpfld2d, icvrec,
551 & doglobalread, ladinit, optimcycle,
552 & mythid, dummy)
553 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
554 xx_comp_pert = xx_comp_ref + localEps
555 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
556 call active_write_xy( fname, tmpfld2d, icvrec,
557 & optimcycle,
558 & mythid, dummy)
559 #endif /* ALLOW_DEPTH_CONTROL */
560
561 #ifdef ALLOW_EFLUXY0_CONTROL
562 else if ( grdchkvarindex .eq. 21 ) then
563 il=ilnblnk( xx_efluxy_file )
564 write(fname(1:80),'(80a)') ' '
565 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
566 write(fname(1:80),'(3a,i10.10)')
567 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
568 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
569 write(fname(1:80),'(2a,i10.10)')
570 & xx_efluxy_file(1:il),'.',optimcycle
571 end if
572
573 call active_read_xyz( fname, tmpfld3d, 1,
574 & doglobalread, ladinit, optimcycle,
575 & mythid, dummy)
576
577 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
578 xx_comp_pert = xx_comp_ref + localEps
579 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
580
581 call active_write_xyz( fname, tmpfld3d, 1,
582 & optimcycle,
583 & mythid, dummy)
584
585 #endif /* ALLOW_EFLUXY0_CONTROL */
586
587 #ifdef ALLOW_EFLUXP0_CONTROL
588 else if ( grdchkvarindex .eq. 22 ) then
589 il=ilnblnk( xx_efluxp_file )
590 write(fname(1:80),'(80a)') ' '
591 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
592 write(fname(1:80),'(3a,i10.10)')
593 & yadmark, xx_efluxp_file(1:il),'.',optimcycle
594 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
595 write(fname(1:80),'(2a,i10.10)')
596 & xx_efluxp_file(1:il),'.',optimcycle
597 end if
598
599 call active_read_xyz( fname, tmpfld3d, 1,
600 & doglobalread, ladinit, optimcycle,
601 & mythid, dummy)
602
603 xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
604 xx_comp_pert = xx_comp_ref + localEps
605 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
606
607 call active_write_xyz( fname, tmpfld3d, 1,
608 & optimcycle,
609 & mythid, dummy)
610
611 #endif /* ALLOW_EFLUXP0_CONTROL */
612
613 #ifdef ALLOW_HFLUXM_CONTROL
614 else if ( grdchkvarindex .eq. 24 ) then
615 il=ilnblnk( xx_hfluxm_file )
616 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
617 write(fname(1:80),'(3a,i10.10)')
618 & yadmark, xx_hfluxm_file(1:il),'.',optimcycle
619 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
620 write(fname(1:80),'(2a,i10.10)')
621 & xx_hfluxm_file(1:il),'.',optimcycle
622 end if
623 call active_read_xy( fname, tmpfld2d, icvrec,
624 & doglobalread, ladinit, optimcycle,
625 & mythid, dummy)
626 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
627 xx_comp_pert = xx_comp_ref + localEps
628 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
629 call active_write_xy( fname, tmpfld2d, icvrec,
630 & optimcycle,
631 & mythid, dummy)
632 #endif /* ALLOW_HFLUXM_CONTROL */
633
634 #ifdef ALLOW_PRECIP_CONTROL
635 else if ( grdchkvarindex .eq. 32 ) then
636 il=ilnblnk( xx_precip_file )
637 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
638 write(fname(1:80),'(3a,i10.10)')
639 & yadmark, xx_precip_file(1:il),'.',optimcycle
640 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
641 write(fname(1:80),'(2a,i10.10)')
642 & xx_precip_file(1:il),'.',optimcycle
643 end if
644 call active_read_xy( fname, tmpfld2d, icvrec,
645 & doglobalread, ladinit, optimcycle,
646 & mythid, dummy)
647 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
648 xx_comp_pert = xx_comp_ref + localEps
649 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
650 call active_write_xy( fname, tmpfld2d, icvrec,
651 & optimcycle,
652 & mythid, dummy)
653 #endif /* ALLOW_PRECIP_CONTROL */
654
655 #ifdef ALLOW_SWFLUX_CONTROL
656 else if ( grdchkvarindex .eq. 33 ) then
657 il=ilnblnk( xx_swflux_file )
658 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
659 write(fname(1:80),'(3a,i10.10)')
660 & yadmark, xx_swflux_file(1:il),'.',optimcycle
661 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
662 write(fname(1:80),'(2a,i10.10)')
663 & xx_swflux_file(1:il),'.',optimcycle
664 end if
665 call active_read_xy( fname, tmpfld2d, icvrec,
666 & doglobalread, ladinit, optimcycle,
667 & mythid, dummy)
668 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
669 xx_comp_pert = xx_comp_ref + localEps
670 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
671 call active_write_xy( fname, tmpfld2d, icvrec,
672 & optimcycle,
673 & mythid, dummy)
674 #endif /* ALLOW_SWFLUX_CONTROL */
675
676 #ifdef ALLOW_SWDOWN_CONTROL
677 else if ( grdchkvarindex .eq. 34 ) then
678 il=ilnblnk( xx_swdown_file )
679 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
680 write(fname(1:80),'(3a,i10.10)')
681 & yadmark, xx_swdown_file(1:il),'.',optimcycle
682 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
683 write(fname(1:80),'(2a,i10.10)')
684 & xx_swdown_file(1:il),'.',optimcycle
685 end if
686 call active_read_xy( fname, tmpfld2d, icvrec,
687 & doglobalread, ladinit, optimcycle,
688 & mythid, dummy)
689 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
690 xx_comp_pert = xx_comp_ref + localEps
691 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
692 call active_write_xy( fname, tmpfld2d, icvrec,
693 & optimcycle,
694 & mythid, dummy)
695 #endif /* ALLOW_SWDOWN_CONTROL */
696
697 #ifdef ALLOW_LWFLUX_CONTROL
698 else if ( grdchkvarindex .eq. 35 ) then
699 il=ilnblnk( xx_lwflux_file )
700 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
701 write(fname(1:80),'(3a,i10.10)')
702 & yadmark, xx_lwflux_file(1:il),'.',optimcycle
703 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
704 write(fname(1:80),'(2a,i10.10)')
705 & xx_lwflux_file(1:il),'.',optimcycle
706 end if
707 call active_read_xy( fname, tmpfld2d, icvrec,
708 & doglobalread, ladinit, optimcycle,
709 & mythid, dummy)
710 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
711 xx_comp_pert = xx_comp_ref + localEps
712 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
713 call active_write_xy( fname, tmpfld2d, icvrec,
714 & optimcycle,
715 & mythid, dummy)
716 #endif /* ALLOW_LWFLUX_CONTROL */
717
718 #ifdef ALLOW_LWDOWN_CONTROL
719 else if ( grdchkvarindex .eq. 36 ) then
720 il=ilnblnk( xx_lwdown_file )
721 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
722 write(fname(1:80),'(3a,i10.10)')
723 & yadmark, xx_lwdown_file(1:il),'.',optimcycle
724 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
725 write(fname(1:80),'(2a,i10.10)')
726 & xx_lwdown_file(1:il),'.',optimcycle
727 end if
728 call active_read_xy( fname, tmpfld2d, icvrec,
729 & doglobalread, ladinit, optimcycle,
730 & mythid, dummy)
731 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
732 xx_comp_pert = xx_comp_ref + localEps
733 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
734 call active_write_xy( fname, tmpfld2d, icvrec,
735 & optimcycle,
736 & mythid, dummy)
737 #endif /* ALLOW_LWDOWN_CONTROL */
738
739 #ifdef ALLOW_EVAP_CONTROL
740 else if ( grdchkvarindex .eq. 37 ) then
741 il=ilnblnk( xx_evap_file )
742 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
743 write(fname(1:80),'(3a,i10.10)')
744 & yadmark, xx_evap_file(1:il),'.',optimcycle
745 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
746 write(fname(1:80),'(2a,i10.10)')
747 & xx_evap_file(1:il),'.',optimcycle
748 end if
749 call active_read_xy( fname, tmpfld2d, icvrec,
750 & doglobalread, ladinit, optimcycle,
751 & mythid, dummy)
752 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
753 xx_comp_pert = xx_comp_ref + localEps
754 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
755 call active_write_xy( fname, tmpfld2d, icvrec,
756 & optimcycle,
757 & mythid, dummy)
758 #endif /* ALLOW_EVAP_CONTROL */
759
760 #ifdef ALLOW_SNOWPRECIP_CONTROL
761 else if ( grdchkvarindex .eq. 38 ) then
762 il=ilnblnk( xx_snowprecip_file )
763 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
764 write(fname(1:80),'(3a,i10.10)')
765 & yadmark, xx_snowprecip_file(1:il),'.',optimcycle
766 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
767 write(fname(1:80),'(2a,i10.10)')
768 & xx_snowprecip_file(1:il),'.',optimcycle
769 end if
770 call active_read_xy( fname, tmpfld2d, icvrec,
771 & doglobalread, ladinit, optimcycle,
772 & mythid, dummy)
773 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
774 xx_comp_pert = xx_comp_ref + localEps
775 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
776 call active_write_xy( fname, tmpfld2d, icvrec,
777 & optimcycle,
778 & mythid, dummy)
779 #endif /* ALLOW_SNOWPRECIP_CONTROL */
780
781 #ifdef ALLOW_APRESSURE_CONTROL
782 else if ( grdchkvarindex .eq. 39 ) then
783 il=ilnblnk( xx_apressure_file )
784 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
785 write(fname(1:80),'(3a,i10.10)')
786 & yadmark, xx_apressure_file(1:il),'.',optimcycle
787 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
788 write(fname(1:80),'(2a,i10.10)')
789 & xx_apressure_file(1:il),'.',optimcycle
790 end if
791 call active_read_xy( fname, tmpfld2d, icvrec,
792 & doglobalread, ladinit, optimcycle,
793 & mythid, dummy)
794 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
795 xx_comp_pert = xx_comp_ref + localEps
796 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
797 call active_write_xy( fname, tmpfld2d, icvrec,
798 & optimcycle,
799 & mythid, dummy)
800 #endif /* ALLOW_APRESSURE_CONTROL */
801
802 #ifdef ALLOW_RUNOFF_CONTROL
803 else if ( grdchkvarindex .eq. 40 ) then
804 il=ilnblnk( xx_runoff_file )
805 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
806 write(fname(1:80),'(3a,i10.10)')
807 & yadmark, xx_runoff_file(1:il),'.',optimcycle
808 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
809 write(fname(1:80),'(2a,i10.10)')
810 & xx_runoff_file(1:il),'.',optimcycle
811 end if
812 call active_read_xy( fname, tmpfld2d, icvrec,
813 & doglobalread, ladinit, optimcycle,
814 & mythid, dummy)
815 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
816 xx_comp_pert = xx_comp_ref + localEps
817 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
818 call active_write_xy( fname, tmpfld2d, icvrec,
819 & optimcycle,
820 & mythid, dummy)
821 #endif /* ALLOW_RUNOFF_CONTROL */
822
823 #ifdef ALLOW_SIAREA_CONTROL
824 else if ( grdchkvarindex .eq. 41 ) then
825 il=ilnblnk( xx_siarea_file )
826 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
827 write(fname(1:80),'(3a,i10.10)')
828 & yadmark, xx_siarea_file(1:il),'.',optimcycle
829 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
830 write(fname(1:80),'(2a,i10.10)')
831 & xx_siarea_file(1:il),'.',optimcycle
832 end if
833 call active_read_xy( fname, tmpfld2d, icvrec,
834 & doglobalread, ladinit, optimcycle,
835 & mythid, dummy)
836 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
837 xx_comp_pert = xx_comp_ref + localEps
838 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
839 call active_write_xy( fname, tmpfld2d, icvrec,
840 & optimcycle,
841 & mythid, dummy)
842 #endif /* ALLOW_SIAREA_CONTROL */
843
844 #ifdef ALLOW_SIHEFF_CONTROL
845 else if ( grdchkvarindex .eq. 42 ) then
846 il=ilnblnk( xx_siheff_file )
847 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
848 write(fname(1:80),'(3a,i10.10)')
849 & yadmark, xx_siheff_file(1:il),'.',optimcycle
850 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
851 write(fname(1:80),'(2a,i10.10)')
852 & xx_siheff_file(1:il),'.',optimcycle
853 end if
854 call active_read_xy( fname, tmpfld2d, icvrec,
855 & doglobalread, ladinit, optimcycle,
856 & mythid, dummy)
857 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
858 xx_comp_pert = xx_comp_ref + localEps
859 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
860 call active_write_xy( fname, tmpfld2d, icvrec,
861 & optimcycle,
862 & mythid, dummy)
863 #endif /* ALLOW_SIHEFF_CONTROL */
864
865 #ifdef ALLOW_SIHSNOW_CONTROL
866 else if ( grdchkvarindex .eq. 43 ) then
867 il=ilnblnk( xx_sihsnow_file )
868 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
869 write(fname(1:80),'(3a,i10.10)')
870 & yadmark, xx_sihsnow_file(1:il),'.',optimcycle
871 else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
872 write(fname(1:80),'(2a,i10.10)')
873 & xx_sihsnow_file(1:il),'.',optimcycle
874 end if
875 call active_read_xy( fname, tmpfld2d, icvrec,
876 & doglobalread, ladinit, optimcycle,
877 & mythid, dummy)
878 xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
879 xx_comp_pert = xx_comp_ref + localEps
880 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
881 call active_write_xy( fname, tmpfld2d, icvrec,
882 & optimcycle,
883 & mythid, dummy)
884 #endif /* ALLOW_SIHSNOW_CONTROL */
885
886 else
887 ce --> this index does not exist yet.
888 endif
889
890 #endif /* ALLOW_GRDCHK */
891
892 end
893

  ViewVC Help
Powered by ViewVC 1.1.22