/[MITgcm]/MITgcm_contrib/dgoldberg/depth_control_no_nsa/code/grdchk_getxx.F
ViewVC logotype

Annotation of /MITgcm_contrib/dgoldberg/depth_control_no_nsa/code/grdchk_getxx.F

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


Revision 1.1 - (hide annotations) (download)
Thu Dec 7 23:21:12 2017 UTC (7 years, 7 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
test case for depth control w/out cg2d_nsa

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

  ViewVC Help
Powered by ViewVC 1.1.22