/[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.8 - (show annotations) (download)
Tue May 10 07:53:24 2011 UTC (12 years, 9 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63
Changes since 1.7: +8 -1 lines
adjust after introducing new control variable xx_shifwflx

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

  ViewVC Help
Powered by ViewVC 1.1.22