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

Contents of /MITgcm/optim/optim_writedata.F

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


Revision 1.1.2.3 - (show annotations) (download)
Fri Dec 6 01:47:35 2002 UTC (21 years, 2 months ago) by heimbach
Branch: ecco-branch
CVS Tags: icebear5, icebear4, icebear3, icebear2, ecco_c44_e26, ecco_c44_e27
Branch point for: icebear
Changes since 1.1.2.2: +25 -27 lines
o lsopt:
   changed BLAS calls from single prec. (SDOT, SNRM2,SSCAL)
   to double prec. (DDOT, DNRM2, DSCAL)
   for compatibility with IBM SP3/SP4
 o optim:
   bringing optim_readdata/optim_writedata formats up-to-date
   with latest ctrl_pack/ctrl_unpack formats.

1
2 subroutine optim_writedata(
3 I nn,
4 I dfile,
5 I lheaderonly,
6 I ff,
7 I vv
8 & )
9
10 c ==================================================================
11 c SUBROUTINE optim_writedata
12 c ==================================================================
13 c
14 c o Writes the latest update of the control vector to file(s). These
15 c files can then be used by the MITgcmUV state estimation setup
16 c for the next forward/adjoint simluation.
17 c
18 c started: Christian Eckert eckert@mit.edu 12-Apr-2000
19 c
20 c changed: Patrick Heimbach heimbach@mit.edu 19-Jun-2000
21 c - finished, revised and debugged
22 c
23 c ==================================================================
24 c SUBROUTINE optim_writedata
25 c ==================================================================
26
27 implicit none
28
29 c == global variables ==
30
31 #include "EEPARAMS.h"
32 #include "SIZE.h"
33 cgg Include ECCO_CPPOPTIONS because the ecco_ctrl,cost files have headers with
34 cgg options for OBCS masks.
35 #include "ECCO_CPPOPTIONS.h"
36
37 #include "ecco.h"
38 #include "ctrl.h"
39 #include "optim.h"
40 #include "minimization.h"
41
42 c == routine arguments ==
43
44 integer nn
45 _RL ff
46 _RL vv(nn)
47
48 character*(9) dfile
49 logical lheaderonly
50
51 c == local variables ==
52
53 integer i,j,k
54 integer ii
55 integer bi,bj
56 integer biG,bjG
57 integer nopt
58 integer icvcomp
59 integer icvoffset
60 integer icvrec
61 integer icvar
62 integer funit
63 integer cbuffindex
64
65 _RL cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
66
67 character*(128) fname
68 cgg(
69 _RL gg
70 integer igg
71 integer iobcs
72 cgg)
73
74 c == end of interface ==
75
76 c-- I/O unit to use.
77 funit = 20
78
79 c-- Next optimization cycle.
80 nopt = optimcycle + 1
81
82 if ( dfile .eq. ctrlname ) then
83 print*
84 print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)'
85 print*,' for optimization cycle: ',nopt
86 print*
87 else
88 print*
89 print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*'
90 print*,' argument. *dfile* = ',dfile
91 print*
92 stop ' ... stopped in OPTIM_WRITEDATA.'
93 endif
94
95 bjG = 1 + (myygloballo - 1)/sny
96 biG = 1 + (myxgloballo - 1)/snx
97
98 c-- Generate file name and open the file.
99 write(fname(1:128),'(4a,i4.4)')
100 & dfile,'_',expId(1:10),'.opt', nopt
101 open( funit, file = fname,
102 & status = 'new',
103 & form = 'unformatted',
104 & access = 'sequential' )
105
106 cph(
107 print *, 'pathei: nvartype ', nvartype
108 print *, 'pathei: nvarlength ', nvarlength
109 print *, 'pathei: expId ', expId
110 print *, 'pathei: nopt ', nopt
111 print *, 'pathei: ff ', ff
112 print *, 'pathei: iG ', biG
113 print *, 'pathei: jG ', bjG
114 print *, 'pathei: nsx ', nsx
115 print *, 'pathei: nsy ', nsy
116
117 print *, 'pathei: nWetcGlobal ',
118 & (nWetcGlobal(k), k=1,nr)
119 print *, 'pathei: nWetsGlobal ',
120 & (nWetsGlobal(k), k=1,nr)
121 print *, 'pathei: nWetwGlobal ',
122 & (nWetwGlobal(k), k=1,nr)
123 print *, 'pathei: nWetvGlobal ',
124 & (nWetvGlobal(k), k=1,nr)
125 print *, 'pathei: ncvarindex ',
126 & (ncvarindex(i), i=1,maxcvars)
127 print *, 'pathei: ncvarrecs ',
128 & (ncvarrecs(i), i=1,maxcvars)
129 print *, 'pathei: ncvarxmax ',
130 & (ncvarxmax(i), i=1,maxcvars)
131 print *, 'pathei: ncvarymax ',
132 & (ncvarymax(i), i=1,maxcvars)
133 print *, 'pathei: ncvarnrmax ',
134 & (ncvarnrmax(i), i=1,maxcvars)
135 print *, 'pathei: ncvargrd ',
136 & (ncvargrd(i), i=1,maxcvars)
137 cph)
138
139 c-- Write the header.
140 write( funit ) nvartype
141 write( funit ) nvarlength
142 write( funit ) expId
143 write( funit ) optimcycle
144 write( funit ) ff
145 write( funit ) big
146 write( funit ) bjg
147 write( funit ) nsx
148 write( funit ) nsy
149 write( funit ) (nWetcGlobal(k), k=1,nr)
150 write( funit ) (nWetsGlobal(k), k=1,nr)
151 write( funit ) (nWetwGlobal(k), k=1,nr)
152 write( funit ) (nWetvGlobal(k), k=1,nr)
153
154 cgg( Add OBCS Mask information into the header section for optimization.
155 #ifdef ALLOW_OBCSN_CONTROL
156 write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
157 #endif
158 #ifdef ALLOW_OBCSS_CONTROL
159 write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
160 #endif
161 #ifdef ALLOW_OBCSW_CONTROL
162 write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
163 #endif
164 #ifdef ALLOW_OBCSE_CONTROL
165 write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
166 #endif
167 cgg)
168
169 write( funit ) (ncvarindex(i), i=1,maxcvars)
170 write( funit ) (ncvarrecs(i), i=1,maxcvars)
171 write( funit ) (ncvarxmax(i), i=1,maxcvars)
172 write( funit ) (ncvarymax(i), i=1,maxcvars)
173 write( funit ) (ncvarnrmax(i), i=1,maxcvars)
174 write( funit ) (ncvargrd(i), i=1,maxcvars)
175 write( funit )
176
177 c-- Write the data.
178 icvoffset = 0
179 do icvar = 1,maxcvars
180 if ( ncvarindex(icvar) .ne. -1 ) then
181 do icvrec = 1,ncvarrecs(icvar)
182 cph(
183 print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',
184 & icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)
185 cph)
186 do bj = 1,nsy
187 do bi = 1,nsx
188 write( funit ) ncvarindex(icvar)
189 write( funit ) bj
190 write( funit ) bi
191 do k = 1,ncvarnrmax(icvar)
192 cbuffindex = 0
193 if (ncvargrd(icvar) .eq. 'c') then
194 cbuffindex = nWetcGlobal(k)
195 else if (ncvargrd(icvar) .eq. 's') then
196 cbuffindex = nWetsGlobal(k)
197 else if (ncvargrd(icvar) .eq. 'w') then
198 cbuffindex = nWetwGlobal(k)
199 else if (ncvargrd(icvar) .eq. 'v') then
200 cbuffindex = nWetvGlobal(k)
201
202 cgg( O.B. points have the grid mask "m".
203 else if (ncvargrd(icvar) .eq. 'm') then
204 cgg From "icvrec", calculate what iobcs must be.
205 gg = (icvrec-1)/nobcs
206 igg = int(gg)
207 iobcs= icvrec - igg*nobcs
208 #ifdef ALLOW_OBCSN_CONTROL
209 if (icvar .eq. 11) then
210 cbuffindex = nWetobcsnGlo(k,iobcs)
211 endif
212 #endif
213 #ifdef ALLOW_OBCSS_CONTROL
214 if (icvar .eq. 12) then
215 cbuffindex = nWetobcssGlo(k,iobcs)
216 endif
217 #endif
218 #ifdef ALLOW_OBCSW_CONTROL
219 if (icvar .eq. 13) then
220 cbuffindex = nWetobcswGlo(k,iobcs)
221 endif
222 #endif
223 #ifdef ALLOW_OBCSE_CONTROL
224 if (icvar .eq. 14) then
225 cbuffindex = nWetobcseGlo(k,iobcs)
226 endif
227 #endif
228 endif
229 cgg)
230 if (cbuffindex .gt. 0) then
231 do icvcomp = 1,cbuffindex
232 cbuff(icvcomp) = vv(icvoffset + icvcomp)
233 cgg( Right now, the changes to the open boundary velocities are not balanced.
234 cgg( The model will crash due to physical reasons.
235 cgg( However, we can optimize with respect to just O.B. T and S if the
236 cgg( next two lines are uncommented.
237 cgg if (iobcs .eq. 3) cbuff(icvcomp)=0.
238 cgg if (iobcs .eq. 4) cbuff(icvcomp)=0.
239 enddo
240 write( funit ) cbuffindex
241 write( funit ) k
242 write( funit ) (cbuff(ii), ii=1,cbuffindex)
243 icvoffset = icvoffset + cbuffindex
244 endif
245 enddo
246 enddo
247 enddo
248 enddo
249 endif
250 enddo
251
252 close( funit )
253 cph(
254 print *,'in owd: icvoffset', icvoffset
255 cph)
256
257 return
258 end
259
260
261
262

  ViewVC Help
Powered by ViewVC 1.1.22