/[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.1.2.3 by heimbach, Fri Dec 6 01:47:35 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: 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 ) expId
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          write( funit ) (nWetvGlobal(k), k=1,nr)
153    
154    cgg(    Add OBCS Mask information into the header section for optimization.
155    #ifdef ALLOW_OBCSN_CONTROL
156              write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
157    #endif
158    #ifdef ALLOW_OBCSS_CONTROL
159              write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
160    #endif
161    #ifdef ALLOW_OBCSW_CONTROL
162              write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
163    #endif
164    #ifdef ALLOW_OBCSE_CONTROL
165              write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
166    #endif
167    cgg)
168    
169          write( funit ) (ncvarindex(i), i=1,maxcvars)
170          write( funit ) (ncvarrecs(i),  i=1,maxcvars)
171          write( funit ) (ncvarxmax(i),  i=1,maxcvars)
172          write( funit ) (ncvarymax(i),  i=1,maxcvars)
173          write( funit ) (ncvarnrmax(i), i=1,maxcvars)
174          write( funit ) (ncvargrd(i),   i=1,maxcvars)
175          write( funit )
176    
177    c--         Write the data.
178          icvoffset = 0
179          do icvar = 1,maxcvars
180             if ( ncvarindex(icvar) .ne. -1 ) then
181                do icvrec = 1,ncvarrecs(icvar)
182    cph(
183                   print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',
184         &              icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)
185    cph)
186                   do bj = 1,nsy
187                      do bi = 1,nsx
188                         write( funit ) ncvarindex(icvar)
189                         write( funit ) bj
190                         write( funit ) bi
191                         do k = 1,ncvarnrmax(icvar)
192                            cbuffindex = 0
193                            if (ncvargrd(icvar) .eq. 'c') then
194                               cbuffindex = nWetcGlobal(k)
195                            else if (ncvargrd(icvar) .eq. 's') then
196                               cbuffindex = nWetsGlobal(k)
197                            else if (ncvargrd(icvar) .eq. 'w') then
198                               cbuffindex = nWetwGlobal(k)
199                            else if (ncvargrd(icvar) .eq. 'v') then
200                               cbuffindex = nWetvGlobal(k)
201    
202    cgg(   O.B. points have the grid mask "m".
203                            else if (ncvargrd(icvar) .eq. 'm') then
204    cgg    From "icvrec", calculate what iobcs must be.
205                              gg   = (icvrec-1)/nobcs
206                              igg  = int(gg)
207                              iobcs= icvrec - igg*nobcs
208    #ifdef ALLOW_OBCSN_CONTROL
209                              if (icvar .eq. 11) then                    
210                                 cbuffindex = nWetobcsnGlo(k,iobcs)
211                              endif
212    #endif
213    #ifdef ALLOW_OBCSS_CONTROL
214                              if (icvar .eq. 12) then
215                                 cbuffindex = nWetobcssGlo(k,iobcs)
216                              endif
217    #endif
218    #ifdef ALLOW_OBCSW_CONTROL
219                              if (icvar .eq. 13) then
220                                 cbuffindex = nWetobcswGlo(k,iobcs)
221                              endif
222    #endif
223    #ifdef ALLOW_OBCSE_CONTROL
224                              if (icvar .eq. 14) then
225                                 cbuffindex = nWetobcseGlo(k,iobcs)
226                              endif
227    #endif
228                            endif
229    cgg)
230                            if (cbuffindex .gt. 0) then
231                               do icvcomp = 1,cbuffindex
232                                  cbuff(icvcomp) = vv(icvoffset + icvcomp)
233    cgg( Right now, the changes to the open boundary velocities are not balanced.
234    cgg( The model will crash due to physical reasons.
235    cgg( However, we can optimize with respect to just O.B. T and S if the
236    cgg( next two lines are uncommented.
237    cgg                              if (iobcs .eq. 3) cbuff(icvcomp)=0.
238    cgg                              if (iobcs .eq. 4) cbuff(icvcomp)=0.
239                               enddo
240                               write( funit ) cbuffindex
241                               write( funit ) k
242                               write( funit ) (cbuff(ii), ii=1,cbuffindex)
243                               icvoffset = icvoffset + cbuffindex
244                            endif
245                         enddo
246                      enddo
247                   enddo
248                enddo
249             endif
250          enddo
251    
252          close( funit )
253    cph(
254          print *,'in owd: icvoffset', icvoffset
255    cph)
256    
257          return
258          end
259    
260    
261    
262    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.3
  ViewVC Help
Powered by ViewVC 1.1.22