/[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.6 - (show annotations) (download)
Fri Dec 3 01:06:33 2004 UTC (16 years, 8 months ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint57y_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint59, checkpoint58, checkpoint57, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint57l_post, checkpoint57t_post, checkpoint57v_post, checkpoint57f_post, checkpoint57a_post, checkpoint57h_pre, checkpoint58w_post, checkpoint57h_post, checkpoint57y_pre, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint57c_pre, checkpoint58r_post, checkpoint58n_post, checkpoint57e_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint57o_post, checkpoint57k_post, checkpoint57w_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post
Changes since 1.5: +0 -4 lines
o optim:
  - remove unnecessary header files
  - adjusted namelists
  - add xerbla.F to Makefile

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 do bj = 1,nsy
185 do bi = 1,nsx
186 write( funit ) ncvarindex(icvar)
187 write( funit ) bj
188 write( funit ) bi
189 do k = 1,ncvarnrmax(icvar)
190 cbuffindex = 0
191 if (ncvargrd(icvar) .eq. 'c') then
192 cbuffindex = nWetcGlobal(k)
193 else if (ncvargrd(icvar) .eq. 's') then
194 cbuffindex = nWetsGlobal(k)
195 else if (ncvargrd(icvar) .eq. 'w') then
196 cbuffindex = nWetwGlobal(k)
197 else if (ncvargrd(icvar) .eq. 'v') then
198 cbuffindex = nWetvGlobal(k)
199
200 cgg( O.B. points have the grid mask "m".
201 else if (ncvargrd(icvar) .eq. 'm') then
202 cgg From "icvrec", calculate what iobcs must be.
203 gg = (icvrec-1)/nobcs
204 igg = int(gg)
205 iobcs= icvrec - igg*nobcs
206 #ifdef ALLOW_OBCSN_CONTROL
207 if (icvar .eq. 11) then
208 cbuffindex = nWetobcsnGlo(k,iobcs)
209 endif
210 #endif
211 #ifdef ALLOW_OBCSS_CONTROL
212 if (icvar .eq. 12) then
213 cbuffindex = nWetobcssGlo(k,iobcs)
214 endif
215 #endif
216 #ifdef ALLOW_OBCSW_CONTROL
217 if (icvar .eq. 13) then
218 cbuffindex = nWetobcswGlo(k,iobcs)
219 endif
220 #endif
221 #ifdef ALLOW_OBCSE_CONTROL
222 if (icvar .eq. 14) then
223 cbuffindex = nWetobcseGlo(k,iobcs)
224 endif
225 #endif
226 endif
227 cgg)
228 if (cbuffindex .gt. 0) then
229 do icvcomp = 1,cbuffindex
230 cbuff(icvcomp) = vv(icvoffset + icvcomp)
231 cgg( Right now, the changes to the open boundary velocities are not balanced.
232 cgg( The model will crash due to physical reasons.
233 cgg( However, we can optimize with respect to just O.B. T and S if the
234 cgg( next two lines are uncommented.
235 cgg if (iobcs .eq. 3) cbuff(icvcomp)=0.
236 cgg if (iobcs .eq. 4) cbuff(icvcomp)=0.
237 enddo
238 write( funit ) cbuffindex
239 write( funit ) k
240 write( funit ) (cbuff(ii), ii=1,cbuffindex)
241 icvoffset = icvoffset + cbuffindex
242 endif
243 enddo
244 enddo
245 enddo
246 enddo
247 endif
248 enddo
249
250 close( funit )
251 cph(
252 print *,'in owd: icvoffset', icvoffset
253 cph)
254
255 return
256 end
257
258
259
260

  ViewVC Help
Powered by ViewVC 1.1.22