/[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.1 by heimbach, Tue Feb 5 20:34: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    
34    #include "ecco.h"
35    #include "ctrl.h"
36    #include "optim.h"
37    #include "minimization.h"
38    
39    c     == routine arguments ==
40    
41          integer nn
42          _RL     ff
43          _RL     vv(nn)
44    
45          character*(9) dfile
46          logical lheaderonly
47    
48    c     == local variables ==
49    
50          integer i,j,k
51          integer ii
52          integer bi,bj
53          integer biG,bjG
54          integer nopt
55          integer icvcomp
56          integer icvoffset
57          integer icvrec
58          integer icvar
59          integer funit
60          integer cbuffindex
61    
62          _RL     cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
63    
64          character*(128) fname
65    
66    c     == end of interface ==
67    
68    c--   I/O unit to use.
69          funit = 20
70    
71    c--   Next optimization cycle.
72          nopt = optimcycle + 1
73    
74          if ( dfile .eq. ctrlname ) then
75            print*
76            print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)'
77            print*,'             for optimization cycle: ',nopt
78            print*
79          else
80            print*
81            print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*'
82            print*,'             argument. *dfile* = ',dfile
83            print*
84            stop   '  ...  stopped in OPTIM_WRITEDATA.'
85          endif
86    
87          bjG = 1 + (myygloballo - 1)/sny
88          biG = 1 + (myxgloballo - 1)/snx
89    
90    c--         Generate file name and open the file.
91          write(fname(1:128),'(4a,i4.4)')
92         &     dfile,'_',expId(1:10),'.opt', nopt
93          open( funit, file   = fname,
94         &     status = 'new',
95         &     form   = 'unformatted',
96         &     access = 'sequential'   )
97    
98    cph(
99             print *, 'pathei: nvartype ', nvartype
100             print *, 'pathei: nvarlength ', nvarlength
101             print *, 'pathei: expId ', expId
102             print *, 'pathei: nopt ', nopt
103             print *, 'pathei: ff ', ff
104             print *, 'pathei: iG ', biG
105             print *, 'pathei: jG ', bjG
106             print *, 'pathei: nsx ', nsx
107             print *, 'pathei: nsy ', nsy
108            
109             print *, 'pathei: nWetcTile ',
110         &        (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
111             print *, 'pathei: nWetsTile ',
112         &        (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
113             print *, 'pathei: nWetwTile ',
114         &        (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy), k=1,nr)
115             print *, 'pathei: ncvarindex ',
116         &        (ncvarindex(i), i=1,maxcvars)
117             print *, 'pathei: ncvarrecs ',
118         &        (ncvarrecs(i),  i=1,maxcvars)
119             print *, 'pathei: ncvarxmax ',
120         &        (ncvarxmax(i),  i=1,maxcvars)
121             print *, 'pathei: ncvarymax ',
122         &        (ncvarymax(i),  i=1,maxcvars)
123             print *, 'pathei: ncvarnrmax ',
124         &        (ncvarnrmax(i), i=1,maxcvars)
125             print *, 'pathei: ncvargrd ',
126         &        (ncvargrd(i),   i=1,maxcvars)
127    cph)
128    
129    c--   Write the header.
130          write( funit ) nvartype
131          write( funit ) nvarlength
132          write( funit ) expId
133          write( funit ) optimcycle
134          write( funit ) ff
135          write( funit ) big
136          write( funit ) bjg
137          write( funit ) nsx
138          write( funit ) nsy
139          write( funit ) (((nWetcTile(i,j,k), i=1,nsx), j=1,nsy),
140         &     k=1,nr)
141          write( funit ) (((nWetsTile(i,j,k), i=1,nsx), j=1,nsy),
142         &     k=1,nr)
143          write( funit ) (((nWetwTile(i,j,k), i=1,nsx), j=1,nsy),
144         &     k=1,nr)
145          write( funit ) (ncvarindex(i), i=1,maxcvars)
146          write( funit ) (ncvarrecs(i),  i=1,maxcvars)
147          write( funit ) (ncvarxmax(i),  i=1,maxcvars)
148          write( funit ) (ncvarymax(i),  i=1,maxcvars)
149          write( funit ) (ncvarnrmax(i), i=1,maxcvars)
150          write( funit ) (ncvargrd(i),   i=1,maxcvars)
151          write( funit )
152    
153    c--         Write the data.
154          icvoffset = 0
155          do icvar = 1,maxcvars
156             if ( ncvarindex(icvar) .ne. -1 ) then
157                do icvrec = 1,ncvarrecs(icvar)
158    cph(
159                   print *,'in owd: icvar, icvrec, ncvarrecs, ncvarindex',
160         &              icvar, icvrec, ncvarrecs(icvar), ncvarindex(icvar)
161    cph)
162                   do bj = 1,nsy
163                      do bi = 1,nsx
164                         write( funit ) ncvarindex(icvar)
165                         write( funit ) bj
166                         write( funit ) bi
167                         do k = 1,ncvarnrmax(icvar)
168                            cbuffindex = 0
169                            if (ncvargrd(icvar) .eq. 'c') then
170                               cbuffindex = nwetctile(bi,bj,k)
171                            else if (ncvargrd(icvar) .eq. 's') then
172                               cbuffindex = nwetstile(bi,bj,k)
173                            else if (ncvargrd(icvar) .eq. 'w') then
174                               cbuffindex = nwetwtile(bi,bj,k)
175                            endif
176                            if (cbuffindex .gt. 0) then
177                               do icvcomp = 1,cbuffindex
178                                  cbuff(icvcomp) = vv(icvoffset + icvcomp)
179                               enddo
180                               write( funit ) cbuffindex
181                               write( funit ) k
182                               write( funit ) (cbuff(ii), ii=1,cbuffindex)
183                               icvoffset = icvoffset + cbuffindex
184                            endif
185                         enddo
186                      enddo
187                   enddo
188                enddo
189             endif
190          enddo
191    
192          close( funit )
193    cph(
194          print *,'in owd: icvoffset', icvoffset
195    cph)
196    
197          return
198          end
199    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.2.1
  ViewVC Help
Powered by ViewVC 1.1.22