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

Annotation of /MITgcm/optim/optim_readdata.F

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


Revision 1.7 - (hide annotations) (download)
Tue Jan 15 16:36:32 2008 UTC (16 years, 3 months ago) by dfer
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint60, checkpoint61, checkpoint62, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59o, checkpoint59n, checkpoint62b, checkpoint61f, checkpoint61n, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.6: +5 -6 lines
Getting rid of expId and #include "ecco.h" and multiple definition of
xx_sst_file and xx_sss_file in optim_numbmod.F.

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

  ViewVC Help
Powered by ViewVC 1.1.22