/[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.12 - (show annotations) (download)
Tue Jun 2 14:49:13 2015 UTC (5 years ago) by gforget
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65n, checkpoint65m, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, HEAD
Changes since 1.11: +7 -6 lines
- remove un-necessary option files includes

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

  ViewVC Help
Powered by ViewVC 1.1.22