/[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.5 - (show annotations) (download)
Wed Nov 19 19:07:02 2003 UTC (20 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint52l_pre, hrcube4, hrcube5, checkpoint52d_pre, checkpoint56b_post, checkpoint52j_pre, checkpoint54d_post, checkpoint54e_post, checkpoint52k_post, checkpoint55, checkpoint54, checkpoint56, checkpoint53, checkpoint52f_post, checkpoint54f_post, checkpoint55i_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint55c_post, checkpoint52e_pre, checkpoint52e_post, checkpoint53d_post, checkpoint52b_pre, checkpoint54b_post, checkpoint52m_post, checkpoint55g_post, checkpoint52b_post, checkpoint52c_post, checkpoint52f_pre, checkpoint55d_post, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint55b_post, checkpoint53a_post, checkpoint55f_post, checkpoint52d_post, checkpoint53g_post, checkpoint52i_post, checkpoint52h_pre, checkpoint56a_post, checkpoint53f_post, checkpoint52j_post, branch-netcdf, checkpoint52l_post, checkpoint52n_post, checkpoint53b_pre, checkpoint55a_post, checkpoint53b_post, checkpoint53d_pre, checkpoint55e_post, checkpoint54c_post
Branch point for: netcdf-sm0
Changes since 1.4: +1 -1 lines
Bringing up-to-date with latest ctrl and IRIX64

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 real*4 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 #ifdef ALLOW_CTRL_WETV
153 write( funit ) (nWetvGlobal(k), k=1,nr)
154 #endif
155
156 cgg( Add OBCS Mask information into the header section for optimization.
157 #ifdef ALLOW_OBCSN_CONTROL
158 write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
159 #endif
160 #ifdef ALLOW_OBCSS_CONTROL
161 write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
162 #endif
163 #ifdef ALLOW_OBCSW_CONTROL
164 write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
165 #endif
166 #ifdef ALLOW_OBCSE_CONTROL
167 write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
168 #endif
169 cgg)
170
171 write( funit ) (ncvarindex(i), i=1,maxcvars)
172 write( funit ) (ncvarrecs(i), i=1,maxcvars)
173 write( funit ) (ncvarxmax(i), i=1,maxcvars)
174 write( funit ) (ncvarymax(i), i=1,maxcvars)
175 write( funit ) (ncvarnrmax(i), i=1,maxcvars)
176 write( funit ) (ncvargrd(i), i=1,maxcvars)
177 write( funit )
178
179 c-- Write the data.
180 icvoffset = 0
181 do icvar = 1,maxcvars
182 if ( ncvarindex(icvar) .ne. -1 ) then
183 do icvrec = 1,ncvarrecs(icvar)
184 cph(
185 print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',
186 & icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)
187 cph)
188 do bj = 1,nsy
189 do bi = 1,nsx
190 write( funit ) ncvarindex(icvar)
191 write( funit ) bj
192 write( funit ) bi
193 do k = 1,ncvarnrmax(icvar)
194 cbuffindex = 0
195 if (ncvargrd(icvar) .eq. 'c') then
196 cbuffindex = nWetcGlobal(k)
197 else if (ncvargrd(icvar) .eq. 's') then
198 cbuffindex = nWetsGlobal(k)
199 else if (ncvargrd(icvar) .eq. 'w') then
200 cbuffindex = nWetwGlobal(k)
201 else if (ncvargrd(icvar) .eq. 'v') then
202 cbuffindex = nWetvGlobal(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 = nWetobcsnGlo(k,iobcs)
213 endif
214 #endif
215 #ifdef ALLOW_OBCSS_CONTROL
216 if (icvar .eq. 12) then
217 cbuffindex = nWetobcssGlo(k,iobcs)
218 endif
219 #endif
220 #ifdef ALLOW_OBCSW_CONTROL
221 if (icvar .eq. 13) then
222 cbuffindex = nWetobcswGlo(k,iobcs)
223 endif
224 #endif
225 #ifdef ALLOW_OBCSE_CONTROL
226 if (icvar .eq. 14) then
227 cbuffindex = nWetobcseGlo(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