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

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

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


Revision 1.8 - (hide annotations) (download)
Tue Jun 24 16:08:45 2003 UTC (20 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint51, checkpoint51b_pre, checkpoint51b_post, checkpoint51c_post, checkpoint51a_post
Changes since 1.7: +61 -1 lines
Merging for c51 vs. e34

1 heimbach 1.8 C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_getadxx.F,v 1.2.6.6 2003/06/20 19:38:59 heimbach Exp $
2 heimbach 1.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 heimbach 1.7 I xx_comp,
14 heimbach 1.2 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 heimbach 1.7 _RL xx_comp
49 heimbach 1.2 integer mythid
50    
51     #ifdef ALLOW_GRADIENT_CHECK
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     c-- == external ==
65    
66     integer ilnblnk
67     external ilnblnk
68    
69     c-- == end of interface ==
70    
71     doglobalread = .false.
72     ladinit = .false.
73     dumiter = 0
74     dumtime = 0. _d 0
75    
76 heimbach 1.4 if ( grdchkvarindex .eq. 0 ) then
77     STOP 'GRDCHK INDEX 0 NOT ALLOWED'
78    
79 heimbach 1.2 #ifdef ALLOW_THETA0_CONTROL
80 heimbach 1.4 else if ( grdchkvarindex .eq. 1 ) then
81 heimbach 1.2 il=ilnblnk( xx_theta_file )
82     write(fname(1:80),'(80a)') ' '
83     write(fname(1:80),'(3a,i10.10)')
84 heimbach 1.7 & yadmark, xx_theta_file(1:il),'.',optimcycle
85 heimbach 1.2
86     call active_read_xyz( fname, tmpfld3d, 1,
87     & doglobalread, ladinit, optimcycle,
88     & mythid, dummy)
89    
90 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
91 heimbach 1.2
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 heimbach 1.7 & yadmark, xx_salt_file(1:il),'.',optimcycle
100 heimbach 1.2
101     call active_read_xyz( fname, tmpfld3d, 1,
102     & doglobalread, ladinit, optimcycle,
103     & mythid, dummy)
104    
105 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
106 heimbach 1.2
107     #endif /* ALLOW_SALT0_CONTROL */
108    
109     #ifdef ALLOW_HFLUX_CONTROL
110     else if ( grdchkvarindex .eq. 3 ) then
111     il=ilnblnk( xx_hflux_file )
112     write(fname(1:80),'(80a)') ' '
113     write(fname(1:80),'(3a,i10.10)')
114 heimbach 1.7 & yadmark, xx_hflux_file(1:il),'.',optimcycle
115 heimbach 1.2
116     call active_read_xy( fname, tmpfld2d, icvrec,
117     & doglobalread, ladinit, optimcycle,
118     & mythid, dummy)
119    
120 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
121 heimbach 1.2
122     #endif /* ALLOW_HFLUX_CONTROL */
123    
124     #ifdef ALLOW_SFLUX_CONTROL
125     else if ( grdchkvarindex .eq. 4 ) then
126     il=ilnblnk( xx_sflux_file )
127     write(fname(1:80),'(80a)') ' '
128     write(fname(1:80),'(3a,i10.10)')
129 heimbach 1.7 & yadmark, xx_sflux_file(1:il),'.',optimcycle
130 heimbach 1.2
131     call active_read_xy( fname, tmpfld2d, icvrec,
132     & doglobalread, ladinit, optimcycle,
133     & mythid, dummy)
134    
135 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
136 heimbach 1.2
137     #endif /* ALLOW_SFLUX_CONTROL */
138    
139     #ifdef ALLOW_USTRESS_CONTROL
140     else if ( grdchkvarindex .eq. 5 ) then
141     il=ilnblnk( xx_tauu_file )
142     write(fname(1:80),'(80a)') ' '
143     write(fname(1:80),'(3a,i10.10)')
144 heimbach 1.7 & yadmark, xx_tauu_file(1:il),'.',optimcycle
145 heimbach 1.2
146     call active_read_xy( fname, tmpfld2d, icvrec,
147     & doglobalread, ladinit, optimcycle,
148     & mythid, dummy)
149    
150 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
151 heimbach 1.2
152     #endif /* ALLOW_USTRESS_CONTROL */
153    
154     #ifdef ALLOW_VSTRESS_CONTROL
155     else if ( grdchkvarindex .eq. 6 ) then
156     il=ilnblnk( xx_tauv_file )
157     write(fname(1:80),'(80a)') ' '
158     write(fname(1:80),'(3a,i10.10)')
159 heimbach 1.7 & yadmark, xx_tauv_file(1:il),'.',optimcycle
160 heimbach 1.2
161     call active_read_xy( fname, tmpfld2d, icvrec,
162     & doglobalread, ladinit, optimcycle,
163     & mythid, dummy)
164    
165 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
166 heimbach 1.2
167     #endif /* ALLOW_VSTRESS_CONTROL */
168    
169 heimbach 1.7 #ifdef ALLOW_ATEMP_CONTROL
170     else if ( grdchkvarindex .eq. 7 ) then
171     il=ilnblnk( xx_atemp_file )
172     write(fname(1:80),'(80a)') ' '
173     write(fname(1:80),'(3a,i10.10)')
174     & yadmark, xx_atemp_file(1:il),'.',optimcycle
175    
176     call active_read_xy( fname, tmpfld2d, icvrec,
177     & doglobalread, ladinit, optimcycle,
178     & mythid, dummy)
179    
180     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
181    
182     #endif /* ALLOW_ATEMP_CONTROL */
183    
184     #ifdef ALLOW_AQH_CONTROL
185     else if ( grdchkvarindex .eq. 8 ) then
186     il=ilnblnk( xx_aqh_file )
187     write(fname(1:80),'(80a)') ' '
188     write(fname(1:80),'(3a,i10.10)')
189     & yadmark, xx_aqh_file(1:il),'.',optimcycle
190    
191     call active_read_xy( fname, tmpfld2d, icvrec,
192     & doglobalread, ladinit, optimcycle,
193     & mythid, dummy)
194    
195     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
196    
197     #endif /* ALLOW_AQH_CONTROL */
198    
199     #ifdef ALLOW_UWIND_CONTROL
200     else if ( grdchkvarindex .eq. 9 ) then
201     il=ilnblnk( xx_uwind_file )
202     write(fname(1:80),'(80a)') ' '
203     write(fname(1:80),'(3a,i10.10)')
204     & yadmark, xx_uwind_file(1:il),'.',optimcycle
205    
206     call active_read_xy( fname, tmpfld2d, icvrec,
207     & doglobalread, ladinit, optimcycle,
208     & mythid, dummy)
209    
210     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
211    
212     #endif /* ALLOW_UWIND_CONTROL */
213    
214     #ifdef ALLOW_VWIND_CONTROL
215     else if ( grdchkvarindex .eq. 10 ) then
216     il=ilnblnk( xx_vwind_file )
217     write(fname(1:80),'(80a)') ' '
218     write(fname(1:80),'(3a,i10.10)')
219     & yadmark, xx_vwind_file(1:il),'.',optimcycle
220    
221     call active_read_xy( fname, tmpfld2d, icvrec,
222     & doglobalread, ladinit, optimcycle,
223     & mythid, dummy)
224    
225     xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
226    
227     #endif /* ALLOW_VWIND_CONTROL */
228 heimbach 1.8
229     #ifdef ALLOW_OBCSN_CONTROL
230     else if ( grdchkvarindex .eq. 11 ) then
231     il=ilnblnk( xx_obcsn_file )
232     write(fname(1:80),'(80a)') ' '
233     write(fname(1:80),'(3a,i10.10)')
234     & yadmark, xx_obcsn_file(1:il),'.',optimcycle
235    
236     call active_read_xz( fname, tmpfldxz, icvrec,
237     & doglobalread, ladinit, optimcycle,
238     & mythid, dummy)
239    
240     xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
241    
242     #endif /* ALLOW_OBCSN_CONTROL */
243    
244     #ifdef ALLOW_OBCSS_CONTROL
245     else if ( grdchkvarindex .eq. 12 ) then
246     il=ilnblnk( xx_obcss_file )
247     write(fname(1:80),'(80a)') ' '
248     write(fname(1:80),'(3a,i10.10)')
249     & yadmark, xx_obcss_file(1:il),'.',optimcycle
250    
251     call active_read_xz( fname, tmpfldxz, icvrec,
252     & doglobalread, ladinit, optimcycle,
253     & mythid, dummy)
254    
255     xx_comp = tmpfldxz( itilepos,layer,itile,jtile )
256    
257     #endif /* ALLOW_OBCSS_CONTROL */
258    
259     #ifdef ALLOW_OBCSW_CONTROL
260     else if ( grdchkvarindex .eq. 13 ) then
261     il=ilnblnk( xx_obcsw_file )
262     write(fname(1:80),'(80a)') ' '
263     write(fname(1:80),'(3a,i10.10)')
264     & yadmark, xx_obcsw_file(1:il),'.',optimcycle
265    
266     call active_read_yz( fname, tmpfldyz, icvrec,
267     & doglobalread, ladinit, optimcycle,
268     & mythid, dummy)
269    
270     xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
271    
272     #endif /* ALLOW_OBCSW_CONTROL */
273    
274     #ifdef ALLOW_OBCSE_CONTROL
275     else if ( grdchkvarindex .eq. 14 ) then
276     il=ilnblnk( xx_obcse_file )
277     write(fname(1:80),'(80a)') ' '
278     write(fname(1:80),'(3a,i10.10)')
279     & yadmark, xx_obcse_file(1:il),'.',optimcycle
280    
281     call active_read_yz( fname, tmpfldyz, icvrec,
282     & doglobalread, ladinit, optimcycle,
283     & mythid, dummy)
284    
285     xx_comp = tmpfldyz( jtilepos,layer,itile,jtile )
286    
287     #endif /* ALLOW_OBCSE_CONTROL */
288 heimbach 1.7
289 heimbach 1.2 #ifdef ALLOW_TR10_CONTROL
290     else if ( grdchkvarindex .eq. 17 ) then
291     il=ilnblnk( xx_tr1_file )
292     write(fname(1:80),'(80a)') ' '
293     write(fname(1:80),'(3a,i10.10)')
294 heimbach 1.7 & yadmark, xx_tr1_file(1:il),'.',optimcycle
295 heimbach 1.2
296     call active_read_xyz( fname, tmpfld3d, 1,
297     & doglobalread, ladinit, optimcycle,
298     & mythid, dummy)
299    
300 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
301 heimbach 1.2
302     #endif /* ALLOW_TR10_CONTROL */
303    
304     #ifdef ALLOW_SST0_CONTROL
305     else if ( grdchkvarindex .eq. 18 ) then
306     il=ilnblnk( xx_sst_file )
307     write(fname(1:80),'(80a)') ' '
308     write(fname(1:80),'(3a,i10.10)')
309 heimbach 1.7 & yadmark, xx_sst_file(1:il),'.',optimcycle
310 heimbach 1.2
311     call active_read_xy( fname, tmpfld2d, icvrec,
312     & doglobalread, ladinit, optimcycle,
313     & mythid, dummy)
314    
315 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
316 heimbach 1.2
317     #endif /* ALLOW_SST0_CONTROL */
318    
319     #ifdef ALLOW_SSS0_CONTROL
320     else if ( grdchkvarindex .eq. 19 ) then
321     il=ilnblnk( xx_sss_file )
322     write(fname(1:80),'(80a)') ' '
323     write(fname(1:80),'(3a,i10.10)')
324 heimbach 1.7 & yadmark, xx_sss_file(1:il),'.',optimcycle
325 heimbach 1.2
326     call active_read_xy( fname, tmpfld2d, icvrec,
327     & doglobalread, ladinit, optimcycle,
328     & mythid, dummy)
329    
330 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
331 heimbach 1.2
332     #endif /* ALLOW_SSS0_CONTROL */
333 heimbach 1.3
334     #ifdef ALLOW_HFACC_CONTROL
335     else if ( grdchkvarindex .eq. 20 ) then
336     il=ilnblnk( xx_hfacc_file )
337     write(fname(1:80),'(80a)') ' '
338     write(fname(1:80),'(3a,i10.10)')
339 heimbach 1.7 & yadmark, xx_hfacc_file(1:il),'.',optimcycle
340 heimbach 1.3
341     #ifdef ALLOW_HFACC3D_CONTROL
342    
343     call active_read_xyz( fname, tmpfld3d, icvrec,
344     & doglobalread, ladinit, optimcycle,
345     & mythid, dummy)
346    
347 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
348 heimbach 1.3
349     #else
350    
351     call active_read_xy( fname, tmpfld2d, icvrec,
352     & doglobalread, ladinit, optimcycle,
353     & mythid, dummy)
354    
355 heimbach 1.7 xx_comp = tmpfld2d( itilepos,jtilepos,itile,jtile )
356 heimbach 1.3
357     #endif /* ALLOW_HFACC3D_CONTROL */
358     #endif /* ALLOW_HFACC_CONTROL */
359 heimbach 1.4
360     #ifdef ALLOW_EFLUXY0_CONTROL
361     else if ( grdchkvarindex .eq. 21 ) then
362     il=ilnblnk( xx_efluxy_file )
363     write(fname(1:80),'(80a)') ' '
364     write(fname(1:80),'(3a,i10.10)')
365 heimbach 1.7 & yadmark, xx_efluxy_file(1:il),'.',optimcycle
366 heimbach 1.4
367     call active_read_xyz( fname, tmpfld3d, 1,
368     & doglobalread, ladinit, optimcycle,
369     & mythid, dummy)
370    
371 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
372 heimbach 1.4
373     #endif /* ALLOW_EFLUXY0_CONTROL */
374    
375     #ifdef ALLOW_EFLUXP0_CONTROL
376     else if ( grdchkvarindex .eq. 22 ) then
377     il=ilnblnk( xx_efluxp_file )
378     write(fname(1:80),'(80a)') ' '
379     write(fname(1:80),'(3a,i10.10)')
380 heimbach 1.7 & yadmark, xx_efluxp_file(1:il),'.',optimcycle
381 heimbach 1.4
382     call active_read_xyz( fname, tmpfld3d, 1,
383     & doglobalread, ladinit, optimcycle,
384     & mythid, dummy)
385    
386 heimbach 1.7 xx_comp = tmpfld3d( itilepos,jtilepos,layer,itile,jtile )
387 heimbach 1.4
388     #endif /* ALLOW_EFLUXP0_CONTROL */
389 heimbach 1.2
390     else
391     ce --> this index does not exist yet.
392     endif
393    
394     #endif /* ALLOW_GRADIENT_CHECK */
395    
396     end
397    

  ViewVC Help
Powered by ViewVC 1.1.22