/[MITgcm]/MITgcm/optim/optim_writedata.F
ViewVC logotype

Annotation of /MITgcm/optim/optim_writedata.F

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


Revision 1.1.2.2 - (hide annotations) (download)
Thu Apr 4 10:20:16 2002 UTC (21 years, 11 months ago) by heimbach
Branch: ecco-branch
CVS Tags: ecco_ice2, ecco_ice1, ecco_c44_e25, ecco_c44_e22, ecco_c44_e23, ecco_c44_e21, ecco_c44_e24
Branch point for: c24_e25_ice
Changes since 1.1.2.1: +65 -0 lines
Added obcs control part for lsopt I/O
(by G. Gebbie).

1 heimbach 1.1.2.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 heimbach 1.1.2.2 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 heimbach 1.1.2.1
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     _RL cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
66    
67     character*(128) fname
68 heimbach 1.1.2.2 cgg(
69     _RL gg
70     integer igg
71     integer iobcs
72     cgg)
73 heimbach 1.1.2.1
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: nWetcTile ',
118     & (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
119     print *, 'pathei: nWetsTile ',
120     & (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
121     print *, 'pathei: nWetwTile ',
122     & (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
123     print *, 'pathei: ncvarindex ',
124     & (ncvarindex(i), i=1,maxcvars)
125     print *, 'pathei: ncvarrecs ',
126     & (ncvarrecs(i), i=1,maxcvars)
127     print *, 'pathei: ncvarxmax ',
128     & (ncvarxmax(i), i=1,maxcvars)
129     print *, 'pathei: ncvarymax ',
130     & (ncvarymax(i), i=1,maxcvars)
131     print *, 'pathei: ncvarnrmax ',
132     & (ncvarnrmax(i), i=1,maxcvars)
133     print *, 'pathei: ncvargrd ',
134     & (ncvargrd(i), i=1,maxcvars)
135     cph)
136    
137     c-- Write the header.
138     write( funit ) nvartype
139     write( funit ) nvarlength
140     write( funit ) expId
141     write( funit ) optimcycle
142     write( funit ) ff
143     write( funit ) big
144     write( funit ) bjg
145     write( funit ) nsx
146     write( funit ) nsy
147     write( funit ) (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy),
148     & k=1,nr)
149     write( funit ) (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy),
150     & k=1,nr)
151     write( funit ) (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy),
152     & k=1,nr)
153 heimbach 1.1.2.2
154     cgg( Add OBCS Mask information into the header section for optimization.
155     #ifdef ALLOW_OBCSN_CONTROL
156     write(funit) ((((nWetobcsn(i,j,k,iobcs), k=1,nr),
157     & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
158     #endif
159     #ifdef ALLOW_OBCSS_CONTROL
160     write(funit) ((((nWetobcss(i,j,k,iobcs), k=1,nr),
161     & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
162     #endif
163     #ifdef ALLOW_OBCSW_CONTROL
164     write(funit) ((((nWetobcsw(i,j,k,iobcs), k=1,nr),
165     & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
166     #endif
167     #ifdef ALLOW_OBCSE_CONTROL
168     write(funit) ((((nWetobcse(i,j,k,iobcs), k=1,nr),
169     & iobcs= 1,nobcs), i=1,nsx) , j=1,nsy)
170     #endif
171     cgg)
172    
173 heimbach 1.1.2.1 write( funit ) (ncvarindex(i), i=1,maxcvars)
174     write( funit ) (ncvarrecs(i), i=1,maxcvars)
175     write( funit ) (ncvarxmax(i), i=1,maxcvars)
176     write( funit ) (ncvarymax(i), i=1,maxcvars)
177     write( funit ) (ncvarnrmax(i), i=1,maxcvars)
178     write( funit ) (ncvargrd(i), i=1,maxcvars)
179     write( funit )
180    
181     c-- Write the data.
182     icvoffset = 0
183     do icvar = 1,maxcvars
184     if ( ncvarindex(icvar) .ne. -1 ) then
185     do icvrec = 1,ncvarrecs(icvar)
186     cph(
187     print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',
188     & icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)
189     cph)
190     do bj = 1,nsy
191     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 = nwetctile(bi,bj,k)
199     else if (ncvargrd(icvar) .eq. 's') then
200     cbuffindex = nwetstile(bi,bj,k)
201     else if (ncvargrd(icvar) .eq. 'w') then
202     cbuffindex = nwetwtile(bi,bj,k)
203 heimbach 1.1.2.2
204     cgg( O.B. points have the grid mask "m".
205     else if (ncvargrd(icvar) .eq. 'm') then
206     cgg From "icvrec", calculate what iobcs must be.
207     gg = (icvrec-1)/nobcs
208     igg = int(gg)
209     iobcs= icvrec - igg*nobcs
210     #ifdef ALLOW_OBCSN_CONTROL
211     if (icvar .eq. 11) then
212     cbuffindex = nwetobcsn(bi,bj,k,iobcs)
213     endif
214     #endif
215     #ifdef ALLOW_OBCSS_CONTROL
216     if (icvar .eq. 12) then
217     cbuffindex = nwetobcss(bi,bj,k,iobcs)
218     endif
219     #endif
220     #ifdef ALLOW_OBCSW_CONTROL
221     if (icvar .eq. 13) then
222     cbuffindex = nwetobcsw(bi,bj,k,iobcs)
223     endif
224     #endif
225     #ifdef ALLOW_OBCSE_CONTROL
226     if (icvar .eq. 14) then
227     cbuffindex = nwetobcse(bi,bj,k,iobcs)
228     endif
229     #endif
230 heimbach 1.1.2.1 endif
231 heimbach 1.1.2.2 cgg)
232 heimbach 1.1.2.1 if (cbuffindex .gt. 0) then
233     do icvcomp = 1,cbuffindex
234     cbuff(icvcomp) = vv(icvoffset + icvcomp)
235 heimbach 1.1.2.2 cgg( Right now, the changes to the open boundary velocities are not balanced.
236     cgg( The model will crash due to physical reasons.
237     cgg( However, we can optimize with respect to just O.B. T and S if the
238     cgg( next two lines are uncommented.
239     cgg if (iobcs .eq. 3) cbuff(icvcomp)=0.
240     cgg if (iobcs .eq. 4) cbuff(icvcomp)=0.
241 heimbach 1.1.2.1 enddo
242     write( funit ) cbuffindex
243     write( funit ) k
244     write( funit ) (cbuff(ii), ii=1,cbuffindex)
245     icvoffset = icvoffset + cbuffindex
246     endif
247     enddo
248     enddo
249     enddo
250     enddo
251     endif
252     enddo
253    
254     close( funit )
255     cph(
256     print *,'in owd: icvoffset', icvoffset
257     cph)
258    
259     return
260     end
261 heimbach 1.1.2.2
262    
263    
264 heimbach 1.1.2.1

  ViewVC Help
Powered by ViewVC 1.1.22