/[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.3 - (show annotations) (download)
Tue Jun 2 16:17:08 2015 UTC (8 years, 9 months ago) by mlosch
Branch: MAIN
Changes since 1.2: +6 -4 lines
replace ECCO_CPPOPTIONS.h with CTRL_OPTIONS.h according recent changes
in main repository (still needs to be tested)

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

  ViewVC Help
Powered by ViewVC 1.1.22