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

Diff of /MITgcm/optim/optim_writedata.F

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

revision 1.1 by heimbach, Tue Feb 5 20:34:35 2002 UTC revision 1.2 by heimbach, Fri Nov 15 04:03:25 2002 UTC
# Line 0  Line 1 
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    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    
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    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,'_',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    
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          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    
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                            endif
231    cgg)
232                            if (cbuffindex .gt. 0) then
233                               do icvcomp = 1,cbuffindex
234                                  cbuff(icvcomp) = vv(icvoffset + icvcomp)
235    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                               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    
262    
263    
264    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22