/[MITgcm]/MITgcm/optim/optim_readdata.F
ViewVC logotype

Contents of /MITgcm/optim/optim_readdata.F

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


Revision 1.6 - (show annotations) (download)
Thu Sep 9 15:58:42 2004 UTC (16 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint59, checkpoint58, checkpoint55, checkpoint57, checkpoint56, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint54f_post, checkpoint58y_post, checkpoint58t_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint57t_post, checkpoint55c_post, checkpoint57v_post, checkpoint57f_post, checkpoint57a_post, checkpoint57h_pre, checkpoint58w_post, checkpoint57h_post, checkpoint57y_pre, checkpoint55g_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint55d_post, checkpoint58e_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint55h_post, checkpoint58n_post, checkpoint57e_post, checkpoint55b_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint58v_post, checkpoint56a_post, checkpoint58l_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint57k_post, checkpoint57w_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post, checkpoint55e_post
Changes since 1.5: +9 -11 lines
Small modifs and fixes
(mostly change to real*4 for large-scale ECCO runs)

1
2 subroutine optim_readdata(
3 I nn,
4 I dfile,
5 I lheaderonly,
6 O ff,
7 O vv
8 & )
9
10 c ==================================================================
11 c SUBROUTINE optim_readdata
12 c ==================================================================
13 c
14 c o Read the data written by the MITgcmUV state estimation setup and
15 c join them to one vector that is subsequently used by the minimi-
16 c zation algorithm "lsopt". Depending on the specified file name
17 c either the control vector or the gradient vector can be read.
18 c
19 c *dfile* should be the radix of the file: ecco_ctrl or ecco_cost
20 c
21 c started: Christian Eckert eckert@mit.edu 12-Apr-2000
22 c
23 c changed: Patrick Heimbach heimbach@mit.edu 19-Jun-2000
24 c - finished, revised and debugged
25 c
26 c ==================================================================
27 c SUBROUTINE optim_readdata
28 c ==================================================================
29
30 implicit none
31
32 c == global variables ==
33
34 #include "EEPARAMS.h"
35 #include "SIZE.h"
36 cgg Include ECCO_CPPOPTIONS because the ecco_ctrl,cost files
37 cgg have headers with options for OBCS masks.
38 #include "ECCO_CPPOPTIONS.h"
39
40 #include "ecco.h"
41 #include "ctrl.h"
42 #include "optim.h"
43 #include "minimization.h"
44
45 c == routine arguments ==
46
47 integer nn
48 _RL ff
49
50 #if defined (DYNAMIC)
51 _RL vv(nn)
52 #elif defined (USE_POINTER) || (MAX_INDEPEND == 0)
53 _RL vv
54 pointer (pvv,vv(1))
55 #else
56 integer nmax
57 parameter( nmax = MAX_INDEPEND )
58 _RL vv(nmax)
59 #endif
60
61 character*(9) dfile
62 logical lheaderonly
63
64 c == local variables ==
65
66 integer bi,bj
67 integer biG,bjG
68 integer i,j
69 integer ii,k
70 integer icvar
71 integer icvrec
72 integer icvcomp
73 integer icvoffset
74 integer nopt
75 integer funit
76
77 integer cbuffindex
78 real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
79
80 character*(128) fname
81
82 c integer filei
83 c integer filej
84 c integer filek
85 c integer fileig
86 c integer filejg
87 c integer filensx
88 c integer filensy
89 integer filenopt
90 _RL fileff
91
92 cgg(
93 _RL gg
94 integer igg
95 integer iobcs
96 cgg)
97
98 c == end of interface ==
99
100 print *, 'pathei-lsopt in optim_readdata'
101
102 c-- The reference i/o unit.
103 funit = 20
104
105 c-- Next optimization cycle.
106 nopt = optimcycle
107
108 if ( dfile .eq. ctrlname ) then
109 print*
110 print*,' OPTIM_READDATA: Reading control vector'
111 print*,' for optimization cycle: ',nopt
112 print*
113 else if ( dfile .eq. costname ) then
114 print*
115 print*,' OPTIM_READDATA: Reading cost function and'
116 print*,' gradient of cost function'
117 print*,' for optimization cycle: ',nopt
118 print*
119 else
120 print*
121 print*,' OPTIM_READDATA: subroutine called by a false *dfile*'
122 print*,' argument. *dfile* = ',dfile
123 print*
124 stop ' ... stopped in OPTIM_READDATA.'
125 endif
126
127 c-- Read the data.
128
129 bjG = 1 + (myygloballo - 1)/sny
130 biG = 1 + (myxgloballo - 1)/snx
131
132 c-- Generate file name and open the file.
133 write(fname(1:128),'(4a,i4.4)')
134 & dfile,'_',expId(1:10),'.opt', nopt
135 open( funit, file = fname,
136 & status = 'old',
137 & form = 'unformatted',
138 & access = 'sequential' )
139 print*, 'opened file ', fname
140
141 c-- Read the header.
142 read( funit ) nvartype
143 read( funit ) nvarlength
144 read( funit ) expId
145 read( funit ) filenopt
146 read( funit ) fileff
147 read( funit ) fileiG
148 read( funit ) filejG
149 read( funit ) filensx
150 read( funit ) filensy
151
152 read( funit ) (nWetcGlobal(k), k=1,nr)
153 read( funit ) (nWetsGlobal(k), k=1,nr)
154 read( funit ) (nWetwGlobal(k), k=1,nr)
155 #ifdef ALLOW_CTRL_WETV
156 read( funit ) (nWetvGlobal(k), k=1,nr)
157 #endif
158
159 cgg( Add OBCS Mask information into the header section for optimization.
160 #ifdef ALLOW_OBCSN_CONTROL
161 read( funit ) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
162 #endif
163 #ifdef ALLOW_OBCSS_CONTROL
164 read( funit ) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
165 #endif
166 #ifdef ALLOW_OBCSW_CONTROL
167 read( funit ) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
168 #endif
169 #ifdef ALLOW_OBCSE_CONTROL
170 read( funit ) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
171 #endif
172 cgg)
173 read( funit ) (ncvarindex(i), i=1,maxcvars)
174 read( funit ) (ncvarrecs(i), i=1,maxcvars)
175 read( funit ) (ncvarxmax(i), i=1,maxcvars)
176 read( funit ) (ncvarymax(i), i=1,maxcvars)
177 read( funit ) (ncvarnrmax(i), i=1,maxcvars)
178 read( funit ) (ncvargrd(i), i=1,maxcvars)
179 read( funit )
180
181 cph(
182 cph if (lheaderonly) then
183 print *, 'pathei: nvartype ', nvartype
184 print *, 'pathei: nvarlength ', nvarlength
185 print *, 'pathei: expId ', expId
186 print *, 'pathei: filenopt ', filenopt
187 print *, 'pathei: fileff ', fileff
188 print *, 'pathei: fileiG ', fileiG
189 print *, 'pathei: filejG ', filejG
190 print *, 'pathei: filensx ', filensx
191 print *, 'pathei: filensy ', filensy
192
193 print *, 'pathei: nWetcGlobal ',
194 & (nWetcGlobal(k), k=1,nr)
195 print *, 'pathei: nWetsGlobal ',
196 & (nWetsGlobal(k), k=1,nr)
197 print *, 'pathei: nWetwGlobal ',
198 & (nWetwGlobal(k), k=1,nr)
199 print *, 'pathei: nWetvGlobal ',
200 & (nWetvGlobal(k), k=1,nr)
201 print *, 'pathei: ncvarindex ',
202 & (ncvarindex(i), i=1,maxcvars)
203 print *, 'pathei: ncvarrecs ',
204 & (ncvarrecs(i), i=1,maxcvars)
205 print *, 'pathei: ncvarxmax ',
206 & (ncvarxmax(i), i=1,maxcvars)
207 print *, 'pathei: ncvarymax ',
208 & (ncvarymax(i), i=1,maxcvars)
209 print *, 'pathei: ncvarnrmax ',
210 & (ncvarnrmax(i), i=1,maxcvars)
211 print *, 'pathei: ncvargrd ',
212 & (ncvargrd(i), i=1,maxcvars)
213 cph end if
214 cph)
215 c-- Check the header information for consistency.
216
217 cph if ( filenopt .ne. nopt ) then
218 cph print*
219 cph print*,' READ_HEADER: Input data belong to the wrong'
220 cph print*,' optimization cycle.'
221 cph print*,' optimization cycle = ',nopt
222 cph print*,' input optim cycle = ',filenopt
223 cph print*
224 cph stop ' ... stopped in READ_HEADER.'
225 cph endif
226
227 if ( (fileiG .ne. biG) .or. (filejG .ne. bjG) ) then
228 print*
229 print*,' READ_HEADER: Tile indices of loop and data '
230 print*,' do not match.'
231 print*,' loop x/y component = ',
232 & biG,bjG
233 print*,' data x/y component = ',
234 & fileiG,filejG
235 print*
236 stop ' ... stopped in READ_HEADER.'
237 endif
238
239 if ( (filensx .ne. nsx) .or. (filensy .ne. nsy) ) then
240 print*
241 print*,' READ_HEADER: Numbers of tiles do not match.'
242 print*,' parameter x/y no. of tiles = ',
243 & bi,bj
244 print*,' data x/y no. of tiles = ',
245 & filensx,filensy
246 print*
247 stop ' ... stopped in READ_HEADER.'
248 endif
249
250 ce Add some more checks. ...
251
252 if (.NOT. lheaderonly) then
253 c-- Read the data.
254 icvoffset = 0
255 do icvar = 1,maxcvars
256 if ( ncvarindex(icvar) .ne. -1 ) then
257 do icvrec = 1,ncvarrecs(icvar)
258 do bj = 1,nsy
259 do bi = 1,nsx
260 read( funit ) ncvarindex(icvar)
261 read( funit ) filej
262 read( funit ) filei
263 do k = 1,ncvarnrmax(icvar)
264 cbuffindex = 0
265 if (ncvargrd(icvar) .eq. 'c') then
266 cbuffindex = nWetcGlobal(k)
267 else if (ncvargrd(icvar) .eq. 's') then
268 cbuffindex = nWetsGlobal(k)
269 else if (ncvargrd(icvar) .eq. 'w') then
270 cbuffindex = nWetwGlobal(k)
271 else if (ncvargrd(icvar) .eq. 'v') then
272 cbuffindex = nWetvGlobal(k)
273 cgg( O.B. points have the grid mask "m".
274 else if (ncvargrd(icvar) .eq. 'm') then
275 cgg From "icvrec", calculate what iobcs must be.
276 gg = (icvrec-1)/nobcs
277 igg = int(gg)
278 iobcs= icvrec - igg*nobcs
279 #ifdef ALLOW_OBCSN_CONTROL
280 if (icvar .eq. 11) then
281 cbuffindex = nWetobcsnGlo(k,iobcs)
282 endif
283 #endif
284 #ifdef ALLOW_OBCSS_CONTROL
285 if (icvar .eq. 12) then
286 cbuffindex = nWetobcssGlo(k,iobcs)
287 endif
288 #endif
289 #ifdef ALLOW_OBCSW_CONTROL
290 if (icvar .eq. 13) then
291 cbuffindex = nWetobcswGlo(k,iobcs)
292 endif
293 #endif
294 #ifdef ALLOW_OBCSE_CONTROL
295 if (icvar .eq. 14) then
296 cbuffindex = nWetobcseGlo(k,iobcs)
297 endif
298 #endif
299 cgg)
300 endif
301 if (cbuffindex .gt. 0) then
302 read( funit ) cbuffindex
303 read( funit ) filek
304 read( funit ) (cbuff(ii), ii=1,cbuffindex)
305 do icvcomp = 1,cbuffindex
306 vv(icvoffset+icvcomp) = cbuff(icvcomp)
307 cgg( Right now, the changes to the open boundary velocities are not balanced.
308 cgg( The model will crash due to physical reasons.
309 cgg( However, we can optimize with respect to just O.B. T and S if the
310 cgg( next two lines are uncommented.
311 cgg if (iobcs .eq. 3) vv(icvoffset+icvcomp)=0.
312 cgg if (iobcs .eq. 4) vv(icvoffset+icvcomp)=0.
313 enddo
314 icvoffset = icvoffset + cbuffindex
315 endif
316 enddo
317 enddo
318 enddo
319 enddo
320 endif
321 enddo
322
323 else
324
325 c-- Assign the number of control variables.
326 nn = nvarlength
327
328 endif
329
330 close( funit )
331
332 c-- Assign the cost function value in case we read the cost file.
333
334 if ( dfile .eq. ctrlname ) then
335 ff = 0. d 0
336 else if ( dfile .eq. costname ) then
337 ff = fileff
338 endif
339
340 return
341 end

  ViewVC Help
Powered by ViewVC 1.1.22