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

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

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


Revision 1.1 - (hide annotations) (download)
Thu Apr 26 11:10:06 2012 UTC (11 years, 11 months ago) by mlosch
Branch: MAIN
First working version of a new optimization package that uses a slightly
modified version of m1qn3, v3.3
(https://who.rocq.inria.fr/Jean-Charles.Gilbert/modulopt/optimization-routines/m1qn3/m1qn3.html)
to work as an offline optimizer. The advantage of m1qn3_offline is, that
it is run in reverse communication control mode, so that it gives back
control to the call routine (here a script) to provide a new estimate of the
cost function and the gradient based on the control vector. This way we can
do complete line searches that are meaningful.

1 mlosch 1.1 C $Header: $
2     C $Name: $
3    
4     c Include ECCO_CPPOPTIONS because the ecco_ctrl,cost files
5     c have headers with options for OBCS masks.
6     #include "ECCO_CPPOPTIONS.h"
7    
8     subroutine optim_writedata(
9     I nn,
10     I dfile,
11     I lheaderonly,
12     I ff,
13     I vv
14     & )
15    
16     c ==================================================================
17     c SUBROUTINE optim_writedata
18     c ==================================================================
19     c
20     c o Writes the latest update of the control vector to file(s). These
21     c files can then be used by the MITgcmUV state estimation setup
22     c for the next forward/adjoint simluation.
23     c
24     c started: Christian Eckert eckert@mit.edu 12-Apr-2000
25     c
26     c changed: Patrick Heimbach heimbach@mit.edu 19-Jun-2000
27     c - finished, revised and debugged
28     c
29     c ==================================================================
30     c SUBROUTINE optim_writedata
31     c ==================================================================
32    
33     implicit none
34    
35     c == global variables ==
36    
37     #include "EEPARAMS.h"
38     #include "SIZE.h"
39     #include "ctrl.h"
40     #include "optim.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,'_',yctrlid(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: yctrlid ', yctrlid
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 ) yctrlid
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     #ifdef ALLOW_SHIFWFLX_CONTROL
156     write(funit) (nWetiGlobal(k), k=1,nr)
157     c write(funit) nWetiGlobal(1)
158     #endif
159    
160     cgg( Add OBCS Mask information into the header section for optimization.
161     #ifdef ALLOW_OBCSN_CONTROL
162     write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
163     #endif
164     #ifdef ALLOW_OBCSS_CONTROL
165     write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
166     #endif
167     #ifdef ALLOW_OBCSW_CONTROL
168     write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
169     #endif
170     #ifdef ALLOW_OBCSE_CONTROL
171     write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
172     #endif
173     cgg)
174    
175     write( funit ) (ncvarindex(i), i=1,maxcvars)
176     write( funit ) (ncvarrecs(i), i=1,maxcvars)
177     write( funit ) (ncvarxmax(i), i=1,maxcvars)
178     write( funit ) (ncvarymax(i), i=1,maxcvars)
179     write( funit ) (ncvarnrmax(i), i=1,maxcvars)
180     write( funit ) (ncvargrd(i), i=1,maxcvars)
181     write( funit )
182    
183     c-- Write the data.
184     icvoffset = 0
185     do icvar = 1,maxcvars
186     if ( ncvarindex(icvar) .ne. -1 ) then
187     do icvrec = 1,ncvarrecs(icvar)
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     #ifdef ALLOW_SHIFWFLX_CONTROL
204     else if (ncvargrd(icvar) .eq. 'i') then
205     cbuffindex = nWetiGlobal(k)
206     #endif
207     cgg( O.B. points have the grid mask "m".
208     else if (ncvargrd(icvar) .eq. 'm') then
209     cgg From "icvrec", calculate what iobcs must be.
210     gg = (icvrec-1)/nobcs
211     igg = int(gg)
212     iobcs= icvrec - igg*nobcs
213     #ifdef ALLOW_OBCSN_CONTROL
214     if (icvar .eq. 11) then
215     cbuffindex = nWetobcsnGlo(k,iobcs)
216     endif
217     #endif
218     #ifdef ALLOW_OBCSS_CONTROL
219     if (icvar .eq. 12) then
220     cbuffindex = nWetobcssGlo(k,iobcs)
221     endif
222     #endif
223     #ifdef ALLOW_OBCSW_CONTROL
224     if (icvar .eq. 13) then
225     cbuffindex = nWetobcswGlo(k,iobcs)
226     endif
227     #endif
228     #ifdef ALLOW_OBCSE_CONTROL
229     if (icvar .eq. 14) then
230     cbuffindex = nWetobcseGlo(k,iobcs)
231     endif
232     #endif
233     endif
234     cgg)
235     if (cbuffindex .gt. 0) then
236     do icvcomp = 1,cbuffindex
237     cbuff(icvcomp) = vv(icvoffset + icvcomp)
238     c If you want to optimize with respect to just O.B. T and S
239     c uncomment the next two lines.
240     c if (iobcs .eq. 3) cbuff(icvcomp)=0.
241     c if (iobcs .eq. 4) cbuff(icvcomp)=0.
242     enddo
243     write( funit ) cbuffindex
244     write( funit ) k
245     write( funit ) (cbuff(ii), ii=1,cbuffindex)
246     icvoffset = icvoffset + cbuffindex
247     endif
248     enddo
249     enddo
250     enddo
251     enddo
252     endif
253     enddo
254    
255     close( funit )
256     cph(
257     print *,'in owd: icvoffset', icvoffset
258     cph)
259    
260     return
261     end
262    
263    
264    
265    

  ViewVC Help
Powered by ViewVC 1.1.22