/[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.12 - (hide annotations) (download)
Tue Jun 2 14:49:13 2015 UTC (8 years, 9 months ago) by gforget
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65n, checkpoint65m, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, HEAD
Changes since 1.11: +7 -6 lines
- remove un-necessary option files includes

1 heimbach 1.2
2 gforget 1.12 c ECCO_CPPOPTIONS used to affect maxcvars
3     c and def ALLOW_OBCSN_CONTROL etc (OBCS masks etc)
4     c#include ECCO_CPPOPTIONS.h
5    
6     c CTRL_OPTIONS affects maxcvars and may def
7     c ALLOW_OBCSN_CONTROL etc (OBCS masks etc)
8     #include "CTRL_OPTIONS.h"
9 gforget 1.11
10 heimbach 1.2 subroutine optim_writedata(
11     I nn,
12     I dfile,
13     I lheaderonly,
14     I ff,
15     I vv
16     & )
17    
18     c ==================================================================
19     c SUBROUTINE optim_writedata
20     c ==================================================================
21     c
22     c o Writes the latest update of the control vector to file(s). These
23     c files can then be used by the MITgcmUV state estimation setup
24     c for the next forward/adjoint simluation.
25     c
26     c started: Christian Eckert eckert@mit.edu 12-Apr-2000
27     c
28     c changed: Patrick Heimbach heimbach@mit.edu 19-Jun-2000
29     c - finished, revised and debugged
30     c
31     c ==================================================================
32     c SUBROUTINE optim_writedata
33     c ==================================================================
34    
35     implicit none
36    
37     c == global variables ==
38    
39     #include "EEPARAMS.h"
40     #include "SIZE.h"
41     #include "ctrl.h"
42     #include "optim.h"
43     #include "minimization.h"
44    
45     c == routine arguments ==
46    
47     integer nn
48     _RL ff
49     _RL vv(nn)
50    
51     character*(9) dfile
52     logical lheaderonly
53    
54     c == local variables ==
55    
56     integer i,j,k
57     integer ii
58     integer bi,bj
59     integer biG,bjG
60     integer nopt
61     integer icvcomp
62     integer icvoffset
63     integer icvrec
64     integer icvar
65     integer funit
66     integer cbuffindex
67    
68 heimbach 1.5 real*4 cbuff( sNx*nSx*nPx*sNy*nSy*nPy )
69 heimbach 1.2
70     character*(128) fname
71     cgg(
72     _RL gg
73     integer igg
74     integer iobcs
75     cgg)
76    
77     c == end of interface ==
78    
79     c-- I/O unit to use.
80     funit = 20
81    
82     c-- Next optimization cycle.
83     nopt = optimcycle + 1
84    
85     if ( dfile .eq. ctrlname ) then
86     print*
87     print*,' OPTIM_WRITEDATA: Writing new control vector to file(s)'
88     print*,' for optimization cycle: ',nopt
89     print*
90     else
91     print*
92     print*,' OPTIM_WRITEDATA: subroutine called by a false *dfile*'
93     print*,' argument. *dfile* = ',dfile
94     print*
95     stop ' ... stopped in OPTIM_WRITEDATA.'
96     endif
97    
98     bjG = 1 + (myygloballo - 1)/sny
99     biG = 1 + (myxgloballo - 1)/snx
100    
101     c-- Generate file name and open the file.
102     write(fname(1:128),'(4a,i4.4)')
103 dfer 1.7 & dfile,'_',yctrlid(1:10),'.opt', nopt
104 heimbach 1.2 open( funit, file = fname,
105     & status = 'new',
106     & form = 'unformatted',
107     & access = 'sequential' )
108    
109     cph(
110     print *, 'pathei: nvartype ', nvartype
111     print *, 'pathei: nvarlength ', nvarlength
112 dfer 1.7 print *, 'pathei: yctrlid ', yctrlid
113 heimbach 1.2 print *, 'pathei: nopt ', nopt
114     print *, 'pathei: ff ', ff
115     print *, 'pathei: iG ', biG
116     print *, 'pathei: jG ', bjG
117     print *, 'pathei: nsx ', nsx
118     print *, 'pathei: nsy ', nsy
119    
120 heimbach 1.3 print *, 'pathei: nWetcGlobal ',
121     & (nWetcGlobal(k), k=1,nr)
122     print *, 'pathei: nWetsGlobal ',
123     & (nWetsGlobal(k), k=1,nr)
124     print *, 'pathei: nWetwGlobal ',
125     & (nWetwGlobal(k), k=1,nr)
126     print *, 'pathei: nWetvGlobal ',
127     & (nWetvGlobal(k), k=1,nr)
128 heimbach 1.2 print *, 'pathei: ncvarindex ',
129     & (ncvarindex(i), i=1,maxcvars)
130     print *, 'pathei: ncvarrecs ',
131     & (ncvarrecs(i), i=1,maxcvars)
132     print *, 'pathei: ncvarxmax ',
133     & (ncvarxmax(i), i=1,maxcvars)
134     print *, 'pathei: ncvarymax ',
135     & (ncvarymax(i), i=1,maxcvars)
136     print *, 'pathei: ncvarnrmax ',
137     & (ncvarnrmax(i), i=1,maxcvars)
138     print *, 'pathei: ncvargrd ',
139     & (ncvargrd(i), i=1,maxcvars)
140     cph)
141    
142     c-- Write the header.
143     write( funit ) nvartype
144     write( funit ) nvarlength
145 dfer 1.7 write( funit ) yctrlid
146 heimbach 1.2 write( funit ) optimcycle
147     write( funit ) ff
148     write( funit ) big
149     write( funit ) bjg
150     write( funit ) nsx
151     write( funit ) nsy
152 heimbach 1.3 write( funit ) (nWetcGlobal(k), k=1,nr)
153     write( funit ) (nWetsGlobal(k), k=1,nr)
154     write( funit ) (nWetwGlobal(k), k=1,nr)
155 heimbach 1.4 #ifdef ALLOW_CTRL_WETV
156 heimbach 1.3 write( funit ) (nWetvGlobal(k), k=1,nr)
157 heimbach 1.4 #endif
158 mlosch 1.8 #ifdef ALLOW_SHIFWFLX_CONTROL
159     write(funit) (nWetiGlobal(k), k=1,nr)
160     c write(funit) nWetiGlobal(1)
161     #endif
162 heimbach 1.2
163     cgg( Add OBCS Mask information into the header section for optimization.
164     #ifdef ALLOW_OBCSN_CONTROL
165 heimbach 1.3 write(funit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
166 heimbach 1.2 #endif
167     #ifdef ALLOW_OBCSS_CONTROL
168 heimbach 1.3 write(funit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
169 heimbach 1.2 #endif
170     #ifdef ALLOW_OBCSW_CONTROL
171 heimbach 1.3 write(funit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
172 heimbach 1.2 #endif
173     #ifdef ALLOW_OBCSE_CONTROL
174 heimbach 1.3 write(funit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
175 heimbach 1.2 #endif
176     cgg)
177    
178     write( funit ) (ncvarindex(i), i=1,maxcvars)
179     write( funit ) (ncvarrecs(i), i=1,maxcvars)
180     write( funit ) (ncvarxmax(i), i=1,maxcvars)
181     write( funit ) (ncvarymax(i), i=1,maxcvars)
182     write( funit ) (ncvarnrmax(i), i=1,maxcvars)
183     write( funit ) (ncvargrd(i), i=1,maxcvars)
184     write( funit )
185    
186     c-- Write the data.
187     icvoffset = 0
188     do icvar = 1,maxcvars
189     if ( ncvarindex(icvar) .ne. -1 ) then
190     do icvrec = 1,ncvarrecs(icvar)
191 heimbach 1.10 cph do bj = 1,nsy
192     cph do bi = 1,nsx
193 heimbach 1.2 write( funit ) ncvarindex(icvar)
194     write( funit ) bj
195     write( funit ) bi
196     do k = 1,ncvarnrmax(icvar)
197     cbuffindex = 0
198     if (ncvargrd(icvar) .eq. 'c') then
199 heimbach 1.3 cbuffindex = nWetcGlobal(k)
200 heimbach 1.2 else if (ncvargrd(icvar) .eq. 's') then
201 heimbach 1.3 cbuffindex = nWetsGlobal(k)
202 heimbach 1.2 else if (ncvargrd(icvar) .eq. 'w') then
203 heimbach 1.3 cbuffindex = nWetwGlobal(k)
204     else if (ncvargrd(icvar) .eq. 'v') then
205     cbuffindex = nWetvGlobal(k)
206 mlosch 1.8 #ifdef ALLOW_SHIFWFLX_CONTROL
207     else if (ncvargrd(icvar) .eq. 'i') then
208     cbuffindex = nWetiGlobal(k)
209     #endif
210 heimbach 1.2 cgg( O.B. points have the grid mask "m".
211     else if (ncvargrd(icvar) .eq. 'm') then
212     cgg From "icvrec", calculate what iobcs must be.
213     gg = (icvrec-1)/nobcs
214     igg = int(gg)
215     iobcs= icvrec - igg*nobcs
216     #ifdef ALLOW_OBCSN_CONTROL
217     if (icvar .eq. 11) then
218 heimbach 1.3 cbuffindex = nWetobcsnGlo(k,iobcs)
219 heimbach 1.2 endif
220     #endif
221     #ifdef ALLOW_OBCSS_CONTROL
222     if (icvar .eq. 12) then
223 heimbach 1.3 cbuffindex = nWetobcssGlo(k,iobcs)
224 heimbach 1.2 endif
225     #endif
226     #ifdef ALLOW_OBCSW_CONTROL
227     if (icvar .eq. 13) then
228 heimbach 1.3 cbuffindex = nWetobcswGlo(k,iobcs)
229 heimbach 1.2 endif
230     #endif
231     #ifdef ALLOW_OBCSE_CONTROL
232     if (icvar .eq. 14) then
233 heimbach 1.3 cbuffindex = nWetobcseGlo(k,iobcs)
234 heimbach 1.2 endif
235     #endif
236     endif
237     cgg)
238     if (cbuffindex .gt. 0) then
239     do icvcomp = 1,cbuffindex
240     cbuff(icvcomp) = vv(icvoffset + icvcomp)
241 mlosch 1.9 c If you want to optimize with respect to just O.B. T and S
242     c uncomment the next two lines.
243     c if (iobcs .eq. 3) cbuff(icvcomp)=0.
244     c if (iobcs .eq. 4) cbuff(icvcomp)=0.
245 heimbach 1.2 enddo
246     write( funit ) cbuffindex
247     write( funit ) k
248     write( funit ) (cbuff(ii), ii=1,cbuffindex)
249     icvoffset = icvoffset + cbuffindex
250     endif
251     enddo
252 heimbach 1.10 cph enddo
253     cph enddo
254 heimbach 1.2 enddo
255     endif
256     enddo
257    
258     close( funit )
259     cph(
260     print *,'in owd: icvoffset', icvoffset
261     cph)
262    
263     return
264     end
265    
266    
267    
268    

  ViewVC Help
Powered by ViewVC 1.1.22