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

Contents of /MITgcm/optim/optim_writedata.F

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


Revision 1.1.2.1 - (show annotations) (download)
Tue Feb 5 20:34:35 2002 UTC (22 years 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
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