/[MITgcm]/MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F
ViewVC logotype

Contents of /MITgcm_contrib/mlosch/optim_m1qn3/optim_writedata.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.4 - (show annotations) (download)
Mon May 9 09:37:17 2016 UTC (7 years, 10 months ago) by mlosch
Branch: MAIN
Changes since 1.3: +5 -2 lines
add CTRL_SIZE.h if ALLOW_GENARR2D_CONTROL, ALLOW_GENARR3D_CONTROL, or
ALLOW_GENTIM2D_CONTROL is defined, so that it compiles in that case, too

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

  ViewVC Help
Powered by ViewVC 1.1.22