/[MITgcm]/MITgcm/pkg/ecco/ecco_cost_init_barfiles.F
ViewVC logotype

Annotation of /MITgcm/pkg/ecco/ecco_cost_init_barfiles.F

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


Revision 1.7 - (hide annotations) (download)
Tue Oct 9 00:02:51 2007 UTC (16 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59k, checkpoint59j
Changes since 1.6: +25 -23 lines
add missing cvs $Header:$ or $Name:$

1 jmc 1.7 C $Header: $
2     C $Name: $
3 heimbach 1.1
4     #include "COST_CPPOPTIONS.h"
5    
6 heimbach 1.3
7 heimbach 1.1 subroutine ecco_cost_init_barfiles( mythid )
8    
9     c ==================================================================
10     c SUBROUTINE ecco_cost_init_barfiles
11     c ==================================================================
12     c
13     c-- Initialise adjoint of monthly mean files calculated
14     c-- in cost_averagesfields (and their ad...).
15     c
16     c started: heimbach@mit.edu 20-Mar-2002
17     c
18     c ==================================================================
19     c SUBROUTINE ecco_cost_cost_init_barfiles
20     c ==================================================================
21    
22     implicit none
23    
24     c == global variables ==
25    
26     #include "EEPARAMS.h"
27     #include "SIZE.h"
28    
29     #include "optim.h"
30     #include "ecco_cost.h"
31     #include "ctrl.h"
32     #include "ctrl_dummy.h"
33 heimbach 1.5 #ifdef ALLOW_SEAICE
34     # include "SEAICE_COST.h"
35     #endif
36 heimbach 1.1
37     c == routine arguments ==
38    
39     integer mythid
40    
41     #ifdef ALLOW_COST
42     c == local variables ==
43    
44     integer bi,bj
45     integer i,j,k
46     integer itlo,ithi
47     integer jtlo,jthi
48     integer jmin,jmax
49     integer imin,imax
50    
51     integer ilps, ils, ilt, irec
52    
53     character*(128) fnamepsbar
54     character*(128) fnametbar
55     character*(128) fnamesbar
56     character*(128) fnameubar
57     character*(128) fnamevbar
58     character*(128) fnamewbar
59     character*(128) fnametauxbar
60     character*(128) fnametauybar
61     character*(128) fnamehfluxbar
62     character*(128) fnamesfluxbar
63 heimbach 1.5 character*(128) fnamesmrareabar
64     c
65 heimbach 1.1 character*(128) adfnamepsbar
66     character*(128) adfnametbar
67     character*(128) adfnamesbar
68     character*(128) adfnameubar
69     character*(128) adfnamevbar
70     character*(128) adfnamewbar
71     character*(128) adfnametauxbar
72     character*(128) adfnametauybar
73     character*(128) adfnamehfluxbar
74     character*(128) adfnamesfluxbar
75 heimbach 1.5 character*(128) adfnamesmrareabar
76 heimbach 1.1
77     c == external functions ==
78    
79     integer ilnblnk
80     external ilnblnk
81    
82     c == end of interface ==
83    
84     jtlo = mybylo(mythid)
85     jthi = mybyhi(mythid)
86     itlo = mybxlo(mythid)
87     ithi = mybxhi(mythid)
88     jmin = 1
89     jmax = sny
90     imin = 1
91     imax = snx
92    
93     do bj = jtlo,jthi
94     do bi = itlo,ithi
95     do j = jmin,jmax
96     do i = imin,imax
97     tmpfld2d(i,j,bi,bj) = 0. _d 0
98     enddo
99     enddo
100     enddo
101     enddo
102     do bj = jtlo,jthi
103     do bi = itlo,ithi
104     do k = 1,nr
105     do j = jmin,jmax
106     do i = imin,imax
107     tmpfld3d(i,j,k,bi,bj) = 0. _d 0
108     enddo
109     enddo
110     enddo
111     enddo
112     enddo
113    
114     cgg( Also initialize the tmp fields used in ctrl_getobcs and cost_obcs.
115     #ifdef OBCS_CONTROL
116     do bj = jtlo,jthi
117     do bi = itlo,ithi
118     do k = 1,nr
119     do j = jmin,jmax
120     tmpfldyz (j,k,bi,bj) = 0. _d 0
121     tmpfldyz2(j,k,bi,bj) = 0. _d 0
122     enddo
123     enddo
124     enddo
125     enddo
126     do bj = jtlo,jthi
127     do bi = itlo,ithi
128     do k = 1,nr
129     do i = imin,imax
130     tmpfldxz (i,k,bi,bj) = 0. _d 0
131     tmpfldxz2(i,k,bi,bj) = 0. _d 0
132     enddo
133     enddo
134     enddo
135     enddo
136     #endif
137     cgg)
138    
139     #ifdef ALLOW_SSH_COST_CONTRIBUTION
140     c-- Save psbar on file.
141     ilps=ilnblnk( psbarfile )
142 jmc 1.7 write(fnamepsbar,'(2a,i10.10)')
143 heimbach 1.1 & psbarfile(1:ilps), '.', optimcycle
144     write(adfnamepsbar,'(3a,i10.10)')
145     & yadprefix, psbarfile(1:ilps), '.', optimcycle
146    
147     do irec = 1, ndaysrec
148 heimbach 1.3 c call active_write_xy( fnamepsbar, tmpfld2d, irec,
149     c & optimcycle, mythid, xx_psbar_mean_dummy )
150 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
151     call active_write_xy( adfnamepsbar, tmpfld2d, irec,
152     & optimcycle,mythid, xx_psbar_mean_dummy )
153     #endif
154     enddo
155     #endif /* ALLOW_SSH_COST_CONTRIBUTION */
156    
157     #if (defined (ALLOW_THETA_COST_CONTRIBUTION) || \
158     defined (ALLOW_CTDT_COST_CONTRIBUTION) || \
159     defined (ALLOW_CTDTCLIM_COST_CONTRIBUTION) || \
160     defined (ALLOW_XBT_COST_CONTRIBUTION) || \
161     defined (ALLOW_DRIFT_COST_CONTRIBUTION) || \
162     defined (ALLOW_OBCS_COST_CONTRIBUTION))
163     c-- Save tbar on file.
164     ilt=ilnblnk( tbarfile )
165 jmc 1.7 write(fnametbar,'(2a,i10.10)')
166 heimbach 1.1 & tbarfile(1:ilt), '.', optimcycle
167 jmc 1.7 write(adfnametbar,'(3a,i10.10)')
168 heimbach 1.1 & yadprefix, tbarfile(1:ilt), '.', optimcycle
169    
170     do irec = 1,nmonsrec
171 heimbach 1.3 c call active_write_xyz( fnametbar, tmpfld3d, irec,
172     c & optimcycle, mythid, xx_tbar_mean_dummy )
173 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
174 jmc 1.7 call active_write_xyz( adfnametbar, tmpfld3d, irec,
175 heimbach 1.1 & optimcycle, mythid, xx_tbar_mean_dummy )
176     #endif
177     enddo
178 heimbach 1.3 #else
179     #ifdef ALLOW_SST_COST_CONTRIBUTION
180     c-- Save tbar on file.
181     ilt=ilnblnk( tbarfile )
182 jmc 1.7 write(fnametbar,'(2a,i10.10)')
183 heimbach 1.3 & tbarfile(1:ilt), '.', optimcycle
184 jmc 1.7 write(adfnametbar,'(3a,i10.10)')
185 heimbach 1.3 & yadprefix, tbarfile(1:ilt), '.', optimcycle
186     do irec = 1,nmonsrec
187     c call active_write_xy( fnametbar, tmpfld2d, irec,
188     c & optimcycle, mythid, xx_tbar_mean_dummy )
189     #ifndef ALLOW_TANGENTLINEAR_RUN
190 jmc 1.7 call active_write_xy( adfnametbar, tmpfld2d, irec,
191 heimbach 1.3 & optimcycle, mythid, xx_tbar_mean_dummy )
192     #endif
193     enddo
194     #endif
195 heimbach 1.1 #endif
196    
197     #if (defined (ALLOW_SALT_COST_CONTRIBUTION) || \
198     defined (ALLOW_CTDS_COST_CONTRIBUTION) || \
199     defined (ALLOW_CTDSCLIM_COST_CONTRIBUTION) || \
200     defined (ALLOW_DRIFT_COST_CONTRIBUTION) || \
201     defined (ALLOW_OBCS_COST_CONTRIBUTION))
202     c-- Save sbar.
203     ils=ilnblnk( sbarfile )
204 jmc 1.7 write(fnamesbar,'(2a,i10.10)')
205 heimbach 1.1 & sbarfile(1:ils), '.', optimcycle
206 jmc 1.7 write(adfnamesbar,'(3a,i10.10)')
207 heimbach 1.1 & yadprefix, sbarfile(1:ils), '.', optimcycle
208    
209     do irec = 1,nmonsrec
210 heimbach 1.3 c call active_write_xyz( fnamesbar, tmpfld3d, irec,
211     c & optimcycle, mythid, xx_sbar_mean_dummy)
212 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
213     call active_write_xyz( adfnamesbar, tmpfld3d, irec,
214     & optimcycle, mythid, xx_sbar_mean_dummy)
215     #endif
216     enddo
217 heimbach 1.3 #else
218     #ifdef ALLOW_SST_COST_CONTRIBUTION
219     c-- Save sbar.
220     ils=ilnblnk( sbarfile )
221 jmc 1.7 write(fnamesbar,'(2a,i10.10)')
222 heimbach 1.3 & sbarfile(1:ils), '.', optimcycle
223 jmc 1.7 write(adfnamesbar,'(3a,i10.10)')
224 heimbach 1.3 & yadprefix, sbarfile(1:ils), '.', optimcycle
225    
226     do irec = 1,nmonsrec
227     c call active_write_xy( fnamesbar, tmpfld2d, irec,
228     c & optimcycle, mythid, xx_sbar_mean_dummy)
229     #ifndef ALLOW_TANGENTLINEAR_RUN
230     call active_write_xy( adfnamesbar, tmpfld2d, irec,
231     & optimcycle, mythid, xx_sbar_mean_dummy)
232     #endif
233     enddo
234     #endif
235 heimbach 1.1 #endif
236    
237     #if (defined (ALLOW_DRIFTER_COST_CONTRIBUTION) || \
238 heimbach 1.3 defined (ALLOW_OBCS_COST_CONTRIBUTION))
239 jmc 1.7 cph There's a mismatch between the cost_drifer and the
240 heimbach 1.1 cph cost_obcs usage of ubar, vbar.
241     cph cost_obcs refers to monthly means, cost_drifer to total mean.
242     cph Needs to be updated for cost_drifer.
243    
244     c-- Save ubar and vbar.
245     ils=ilnblnk( ubarfile )
246 jmc 1.7 write(fnameubar,'(2a,i10.10)')
247 heimbach 1.1 & ubarfile(1:ils), '.', optimcycle
248 jmc 1.7 write(fnamevbar,'(2a,i10.10)')
249 heimbach 1.1 & vbarfile(1:ils), '.', optimcycle
250 jmc 1.7 write(adfnameubar,'(3a,i10.10)')
251 heimbach 1.1 & yadprefix, ubarfile(1:ils), '.', optimcycle
252 jmc 1.7 write(adfnamevbar,'(3a,i10.10)')
253 heimbach 1.1 & yadprefix, vbarfile(1:ils), '.', optimcycle
254    
255     do irec = 1,nmonsrec
256 heimbach 1.3 c call active_write_xyz( fnameubar, tmpfld3d, irec,
257     c & optimcycle, mythid, xx_ubar_mean_dummy)
258     c call active_write_xyz( fnamevbar, tmpfld3d, irec,
259     c & optimcycle, mythid, xx_vbar_mean_dummy)
260 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
261     call active_write_xyz( adfnameubar, tmpfld3d, irec,
262     & optimcycle, mythid, xx_ubar_mean_dummy)
263     call active_write_xyz( adfnamevbar, tmpfld3d, irec,
264     & optimcycle, mythid, xx_vbar_mean_dummy)
265     #endif
266     enddo
267     #endif
268    
269     #ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
270     c-- Save wbar
271     ils=ilnblnk( wbarfile )
272 jmc 1.7 write(fnamewbar,'(2a,i10.10)')
273 heimbach 1.1 & wbarfile(1:ils), '.', optimcycle
274 jmc 1.7 write(adfnamewbar,'(3a,i10.10)')
275 heimbach 1.1 & yadprefix, wbarfile(1:ils), '.', optimcycle
276    
277     do irec = 1,nmonsrec
278 heimbach 1.3 c call active_write_xyz( fnamewbar, tmpfld3d, irec,
279     c & optimcycle, mythid, xx_wbar_mean_dummy)
280 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
281     call active_write_xyz( adfnamewbar, tmpfld3d, irec,
282     & optimcycle, mythid, xx_wbar_mean_dummy)
283     #endif
284     enddo
285     #endif
286    
287     #ifdef ALLOW_SCAT_COST_CONTRIBUTION
288     c-- Save tauxbar, tauybar on file.
289     ilps=ilnblnk( tauxbarfile )
290 jmc 1.7 write(fnametauxbar,'(2a,i10.10)')
291 heimbach 1.1 & tauxbarfile(1:ilps), '.', optimcycle
292     write(adfnametauxbar,'(3a,i10.10)')
293     & yadprefix, tauxbarfile(1:ilps), '.', optimcycle
294     ilps=ilnblnk( tauybarfile )
295 jmc 1.7 write(fnametauybar,'(2a,i10.10)')
296 heimbach 1.1 & tauybarfile(1:ilps), '.', optimcycle
297     write(adfnametauybar,'(3a,i10.10)')
298     & yadprefix, tauybarfile(1:ilps), '.', optimcycle
299    
300     do irec = 1, nmonsrec
301 heimbach 1.3 c call active_write_xy( fnametauxbar, tmpfld2d, irec,
302     c & optimcycle, mythid, xx_taux_mean_dummy )
303     c call active_write_xy( fnametauybar, tmpfld2d, irec,
304     c & optimcycle, mythid, xx_tauy_mean_dummy )
305 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
306     call active_write_xy( adfnametauxbar, tmpfld2d, irec,
307     & optimcycle,mythid, xx_taux_mean_dummy )
308     call active_write_xy( adfnametauybar, tmpfld2d, irec,
309     & optimcycle,mythid, xx_tauy_mean_dummy )
310     #endif
311     enddo
312     #endif
313    
314     #ifdef ALLOW_MEAN_HFLUX_COST_CONTRIBUTION
315     c-- Save hfluxbar on file.
316     ilps=ilnblnk( hfluxbarfile )
317 jmc 1.7 write(fnamehfluxbar,'(2a,i10.10)')
318 heimbach 1.1 & hfluxbarfile(1:ilps), '.', optimcycle
319     write(adfnamehfluxbar,'(3a,i10.10)')
320     & yadprefix, hfluxbarfile(1:ilps), '.', optimcycle
321    
322     do irec = 1, 1
323 heimbach 1.3 c call active_write_xy( fnamehfluxbar, tmpfld2d, irec,
324     c & optimcycle, mythid, xx_hflux_mean_dummy )
325 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
326     call active_write_xy( adfnamehfluxbar, tmpfld2d, irec,
327     & optimcycle,mythid, xx_hflux_mean_dummy )
328     #endif
329     enddo
330     #endif
331    
332     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
333     c-- Save sfluxbar on file.
334     ilps=ilnblnk( sfluxbarfile )
335 jmc 1.7 write(fnamesfluxbar,'(2a,i10.10)')
336 heimbach 1.1 & sfluxbarfile(1:ilps), '.', optimcycle
337     write(adfnamesfluxbar,'(3a,i10.10)')
338     & yadprefix, sfluxbarfile(1:ilps), '.', optimcycle
339    
340 heimbach 1.6 do irec = 1, nyearsrec
341 heimbach 1.3 c call active_write_xy( fnamesfluxbar, tmpfld2d, irec,
342     c & optimcycle, mythid, xx_sflux_mean_dummy )
343 heimbach 1.1 #ifndef ALLOW_TANGENTLINEAR_RUN
344     call active_write_xy( adfnamesfluxbar, tmpfld2d, irec,
345     & optimcycle,mythid, xx_sflux_mean_dummy )
346     #endif
347     enddo
348     #endif
349    
350 heimbach 1.5 #ifdef ALLOW_SEAICE
351    
352     #ifdef ALLOW_SEAICE_COST_SMR_AREA
353     ilps=ilnblnk( smrareabarfile )
354 jmc 1.7 write(fnamesmrareabar,'(2a,i10.10)')
355 heimbach 1.5 & smrareabarfile(1:ilps), '.', optimcycle
356     write(adfnamesmrareabar,'(3a,i10.10)')
357     & yadprefix, smrareabarfile(1:ilps), '.', optimcycle
358    
359     do irec = 1, ndaysrec
360     c call active_write_xy( fnamesmrareabar, tmpfld2d, irec,
361     c & optimcycle, mythid, xx_smrareabar_mean_dummy )
362     #ifndef ALLOW_TANGENTLINEAR_RUN
363     call active_write_xy( adfnamesmrareabar, tmpfld2d, irec,
364     & optimcycle,mythid, xx_smrareabar_mean_dummy )
365     #endif
366     enddo
367     #endif /* ALLOW_SEAICE_COST_SMR_AREA */
368    
369     #endif /* ALLOW_SEAICE */
370    
371 heimbach 1.1 #endif /* ALLOW_COST */
372    
373     return
374     end
375    

  ViewVC Help
Powered by ViewVC 1.1.22