/[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.1 - (hide annotations) (download)
Tue Feb 5 20:34:35 2002 UTC (22 years, 2 months ago) by heimbach
Branch: ecco-branch
CVS Tags: ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, ecco_c44_e20, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5
Changes since 1.1: +199 -0 lines
o Updating adjoint/makefile to ECCO code
o Adding optim and lsopt for line search optimization.
o Adding verif. experiments for ECCO
Code will be tagged ecco-branch-mod1.

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    
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    

  ViewVC Help
Powered by ViewVC 1.1.22