/[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.7 - (show annotations) (download)
Tue Jan 15 16:36:32 2008 UTC (16 years, 1 month 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: +3 -4 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
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
155 cgg( Add OBCS Mask information into the header section for optimization.
156 #ifdef ALLOW_OBCSN_CONTROL
157 write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
158 #endif
159 #ifdef ALLOW_OBCSS_CONTROL
160 write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
161 #endif
162 #ifdef ALLOW_OBCSW_CONTROL
163 write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
164 #endif
165 #ifdef ALLOW_OBCSE_CONTROL
166 write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
167 #endif
168 cgg)
169
170 write( funit ) (ncvarindex(i), i=1,maxcvars)
171 write( funit ) (ncvarrecs(i), i=1,maxcvars)
172 write( funit ) (ncvarxmax(i), i=1,maxcvars)
173 write( funit ) (ncvarymax(i), i=1,maxcvars)
174 write( funit ) (ncvarnrmax(i), i=1,maxcvars)
175 write( funit ) (ncvargrd(i), i=1,maxcvars)
176 write( funit )
177
178 c-- Write the data.
179 icvoffset = 0
180 do icvar = 1,maxcvars
181 if ( ncvarindex(icvar) .ne. -1 ) then
182 do icvrec = 1,ncvarrecs(icvar)
183 do bj = 1,nsy
184 do bi = 1,nsx
185 write( funit ) ncvarindex(icvar)
186 write( funit ) bj
187 write( funit ) bi
188 do k = 1,ncvarnrmax(icvar)
189 cbuffindex = 0
190 if (ncvargrd(icvar) .eq. 'c') then
191 cbuffindex = nWetcGlobal(k)
192 else if (ncvargrd(icvar) .eq. 's') then
193 cbuffindex = nWetsGlobal(k)
194 else if (ncvargrd(icvar) .eq. 'w') then
195 cbuffindex = nWetwGlobal(k)
196 else if (ncvargrd(icvar) .eq. 'v') then
197 cbuffindex = nWetvGlobal(k)
198
199 cgg( O.B. points have the grid mask "m".
200 else if (ncvargrd(icvar) .eq. 'm') then
201 cgg From "icvrec", calculate what iobcs must be.
202 gg = (icvrec-1)/nobcs
203 igg = int(gg)
204 iobcs= icvrec - igg*nobcs
205 #ifdef ALLOW_OBCSN_CONTROL
206 if (icvar .eq. 11) then
207 cbuffindex = nWetobcsnGlo(k,iobcs)
208 endif
209 #endif
210 #ifdef ALLOW_OBCSS_CONTROL
211 if (icvar .eq. 12) then
212 cbuffindex = nWetobcssGlo(k,iobcs)
213 endif
214 #endif
215 #ifdef ALLOW_OBCSW_CONTROL
216 if (icvar .eq. 13) then
217 cbuffindex = nWetobcswGlo(k,iobcs)
218 endif
219 #endif
220 #ifdef ALLOW_OBCSE_CONTROL
221 if (icvar .eq. 14) then
222 cbuffindex = nWetobcseGlo(k,iobcs)
223 endif
224 #endif
225 endif
226 cgg)
227 if (cbuffindex .gt. 0) then
228 do icvcomp = 1,cbuffindex
229 cbuff(icvcomp) = vv(icvoffset + icvcomp)
230 cgg( Right now, the changes to the open boundary velocities are not balanced.
231 cgg( The model will crash due to physical reasons.
232 cgg( However, we can optimize with respect to just O.B. T and S if the
233 cgg( next two lines are uncommented.
234 cgg if (iobcs .eq. 3) cbuff(icvcomp)=0.
235 cgg if (iobcs .eq. 4) cbuff(icvcomp)=0.
236 enddo
237 write( funit ) cbuffindex
238 write( funit ) k
239 write( funit ) (cbuff(ii), ii=1,cbuffindex)
240 icvoffset = icvoffset + cbuffindex
241 endif
242 enddo
243 enddo
244 enddo
245 enddo
246 endif
247 enddo
248
249 close( funit )
250 cph(
251 print *,'in owd: icvoffset', icvoffset
252 cph)
253
254 return
255 end
256
257
258
259

  ViewVC Help
Powered by ViewVC 1.1.22