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

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

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


Revision 1.5 - (hide annotations) (download)
Mon Sep 16 18:11:58 2002 UTC (21 years, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint46f_post, checkpoint46l_pre, checkpoint47d_pre, checkpoint47a_post, checkpoint47d_post, checkpoint46j_pre, checkpoint46j_post, checkpoint46k_post, checkpoint47b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint46g_post, checkpoint46i_post, checkpoint47, checkpoint46h_post
Changes since 1.4: +102 -38 lines
Enable tangent linear (forward mode) gradient checks:
o extended active file handling to g_... files
o added TANGENT_SIMULATION to theSimulationMode
o extended grdchk package accordingly

1 heimbach 1.5 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getxx.F,v 1.4 2002/07/13 02:55:58 heimbach Exp $
2 heimbach 1.2
3     #include "CTRL_CPPOPTIONS.h"
4    
5    
6     subroutine grdchk_getxx(
7     I icvrec,
8 heimbach 1.5 I theSimulationMode,
9 heimbach 1.2 I itile,
10     I jtile,
11     I layer,
12     I itilepos,
13     I jtilepos,
14     I xx_comp_ref,
15     I xx_comp_pert,
16 heimbach 1.5 I localEps,
17 heimbach 1.2 I mythid
18     & )
19    
20     c ==================================================================
21     c SUBROUTINE grdchk_getxx
22     c ==================================================================
23     c
24     c o Set component a component of the control vector; xx(loc)
25     c
26     c started: Christian Eckert eckert@mit.edu 08-Mar-2000
27     c continued: heimbach@mit.edu: 13-Jun-2001
28     c
29     c ==================================================================
30     c SUBROUTINE grdchk_getxx
31     c ==================================================================
32    
33     implicit none
34    
35     c == global variables ==
36    
37     #include "EEPARAMS.h"
38     #include "SIZE.h"
39     #include "ctrl.h"
40     #include "grdchk.h"
41     #include "optim.h"
42    
43     c == routine arguments ==
44    
45     integer icvrec
46 heimbach 1.5 integer theSimulationMode
47 heimbach 1.2 integer jtile
48     integer itile
49     integer layer
50     integer itilepos
51     integer jtilepos
52     _RL xx_comp_ref
53     _RL xx_comp_pert
54 heimbach 1.5 _RL localEps
55 heimbach 1.2 integer mythid
56    
57     #ifdef ALLOW_GRADIENT_CHECK
58     c == local variables ==
59    
60     integer il
61     integer dumiter
62     _RL dumtime
63     _RL dummy
64    
65     logical doglobalread
66     logical ladinit
67    
68     character*(80) fname
69    
70     c-- == external ==
71    
72     integer ilnblnk
73     external ilnblnk
74    
75     c-- == end of interface ==
76    
77     doglobalread = .false.
78     ladinit = .false.
79     dumiter = 0
80     dumtime = 0. _d 0
81    
82 heimbach 1.4 if ( grdchkvarindex .eq. 0 ) then
83     STOP 'GRDCHK INDEX 0 NOT ALLOWED'
84    
85 heimbach 1.2 #ifdef ALLOW_THETA0_CONTROL
86 heimbach 1.4 else if ( grdchkvarindex .eq. 1 ) then
87 heimbach 1.2 il=ilnblnk( xx_theta_file )
88     write(fname(1:80),'(80a)') ' '
89 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
90     write(fname(1:80),'(3a,i10.10)')
91     & yadmark, xx_theta_file(1:il),'.',optimcycle
92     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
93     write(fname(1:80),'(2a,i10.10)')
94     & xx_theta_file(1:il),'.',optimcycle
95     end if
96 heimbach 1.2
97     call active_read_xyz( fname, tmpfld3d, 1,
98     & doglobalread, ladinit, optimcycle,
99     & mythid, dummy)
100    
101     xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
102 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
103 heimbach 1.2 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
104    
105     call active_write_xyz( fname, tmpfld3d, 1,
106     & optimcycle,
107     & mythid, dummy)
108    
109     #endif /* ALLOW_THETA0_CONTROL */
110    
111     #ifdef ALLOW_SALT0_CONTROL
112     else if ( grdchkvarindex .eq. 2 ) then
113     il=ilnblnk( xx_salt_file )
114     write(fname(1:80),'(80a)') ' '
115 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
116     write(fname(1:80),'(3a,i10.10)')
117     & yadmark, xx_salt_file(1:il),'.',optimcycle
118     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
119     write(fname(1:80),'(2a,i10.10)')
120     & xx_salt_file(1:il),'.',optimcycle
121     end if
122 heimbach 1.2
123     call active_read_xyz( fname, tmpfld3d, 1,
124     & doglobalread, ladinit, optimcycle,
125     & mythid, dummy)
126    
127     xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
128 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
129 heimbach 1.2 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
130    
131     call active_write_xyz( fname, tmpfld3d, 1,
132     & optimcycle,
133     & mythid, dummy)
134    
135     #endif /* ALLOW_SALT0_CONTROL */
136    
137     #ifdef ALLOW_HFLUX_CONTROL
138     else if ( grdchkvarindex .eq. 3 ) then
139     il=ilnblnk( xx_hflux_file )
140     write(fname(1:80),'(80a)') ' '
141 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
142     write(fname(1:80),'(3a,i10.10)')
143     & yadmark, xx_hflux_file(1:il),'.',optimcycle
144     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
145     write(fname(1:80),'(2a,i10.10)')
146     & xx_hflux_file(1:il),'.',optimcycle
147     end if
148 heimbach 1.2
149     call active_read_xy( fname, tmpfld2d, icvrec,
150     & doglobalread, ladinit, optimcycle,
151     & mythid, dummy)
152    
153     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
154 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
155 heimbach 1.2 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
156    
157     call active_write_xy( fname, tmpfld2d, icvrec,
158     & optimcycle,
159     & mythid, dummy)
160    
161     #endif /* ALLOW_HFLUX_CONTROL */
162    
163     #ifdef ALLOW_SFLUX_CONTROL
164     else if ( grdchkvarindex .eq. 4 ) then
165     il=ilnblnk( xx_sflux_file )
166     write(fname(1:80),'(80a)') ' '
167 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
168     write(fname(1:80),'(3a,i10.10)')
169     & yadmark, xx_sflux_file(1:il),'.',optimcycle
170     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
171     write(fname(1:80),'(2a,i10.10)')
172     & xx_sflux_file(1:il),'.',optimcycle
173     end if
174 heimbach 1.2
175     call active_read_xy( fname, tmpfld2d, icvrec,
176     & doglobalread, ladinit, optimcycle,
177     & mythid, dummy)
178    
179     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
180 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
181 heimbach 1.2 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
182    
183     call active_write_xy( fname, tmpfld2d, icvrec,
184     & optimcycle,
185     & mythid, dummy)
186    
187     #endif /* ALLOW_SFLUX_CONTROL */
188    
189     #ifdef ALLOW_USTRESS_CONTROL
190     else if ( grdchkvarindex .eq. 5 ) then
191     il=ilnblnk( xx_tauu_file )
192     write(fname(1:80),'(80a)') ' '
193 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
194     write(fname(1:80),'(3a,i10.10)')
195     & yadmark, xx_tauu_file(1:il),'.',optimcycle
196     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
197     write(fname(1:80),'(2a,i10.10)')
198     & xx_tauu_file(1:il),'.',optimcycle
199     end if
200 heimbach 1.2
201     call active_read_xy( fname, tmpfld2d, icvrec,
202     & doglobalread, ladinit, optimcycle,
203     & mythid, dummy)
204    
205     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
206 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
207 heimbach 1.2 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
208    
209     call active_write_xy( fname, tmpfld2d, icvrec,
210     & optimcycle,
211     & mythid, dummy)
212    
213     #endif /* ALLOW_USTRESS_CONTROL */
214    
215     #ifdef ALLOW_VSTRESS_CONTROL
216     else if ( grdchkvarindex .eq. 6 ) then
217     il=ilnblnk( xx_tauv_file )
218     write(fname(1:80),'(80a)') ' '
219 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
220     write(fname(1:80),'(3a,i10.10)')
221     & yadmark, xx_tauv_file(1:il),'.',optimcycle
222     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
223     write(fname(1:80),'(2a,i10.10)')
224     & xx_tauv_file(1:il),'.',optimcycle
225     end if
226 heimbach 1.2
227     call active_read_xy( fname, tmpfld2d, icvrec,
228     & doglobalread, ladinit, optimcycle,
229     & mythid, dummy)
230    
231     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
232 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
233 heimbach 1.2 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
234    
235     call active_write_xy( fname, tmpfld2d, icvrec,
236     & optimcycle,
237     & mythid, dummy)
238    
239     #endif /* ALLOW_VSTRESS_CONTROL */
240    
241     #ifdef ALLOW_TR10_CONTROL
242     else if ( grdchkvarindex .eq. 17 ) then
243     il=ilnblnk( xx_tr1_file )
244     write(fname(1:80),'(80a)') ' '
245 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
246     write(fname(1:80),'(3a,i10.10)')
247     & yadmark, xx_tr1_file(1:il),'.',optimcycle
248     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
249     write(fname(1:80),'(2a,i10.10)')
250     & xx_tr1_file(1:il),'.',optimcycle
251     end if
252 heimbach 1.2
253     call active_read_xyz( fname, tmpfld3d, icvrec,
254     & doglobalread, ladinit, optimcycle,
255     & mythid, dummy)
256    
257     xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
258 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
259 heimbach 1.2 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
260    
261     call active_write_xyz( fname, tmpfld3d, icvrec,
262     & optimcycle,
263     & mythid, dummy)
264    
265     #endif /* ALLOW_TR10_CONTROL */
266    
267     #ifdef ALLOW_SST0_CONTROL
268     else if ( grdchkvarindex .eq. 18 ) then
269     il=ilnblnk( xx_sst_file )
270     write(fname(1:80),'(80a)') ' '
271 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
272     write(fname(1:80),'(3a,i10.10)')
273     & yadmark, xx_sst_file(1:il),'.',optimcycle
274     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
275     write(fname(1:80),'(2a,i10.10)')
276     & xx_sst_file(1:il),'.',optimcycle
277     end if
278 heimbach 1.2
279     call active_read_xy( fname, tmpfld2d, icvrec,
280     & doglobalread, ladinit, optimcycle,
281     & mythid, dummy)
282    
283     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
284 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
285 heimbach 1.2 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
286    
287     call active_write_xy( fname, tmpfld2d, icvrec,
288     & optimcycle,
289     & mythid, dummy)
290    
291     #endif /* ALLOW_SST0_CONTROL */
292    
293     #ifdef ALLOW_SSS0_CONTROL
294     else if ( grdchkvarindex .eq. 19 ) then
295     il=ilnblnk( xx_sss_file )
296     write(fname(1:80),'(80a)') ' '
297 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
298     write(fname(1:80),'(3a,i10.10)')
299     & yadmark, xx_sss_file(1:il),'.',optimcycle
300     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
301     write(fname(1:80),'(2a,i10.10)')
302     & xx_sss_file(1:il),'.',optimcycle
303     end if
304 heimbach 1.2
305     call active_read_xy( fname, tmpfld2d, icvrec,
306     & doglobalread, ladinit, optimcycle,
307     & mythid, dummy)
308    
309     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
310 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
311 heimbach 1.2 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
312    
313     call active_write_xy( fname, tmpfld2d, icvrec,
314     & optimcycle,
315     & mythid, dummy)
316    
317     #endif /* ALLOW_SSS0_CONTROL */
318    
319 heimbach 1.3 #ifdef ALLOW_HFACC_CONTROL
320     else if ( grdchkvarindex .eq. 20 ) then
321     il=ilnblnk( xx_hfacc_file )
322     write(fname(1:80),'(80a)') ' '
323 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
324     write(fname(1:80),'(3a,i10.10)')
325     & yadmark, xx_hfacc_file(1:il),'.',optimcycle
326     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
327     write(fname(1:80),'(2a,i10.10)')
328     & xx_hfacc_file(1:il),'.',optimcycle
329     end if
330 heimbach 1.3
331     #ifdef ALLOW_HFACC3D_CONTROL
332    
333     call active_read_xyz( fname, tmpfld3d, icvrec,
334     & doglobalread, ladinit, optimcycle,
335     & mythid, dummy)
336    
337     xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
338 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
339 heimbach 1.3 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
340    
341     call active_write_xyz( fname, tmpfld3d, icvrec,
342     & optimcycle,
343     & mythid, dummy)
344    
345     #else
346    
347     call active_read_xy( fname, tmpfld2d, icvrec,
348     & doglobalread, ladinit, optimcycle,
349     & mythid, dummy)
350    
351     xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile )
352 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
353 heimbach 1.3 tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert
354    
355     call active_write_xy( fname, tmpfld2d, icvrec,
356     & optimcycle,
357     & mythid, dummy)
358    
359     #endif /* ALLOW_HFACC3D_CONTROL */
360     #endif /* ALLOW_HFACC_CONTROL */
361 heimbach 1.4
362     #ifdef ALLOW_EFLUXY0_CONTROL
363     else if ( grdchkvarindex .eq. 21 ) then
364     il=ilnblnk( xx_efluxy_file )
365     write(fname(1:80),'(80a)') ' '
366 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
367     write(fname(1:80),'(3a,i10.10)')
368     & yadmark, xx_efluxy_file(1:il),'.',optimcycle
369     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
370     write(fname(1:80),'(2a,i10.10)')
371     & xx_efluxy_file(1:il),'.',optimcycle
372     end if
373 heimbach 1.4
374     call active_read_xyz( fname, tmpfld3d, 1,
375     & doglobalread, ladinit, optimcycle,
376     & mythid, dummy)
377    
378     xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
379 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
380 heimbach 1.4 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
381    
382     call active_write_xyz( fname, tmpfld3d, 1,
383     & optimcycle,
384     & mythid, dummy)
385    
386     #endif /* ALLOW_EFLUXY0_CONTROL */
387    
388     #ifdef ALLOW_EFLUXP0_CONTROL
389     else if ( grdchkvarindex .eq. 22 ) then
390     il=ilnblnk( xx_efluxp_file )
391     write(fname(1:80),'(80a)') ' '
392 heimbach 1.5 if ( theSimulationMode .EQ. TANGENT_SIMULATION ) then
393     write(fname(1:80),'(3a,i10.10)')
394     & yadmark, xx_efluxp_file(1:il),'.',optimcycle
395     else if ( theSimulationMode .EQ. FORWARD_SIMULATION ) then
396     write(fname(1:80),'(2a,i10.10)')
397     & xx_efluxp_file(1:il),'.',optimcycle
398     end if
399 heimbach 1.4
400     call active_read_xyz( fname, tmpfld3d, 1,
401     & doglobalread, ladinit, optimcycle,
402     & mythid, dummy)
403    
404     xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
405 heimbach 1.5 xx_comp_pert = xx_comp_ref + localEps
406 heimbach 1.4 tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert
407    
408     call active_write_xyz( fname, tmpfld3d, 1,
409     & optimcycle,
410     & mythid, dummy)
411    
412     #endif /* ALLOW_EFLUXP0_CONTROL */
413    
414 heimbach 1.2 else
415     ce --> this index does not exist yet.
416     endif
417    
418     #endif /* ALLOW_GRADIENT_CHECK */
419    
420     end
421    

  ViewVC Help
Powered by ViewVC 1.1.22