1 |
C $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/ctrl/ctrl_setxx.F,v 1.4 2001/02/02 19:23:35 heimbach Exp $ |
2 |
|
3 |
#include "CTRL_CPPOPTIONS.h" |
4 |
|
5 |
|
6 |
subroutine grdchk_getxx( |
7 |
I icvrec, |
8 |
I itile, |
9 |
I jtile, |
10 |
I layer, |
11 |
I itilepos, |
12 |
I jtilepos, |
13 |
I xx_comp_ref, |
14 |
I xx_comp_pert, |
15 |
I mythid |
16 |
& ) |
17 |
|
18 |
c ================================================================== |
19 |
c SUBROUTINE grdchk_getxx |
20 |
c ================================================================== |
21 |
c |
22 |
c o Set component a component of the control vector; xx(loc) |
23 |
c |
24 |
c started: Christian Eckert eckert@mit.edu 08-Mar-2000 |
25 |
c continued: heimbach@mit.edu: 13-Jun-2001 |
26 |
c |
27 |
c ================================================================== |
28 |
c SUBROUTINE grdchk_getxx |
29 |
c ================================================================== |
30 |
|
31 |
implicit none |
32 |
|
33 |
c == global variables == |
34 |
|
35 |
#include "EEPARAMS.h" |
36 |
#include "SIZE.h" |
37 |
#include "ctrl.h" |
38 |
#include "grdchk.h" |
39 |
#include "optim.h" |
40 |
|
41 |
c == routine arguments == |
42 |
|
43 |
integer icvrec |
44 |
integer jtile |
45 |
integer itile |
46 |
integer layer |
47 |
integer itilepos |
48 |
integer jtilepos |
49 |
_RL xx_comp_ref |
50 |
_RL xx_comp_pert |
51 |
integer mythid |
52 |
|
53 |
#ifdef ALLOW_GRADIENT_CHECK |
54 |
c == local variables == |
55 |
|
56 |
integer il |
57 |
integer dumiter |
58 |
_RL dumtime |
59 |
_RL dummy |
60 |
|
61 |
logical doglobalread |
62 |
logical ladinit |
63 |
|
64 |
character*(80) fname |
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. 1 ) then |
79 |
#ifdef ALLOW_THETA0_CONTROL |
80 |
il=ilnblnk( xx_theta_file ) |
81 |
write(fname(1:80),'(80a)') ' ' |
82 |
write(fname(1:80),'(2a,i10.10)') |
83 |
& xx_theta_file(1:il),'.',optimcycle |
84 |
|
85 |
call active_read_xyz( fname, tmpfld3d, 1, |
86 |
& doglobalread, ladinit, optimcycle, |
87 |
& mythid, dummy) |
88 |
|
89 |
xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) |
90 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
91 |
tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert |
92 |
|
93 |
call active_write_xyz( fname, tmpfld3d, 1, |
94 |
& optimcycle, |
95 |
& mythid, dummy) |
96 |
|
97 |
#endif /* ALLOW_THETA0_CONTROL */ |
98 |
|
99 |
#ifdef ALLOW_SALT0_CONTROL |
100 |
else if ( grdchkvarindex .eq. 2 ) then |
101 |
il=ilnblnk( xx_salt_file ) |
102 |
write(fname(1:80),'(80a)') ' ' |
103 |
write(fname(1:80),'(2a,i10.10)') |
104 |
& xx_salt_file(1:il),'.',optimcycle |
105 |
|
106 |
call active_read_xyz( fname, tmpfld3d, 1, |
107 |
& doglobalread, ladinit, optimcycle, |
108 |
& mythid, dummy) |
109 |
|
110 |
xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) |
111 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
112 |
tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert |
113 |
|
114 |
call active_write_xyz( fname, tmpfld3d, 1, |
115 |
& optimcycle, |
116 |
& mythid, dummy) |
117 |
|
118 |
#endif /* ALLOW_SALT0_CONTROL */ |
119 |
|
120 |
#ifdef ALLOW_HFLUX_CONTROL |
121 |
else if ( grdchkvarindex .eq. 3 ) then |
122 |
il=ilnblnk( xx_hflux_file ) |
123 |
write(fname(1:80),'(80a)') ' ' |
124 |
write(fname(1:80),'(2a,i10.10)') |
125 |
& xx_hflux_file(1:il),'.',optimcycle |
126 |
|
127 |
call active_read_xy( fname, tmpfld2d, icvrec, |
128 |
& doglobalread, ladinit, optimcycle, |
129 |
& mythid, dummy) |
130 |
|
131 |
xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile ) |
132 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
133 |
tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert |
134 |
|
135 |
call active_write_xy( fname, tmpfld2d, icvrec, |
136 |
& optimcycle, |
137 |
& mythid, dummy) |
138 |
|
139 |
#endif /* ALLOW_HFLUX_CONTROL */ |
140 |
|
141 |
#ifdef ALLOW_SFLUX_CONTROL |
142 |
else if ( grdchkvarindex .eq. 4 ) then |
143 |
il=ilnblnk( xx_sflux_file ) |
144 |
write(fname(1:80),'(80a)') ' ' |
145 |
write(fname(1:80),'(2a,i10.10)') |
146 |
& xx_sflux_file(1:il),'.',optimcycle |
147 |
|
148 |
call active_read_xy( fname, tmpfld2d, icvrec, |
149 |
& doglobalread, ladinit, optimcycle, |
150 |
& mythid, dummy) |
151 |
|
152 |
xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile ) |
153 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
154 |
tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert |
155 |
|
156 |
call active_write_xy( fname, tmpfld2d, icvrec, |
157 |
& optimcycle, |
158 |
& mythid, dummy) |
159 |
|
160 |
#endif /* ALLOW_SFLUX_CONTROL */ |
161 |
|
162 |
#ifdef ALLOW_USTRESS_CONTROL |
163 |
else if ( grdchkvarindex .eq. 5 ) then |
164 |
il=ilnblnk( xx_tauu_file ) |
165 |
write(fname(1:80),'(80a)') ' ' |
166 |
write(fname(1:80),'(2a,i10.10)') |
167 |
& xx_tauu_file(1:il),'.',optimcycle |
168 |
|
169 |
call active_read_xy( fname, tmpfld2d, icvrec, |
170 |
& doglobalread, ladinit, optimcycle, |
171 |
& mythid, dummy) |
172 |
|
173 |
xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile ) |
174 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
175 |
tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert |
176 |
|
177 |
call active_write_xy( fname, tmpfld2d, icvrec, |
178 |
& optimcycle, |
179 |
& mythid, dummy) |
180 |
|
181 |
#endif /* ALLOW_USTRESS_CONTROL */ |
182 |
|
183 |
#ifdef ALLOW_VSTRESS_CONTROL |
184 |
else if ( grdchkvarindex .eq. 6 ) then |
185 |
il=ilnblnk( xx_tauv_file ) |
186 |
write(fname(1:80),'(80a)') ' ' |
187 |
write(fname(1:80),'(2a,i10.10)') |
188 |
& xx_tauv_file(1:il),'.',optimcycle |
189 |
|
190 |
call active_read_xy( fname, tmpfld2d, icvrec, |
191 |
& doglobalread, ladinit, optimcycle, |
192 |
& mythid, dummy) |
193 |
|
194 |
xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile ) |
195 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
196 |
tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert |
197 |
|
198 |
call active_write_xy( fname, tmpfld2d, icvrec, |
199 |
& optimcycle, |
200 |
& mythid, dummy) |
201 |
|
202 |
#endif /* ALLOW_VSTRESS_CONTROL */ |
203 |
|
204 |
#ifdef ALLOW_TR10_CONTROL |
205 |
else if ( grdchkvarindex .eq. 17 ) then |
206 |
il=ilnblnk( xx_tr1_file ) |
207 |
write(fname(1:80),'(80a)') ' ' |
208 |
write(fname(1:80),'(2a,i10.10)') |
209 |
& xx_tr1_file(1:il),'.',optimcycle |
210 |
|
211 |
call active_read_xyz( fname, tmpfld3d, icvrec, |
212 |
& doglobalread, ladinit, optimcycle, |
213 |
& mythid, dummy) |
214 |
|
215 |
xx_comp_ref = tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) |
216 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
217 |
tmpfld3d( itilepos,jtilepos,layer,itile,jtile ) = xx_comp_pert |
218 |
|
219 |
call active_write_xyz( fname, tmpfld3d, icvrec, |
220 |
& optimcycle, |
221 |
& mythid, dummy) |
222 |
|
223 |
#endif /* ALLOW_TR10_CONTROL */ |
224 |
|
225 |
#ifdef ALLOW_SST0_CONTROL |
226 |
else if ( grdchkvarindex .eq. 18 ) then |
227 |
il=ilnblnk( xx_sst_file ) |
228 |
write(fname(1:80),'(80a)') ' ' |
229 |
write(fname(1:80),'(2a,i10.10)') |
230 |
& xx_sst_file(1:il),'.',optimcycle |
231 |
|
232 |
call active_read_xy( fname, tmpfld2d, icvrec, |
233 |
& doglobalread, ladinit, optimcycle, |
234 |
& mythid, dummy) |
235 |
|
236 |
xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile ) |
237 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
238 |
tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert |
239 |
|
240 |
call active_write_xy( fname, tmpfld2d, icvrec, |
241 |
& optimcycle, |
242 |
& mythid, dummy) |
243 |
|
244 |
#endif /* ALLOW_SST0_CONTROL */ |
245 |
|
246 |
#ifdef ALLOW_SSS0_CONTROL |
247 |
else if ( grdchkvarindex .eq. 19 ) then |
248 |
il=ilnblnk( xx_sss_file ) |
249 |
write(fname(1:80),'(80a)') ' ' |
250 |
write(fname(1:80),'(2a,i10.10)') |
251 |
& xx_sss_file(1:il),'.',optimcycle |
252 |
|
253 |
call active_read_xy( fname, tmpfld2d, icvrec, |
254 |
& doglobalread, ladinit, optimcycle, |
255 |
& mythid, dummy) |
256 |
|
257 |
xx_comp_ref = tmpfld2d( itilepos,jtilepos,itile,jtile ) |
258 |
xx_comp_pert = xx_comp_ref + grdchk_eps |
259 |
tmpfld2d( itilepos,jtilepos,itile,jtile ) = xx_comp_pert |
260 |
|
261 |
call active_write_xy( fname, tmpfld2d, icvrec, |
262 |
& optimcycle, |
263 |
& mythid, dummy) |
264 |
|
265 |
#endif /* ALLOW_SSS0_CONTROL */ |
266 |
|
267 |
else |
268 |
ce --> this index does not exist yet. |
269 |
endif |
270 |
|
271 |
#endif /* ALLOW_GRADIENT_CHECK */ |
272 |
|
273 |
end |
274 |
|