/[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.2 - (show annotations) (download)
Thu Apr 4 10:20:16 2002 UTC (21 years, 10 months ago) by heimbach
Branch: ecco-branch
CVS Tags: ecco_ice2, ecco_ice1, ecco_c44_e25, ecco_c44_e22, ecco_c44_e23, ecco_c44_e21, ecco_c44_e24
Branch point for: c24_e25_ice
Changes since 1.1.2.1: +65 -0 lines
Added obcs control part for lsopt I/O
(by G. Gebbie).

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: nWetcTile ',
118 & (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
119 print *, 'pathei: nWetsTile ',
120 & (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
121 print *, 'pathei: nWetwTile ',
122 & (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
123 print *, 'pathei: ncvarindex ',
124 & (ncvarindex(i), i=1,maxcvars)
125 print *, 'pathei: ncvarrecs ',
126 & (ncvarrecs(i), i=1,maxcvars)
127 print *, 'pathei: ncvarxmax ',
128 & (ncvarxmax(i), i=1,maxcvars)
129 print *, 'pathei: ncvarymax ',
130 & (ncvarymax(i), i=1,maxcvars)
131 print *, 'pathei: ncvarnrmax ',
132 & (ncvarnrmax(i), i=1,maxcvars)
133 print *, 'pathei: ncvargrd ',
134 & (ncvargrd(i), i=1,maxcvars)
135 cph)
136
137 c-- Write the header.
138 write( funit ) nvartype
139 write( funit ) nvarlength
140 write( funit ) expId
141 write( funit ) optimcycle
142 write( funit ) ff
143 write( funit ) big
144 write( funit ) bjg
145 write( funit ) nsx
146 write( funit ) nsy
147 write( funit ) (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy),
148 & k=1,nr)
149 write( funit ) (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy),
150 & k=1,nr)
151 write( funit ) (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy),
152 & k=1,nr)
153
154 cgg( Add OBCS Mask information into the header section for optimization.
155 #ifdef ALLOW_OBCSN_CONTROL
156 write(funit) ((((nWetobcsn(i,j,k,iobcs), k=1,nr),
157 & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
158 #endif
159 #ifdef ALLOW_OBCSS_CONTROL
160 write(funit) ((((nWetobcss(i,j,k,iobcs), k=1,nr),
161 & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
162 #endif
163 #ifdef ALLOW_OBCSW_CONTROL
164 write(funit) ((((nWetobcsw(i,j,k,iobcs), k=1,nr),
165 & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
166 #endif
167 #ifdef ALLOW_OBCSE_CONTROL
168 write(funit) ((((nWetobcse(i,j,k,iobcs), k=1,nr),
169 & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
170 #endif
171 cgg)
172
173 write( funit ) (ncvarindex(i), i=1,maxcvars)
174 write( funit ) (ncvarrecs(i), i=1,maxcvars)
175 write( funit ) (ncvarxmax(i), i=1,maxcvars)
176 write( funit ) (ncvarymax(i), i=1,maxcvars)
177 write( funit ) (ncvarnrmax(i), i=1,maxcvars)
178 write( funit ) (ncvargrd(i), i=1,maxcvars)
179 write( funit )
180
181 c-- Write the data.
182 icvoffset = 0
183 do icvar = 1,maxcvars
184 if ( ncvarindex(icvar) .ne. -1 ) then
185 do icvrec = 1,ncvarrecs(icvar)
186 cph(
187 print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',
188 & icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)
189 cph)
190 do bj = 1,nsy
191 do bi = 1,nsx
192 write( funit ) ncvarindex(icvar)
193 write( funit ) bj
194 write( funit ) bi
195 do k = 1,ncvarnrmax(icvar)
196 cbuffindex = 0
197 if (ncvargrd(icvar) .eq. 'c') then
198 cbuffindex = nwetctile(bi,bj,k)
199 else if (ncvargrd(icvar) .eq. 's') then
200 cbuffindex = nwetstile(bi,bj,k)
201 else if (ncvargrd(icvar) .eq. 'w') then
202 cbuffindex = nwetwtile(bi,bj,k)
203
204 cgg( O.B. points have the grid mask "m".
205 else if (ncvargrd(icvar) .eq. 'm') then
206 cgg From "icvrec", calculate what iobcs must be.
207 gg = (icvrec-1)/nobcs
208 igg = int(gg)
209 iobcs= icvrec - igg*nobcs
210 #ifdef ALLOW_OBCSN_CONTROL
211 if (icvar .eq. 11) then
212 cbuffindex = nwetobcsn(bi,bj,k,iobcs)
213 endif
214 #endif
215 #ifdef ALLOW_OBCSS_CONTROL
216 if (icvar .eq. 12) then
217 cbuffindex = nwetobcss(bi,bj,k,iobcs)
218 endif
219 #endif
220 #ifdef ALLOW_OBCSW_CONTROL
221 if (icvar .eq. 13) then
222 cbuffindex = nwetobcsw(bi,bj,k,iobcs)
223 endif
224 #endif
225 #ifdef ALLOW_OBCSE_CONTROL
226 if (icvar .eq. 14) then
227 cbuffindex = nwetobcse(bi,bj,k,iobcs)
228 endif
229 #endif
230 endif
231 cgg)
232 if (cbuffindex .gt. 0) then
233 do icvcomp = 1,cbuffindex
234 cbuff(icvcomp) = vv(icvoffset + icvcomp)
235 cgg( Right now, the changes to the open boundary velocities are not balanced.
236 cgg( The model will crash due to physical reasons.
237 cgg( However, we can optimize with respect to just O.B. T and S if the
238 cgg( next two lines are uncommented.
239 cgg if (iobcs .eq. 3) cbuff(icvcomp)=0.
240 cgg if (iobcs .eq. 4) cbuff(icvcomp)=0.
241 enddo
242 write( funit ) cbuffindex
243 write( funit ) k
244 write( funit ) (cbuff(ii), ii=1,cbuffindex)
245 icvoffset = icvoffset + cbuffindex
246 endif
247 enddo
248 enddo
249 enddo
250 enddo
251 endif
252 enddo
253
254 close( funit )
255 cph(
256 print *,'in owd: icvoffset', icvoffset
257 cph)
258
259 return
260 end
261
262
263
264

  ViewVC Help
Powered by ViewVC 1.1.22