/[MITgcm]/MITgcm_contrib/SOSE/code_ad/cost_averagesfields.F
ViewVC logotype

Annotation of /MITgcm_contrib/SOSE/code_ad/cost_averagesfields.F

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


Revision 1.1 - (hide annotations) (download)
Fri Apr 23 19:55:11 2010 UTC (15 years, 3 months ago) by mmazloff
Branch: MAIN
CVS Tags: HEAD
original files

1 mmazloff 1.1 C $Header: /u/gcmpack/MITgcm/pkg/ecco/cost_averagesfields.F,v 1.27 2009/11/20 22:29:08 heimbach Exp $
2     C $Name: $
3    
4     #include "COST_CPPOPTIONS.h"
5     #ifdef ALLOW_OBCS
6     # include "OBCS_OPTIONS.h"
7     #endif
8     #ifdef ALLOW_SEAICE
9     # include "SEAICE_OPTIONS.h"
10     #endif
11    
12     subroutine cost_averagesfields( mytime, mythid )
13    
14     c ==================================================================
15     c SUBROUTINE cost_averagesfields
16     c ==================================================================
17     c
18     c o Compute time averages of etaN, theta, and salt. The counters
19     c are explicitly calculated instead of being incremented. This
20     c reduces dependencies. The latter is useful for the adjoint code
21     c generation.
22     c
23     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
24     c
25     c changed: Christian Eckert eckert@mit.edu 24-Feb-2000
26     c
27     c - Restructured the code in order to create a package
28     c for the MITgcmUV.
29     c
30     c ==================================================================
31     c SUBROUTINE cost_averagesfields
32     c ==================================================================
33    
34     implicit none
35    
36     c == global variables ==
37    
38     #include "EEPARAMS.h"
39     #include "SIZE.h"
40     #include "PARAMS.h"
41     #include "DYNVARS.h"
42     #include "FFIELDS.h"
43     #include "GRID.h"
44     #include "CG2D.h"
45    
46     #include "optim.h"
47     #include "ecco_cost.h"
48     #include "ctrl_dummy.h"
49     #ifdef ALLOW_EXF
50     # include "EXF_FIELDS.h"
51     #endif
52     #ifdef ALLOW_SEAICE
53     # include "SEAICE.h"
54     # include "SEAICE_COST.h"
55     #endif
56    
57     c == routine arguments ==
58    
59     _RL mytime
60     integer mythid
61    
62     c == local variables ==
63    
64     integer myiter
65     integer bi,bj
66     integer i,j,k
67     integer ig,jg
68     integer itlo,ithi
69     integer jtlo,jthi
70     integer jmin,jmax
71     integer imin,imax
72    
73     logical first
74     logical startofday
75     logical startofmonth
76     logical startofyear
77     logical inday
78     logical inmonth
79     logical inyear
80     logical last
81     logical endofday
82     logical endofmonth
83     logical endofyear
84     logical intmp
85    
86     integer ilps, ils,ilt
87    
88     character*(128) fnamepsbar
89     character*(128) fnametbar
90     character*(128) fnamesbar
91     character*(128) fnameubar
92     character*(128) fnamevbar
93     character*(128) fnamewbar
94     character*(128) fnametauxbar
95     character*(128) fnametauybar
96     character*(128) fnamehfluxbar
97     character*(128) fnamesfluxbar
98    
99     cph(
100     integer locdayrec
101     cph)
102     c == external functions ==
103    
104     integer ilnblnk
105     external ilnblnk
106    
107     c == end of interface ==
108    
109     jtlo = mybylo(mythid)
110     jthi = mybyhi(mythid)
111     itlo = mybxlo(mythid)
112     ithi = mybxhi(mythid)
113     jmin = 1
114     jmax = sny
115     imin = 1
116     imax = snx
117    
118     myiter = niter0 + INT((mytime-starttime)/deltaTClock+0.5)
119    
120     c-- Get the time flags and record numbers for the time averaging.
121    
122     #ifdef ALLOW_DEBUG
123     IF ( debugLevel .GE. debLevB )
124     & CALL DEBUG_CALL('cost_averagesflags',myThid)
125     #endif
126     call cost_averagesflags(
127     I myiter, mytime, mythid,
128     O first, last,
129     O startofday, startofmonth, startofyear,
130     O inday, inmonth, inyear,
131     O endofday, endofmonth, endofyear,
132     O sum1day, dayrec,
133     O sum1mon, monrec,
134     O sum1year, yearrec
135     & )
136    
137     #ifdef ALLOW_SSH_COST_CONTRIBUTION
138     #ifdef ALLOW_DEBUG
139     IF ( debugLevel .GE. debLevB )
140     & CALL DEBUG_CALL('cost_averagesgeneric psbar',myThid)
141     #endif
142     call cost_averagesgeneric(
143     & psbarfile,
144     & psbar, etan, xx_psbar_mean_dummy,
145     & first, last, startofday, endofday, inday,
146     & sum1day, dayrec, 1, mythid )
147     #endif
148    
149     #if (defined (ALLOW_THETA_COST_CONTRIBUTION) || \
150     defined (ALLOW_CTDT_COST_CONTRIBUTION) || \
151     defined (ALLOW_XBT_COST_CONTRIBUTION) || \
152     defined (ALLOW_ARGO_THETA_COST_CONTRIBUTION) || \
153     defined (ALLOW_DRIFT_COST_CONTRIBUTION) || \
154     defined (ALLOW_OBCS_COST_CONTRIBUTION))
155     #ifdef ALLOW_DEBUG
156     IF ( debugLevel .GE. debLevB )
157     & CALL DEBUG_CALL('cost_averagesgeneric tbar',myThid)
158     #endif
159     call cost_averagesgeneric(
160     & tbarfile,
161     & tbar, theta, xx_tbar_mean_dummy,
162     & first, last, startofmonth, endofmonth, inmonth,
163     & sum1mon, monrec, nr, mythid )
164     #else
165     #ifdef ALLOW_SST_COST_CONTRIBUTION
166     call cost_averagesgeneric(
167     & tbarfile,
168     & tbar, theta(1-Olx,1-Oly,1,1,1), xx_tbar_mean_dummy,
169     & first, last, startofmonth, endofmonth, inmonth,
170     & sum1mon, monrec, 1, mythid )
171     #endif
172     #endif
173    
174     #ifdef ALLOW_DAILYSST_COST_CONTRIBUTION
175     cph#ifdef ALLOW_SEAICE_COST_AREASST
176     #ifdef ALLOW_DEBUG
177     IF ( debugLevel .GE. debLevB )
178     & CALL DEBUG_CALL('cost_averagesgeneric sstbar',myThid)
179     #endif
180     call cost_averagesgeneric(
181     & sstbarfile,
182     & sstbar, theta(1-Olx,1-Oly,1,1,1), xx_sstbar_mean_dummy,
183     & first, last, startofday, endofday, inday,
184     & sum1day, dayrec, 1, mythid )
185     #endif
186    
187     #if (defined (ALLOW_SALT_COST_CONTRIBUTION) || \
188     defined (ALLOW_CTDS_COST_CONTRIBUTION) || \
189     defined (ALLOW_ARGO_SALT_COST_CONTRIBUTION) || \
190     defined (ALLOW_DRIFT_COST_CONTRIBUTION) || \
191     defined (ALLOW_OBCS_COST_CONTRIBUTION))
192     #ifdef ALLOW_DEBUG
193     IF ( debugLevel .GE. debLevB )
194     & CALL DEBUG_CALL('cost_averagesgeneric sbar',myThid)
195     #endif
196     call cost_averagesgeneric(
197     & sbarfile,
198     & sbar, salt, xx_sbar_mean_dummy,
199     & first, last, startofmonth, endofmonth, inmonth,
200     & sum1mon, monrec, nr, mythid )
201     #else
202     #ifdef ALLOW_SSS_COST_CONTRIBUTION
203     call cost_averagesgeneric(
204     & sbarfile,
205     & sbar, salt(1-Olx,1-Oly,1,1,1), xx_sbar_mean_dummy,
206     & first, last, startofmonth, endofmonth, inmonth,
207     & sum1mon, monrec, 1, mythid )
208     #endif
209     #endif
210    
211     #ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
212     CMM( call cost_averagesgeneric(
213     CMM & wbarfile,
214     CMM & wbar, wvel, xx_wbar_mean_dummy,
215     CMM & first, last, startofmonth, endofmonth, inmonth,
216     CMM & sum1mon, monrec, nr, mythid )
217     CMM(
218     if (first.or.startofmonth) then
219     do bj = jtlo,jthi
220     do bi = itlo,ithi
221     do k = 1,nr
222     do j = jmin,jmax
223     do i = imin,imax
224     wbar(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)*wVel(i,j,k,bi,bj)
225     enddo
226     enddo
227     enddo
228     enddo
229     enddo
230     else if (last .or. endofmonth) then
231     do bj = jtlo,jthi
232     do bi = itlo,ithi
233     do k = 1,nr
234     do j = jmin,jmax
235     do i = imin,imax
236     wbar(i,j,k,bi,bj) = (wbar (i,j,k,bi,bj) +
237     & wVel(i,j,k,bi,bj) * wVel(i,j,k,bi,bj) )/
238     & float(sum1mon)
239     enddo
240     enddo
241     enddo
242     enddo
243     enddo
244    
245     c-- Save ubar and vbar.
246     if (optimcycle .ge. 0) then
247     ils=ilnblnk( wbarfile )
248     write(fnamewbar,'(2a,i10.10)') wbarfile(1:ils),'.',
249     & optimcycle
250     endif
251    
252     call active_write_xyz( fnamewbar, wbar, monrec, optimcycle,
253     & mythid, xx_wbar_mean_dummy)
254    
255     else if ( ( inmonth ) .and.
256     & .not. (first .or. startofmonth) .and.
257     & .not. (last .or. endofmonth ) ) then
258     c-- Accumulate ubar and vbar.
259     do bj = jtlo,jthi
260     do bi = itlo,ithi
261     do k = 1,nr
262     do j = jmin,jmax
263     do i = imin,imax
264     wbar(i,j,k,bi,bj) = wbar (i,j,k,bi,bj) +
265     & wVel (i,j,k,bi,bj) * wVel (i,j,k,bi,bj)
266     enddo
267     enddo
268     enddo
269     enddo
270     enddo
271     else
272     stop 'CMM: ... stopped in cost_averagesfields; wbar part.'
273     endif
274    
275     CMM)
276     #endif
277    
278     #if (defined (ALLOW_DRIFTER_COST_CONTRIBUTION) || \
279     defined (ALLOW_OBCS_COST_CONTRIBUTION))
280     cph There is a mismatch between the cost_drifer and the
281     cph cost_obcs usage of ubar, vbar.
282     cph cost_obcs refers to monthly means, cost_drifer to total mean.
283     cph Needs to be updated for cost_obcs!!!.
284     c-- Next, do the averages for velocitty.
285     if (first.or.startofmonth) then
286     do bj = jtlo,jthi
287     do bi = itlo,ithi
288     do k = 1,nr
289     do j = jmin,jmax
290     do i = imin,imax
291     ubar(i,j,k,bi,bj) = uVel(i,j,k,bi,bj)
292     vbar(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)
293     enddo
294     enddo
295     enddo
296     enddo
297     enddo
298     else if (last .or. endofmonth) then
299     do bj = jtlo,jthi
300     do bi = itlo,ithi
301     do k = 1,nr
302     do j = jmin,jmax
303     do i = imin,imax
304     ubar(i,j,k,bi,bj) = (ubar (i,j,k,bi,bj) +
305     & uVel(i,j,k,bi,bj) )/
306     & float(sum1mon)
307     vbar(i,j,k,bi,bj) = (vbar (i,j,k,bi,bj) +
308     & vVel(i,j,k,bi,bj) )/
309     & float(sum1mon)
310     enddo
311     enddo
312     enddo
313     enddo
314     enddo
315    
316     c-- Save ubar and vbar.
317     if (optimcycle .ge. 0) then
318     ils=ilnblnk( ubarfile )
319     write(fnameubar,'(2a,i10.10)') ubarfile(1:ils),'.',
320     & optimcycle
321     write(fnamevbar,'(2a,i10.10)') vbarfile(1:ils),'.',
322     & optimcycle
323     endif
324    
325     call active_write_xyz( fnameubar, ubar, monrec, optimcycle,
326     & mythid, xx_ubar_mean_dummy)
327    
328     call active_write_xyz( fnamevbar, vbar, monrec, optimcycle,
329     & mythid, xx_vbar_mean_dummy)
330    
331     ce , myiter, mytime )
332    
333     else if ( ( inmonth ) .and.
334     & .not. (first .or. startofmonth) .and.
335     & .not. (last .or. endofmonth ) ) then
336     c-- Accumulate ubar and vbar.
337     do bj = jtlo,jthi
338     do bi = itlo,ithi
339     do k = 1,nr
340     do j = jmin,jmax
341     do i = imin,imax
342     ubar(i,j,k,bi,bj) = ubar (i,j,k,bi,bj) +
343     & uVel (i,j,k,bi,bj)
344     vbar(i,j,k,bi,bj) = vbar (i,j,k,bi,bj) +
345     & vVel (i,j,k,bi,bj)
346     enddo
347     enddo
348     enddo
349     enddo
350     enddo
351     else
352     stop ' ... stopped in cost_averagesfields; ubar part.'
353     endif
354    
355     #endif
356    
357     #ifdef ALLOW_SCAT_COST_CONTRIBUTION
358     c-- Next, do the averages for velocitty.
359     if (first.or. startofmonth) then
360     do bj = jtlo,jthi
361     do bi = itlo,ithi
362     do j = jmin,jmax
363     do i = imin,imax
364     tauxbar(i,j,bi,bj) = ustress(i,j,bi,bj)
365     tauybar(i,j,bi,bj) = vstress(i,j,bi,bj)
366     enddo
367     enddo
368     enddo
369     enddo
370     else if (last .or. endofmonth) then
371     do bj = jtlo,jthi
372     do bi = itlo,ithi
373     do j = jmin,jmax
374     do i = imin,imax
375     tauxbar(i,j,bi,bj) = (tauxbar (i,j,bi,bj) +
376     & ustress(i,j,bi,bj) )/
377     & float(sum1mon)
378     tauybar(i,j,bi,bj) = (tauybar (i,j,bi,bj) +
379     & vstress(i,j,bi,bj) )/
380     & float(sum1mon)
381     enddo
382     enddo
383     enddo
384     enddo
385    
386     c-- Save ubar and vbar.
387     if (optimcycle .ge. 0) then
388     ils=ilnblnk( tauxbarfile )
389     write(fnametauxbar,'(2a,i10.10)') tauxbarfile(1:ils),'.',
390     & optimcycle
391     ils=ilnblnk( tauybarfile )
392     write(fnametauybar,'(2a,i10.10)') tauybarfile(1:ils),'.',
393     & optimcycle
394     endif
395    
396     call active_write_xy( fnametauxbar, tauxbar, monrec, optimcycle,
397     & mythid, xx_taux_mean_dummy)
398    
399     call active_write_xy( fnametauybar, tauybar, monrec, optimcycle,
400     & mythid, xx_tauy_mean_dummy)
401    
402    
403     else if ( .not. (first.or. startofmonth) .and.
404     & .not. (last .or. endofmonth) ) then
405     c-- Accumulate ubar and vbar.
406     do bj = jtlo,jthi
407     do bi = itlo,ithi
408     do j = jmin,jmax
409     do i = imin,imax
410     tauxbar(i,j,bi,bj) = tauxbar (i,j,bi,bj) +
411     & ustress (i,j,bi,bj)
412     tauybar(i,j,bi,bj) = tauybar (i,j,bi,bj) +
413     & vstress (i,j,bi,bj)
414     enddo
415     enddo
416     enddo
417     enddo
418     else
419     stop ' ... stopped in cost_averagesfields; tauxbar part.'
420     endif
421    
422     #else
423     #ifdef ALLOW_DAILYSCAT_COST_CONTRIBUTION
424     call cost_averagesgeneric(
425     & tauxbarfile,
426     & tauxbar, ustress, xx_taux_mean_dummy,
427     & first, last, startofday, endofday, inday,
428     & sum1day, dayrec, 1, mythid )
429     call cost_averagesgeneric(
430     & tauybarfile,
431     & tauybar, vstress, xx_tauy_mean_dummy,
432     & first, last, startofday, endofday, inday,
433     & sum1day, dayrec, 1, mythid )
434     #endif
435     #endif
436    
437     #ifdef ALLOW_MEAN_HFLUX_COST_CONTRIBUTION
438     cph: this is one mean over whole integration:
439     c intmp = (.NOT. first) .and. (.NOT. last)
440     c call cost_averagesgeneric(
441     c & hfluxbarfile,
442     c & hfluxbar, qnet, xx_hflux_mean_dummy,
443     c & first, last, .false., .false., intmp,
444     c & ntimesteps, 1, 1, mythid )
445     cph: switch to annual means:
446     #ifdef ALLOW_DEBUG
447     IF ( debugLevel .GE. debLevB )
448     & CALL DEBUG_CALL('cost_averagesgeneric hfluxbar',myThid)
449     #endif
450     call cost_averagesgeneric(
451     & hfluxbarfile,
452     & hfluxbar, qnet, xx_hflux_mean_dummy,
453     & first, last, startofyear, endofyear, inyear,
454     & sum1year, yearrec, 1, mythid )
455     #endif
456    
457     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
458     cph: these are annual means
459     # ifndef ALLOW_SEAICE
460     #ifdef ALLOW_DEBUG
461     IF ( debugLevel .GE. debLevB )
462     & CALL DEBUG_CALL('cost_averagesgeneric sfluxbar',myThid)
463     #endif
464     call cost_averagesgeneric(
465     & sfluxbarfile,
466     & sfluxbar, empmr, xx_sflux_mean_dummy,
467     & first, last, startofyear, endofyear, inyear,
468     & sum1year, yearrec, 1, mythid )
469     # else
470     #ifdef ALLOW_DEBUG
471     IF ( debugLevel .GE. debLevB )
472     & CALL DEBUG_CALL('cost_averagesgeneric sfluxbar',myThid)
473     #endif
474     call cost_averagesgeneric(
475     & sfluxbarfile,
476     & sfluxbar, frWtrAtm, xx_sflux_mean_dummy,
477     & first, last, startofyear, endofyear, inyear,
478     & sum1year, yearrec, 1, mythid )
479     # endif
480     #endif
481    
482     #ifdef ALLOW_BP_COST_CONTRIBUTION
483     call cost_averagesgeneric(
484     & bpbarfile,
485     & bpbar, phiHydLow, xx_bpbar_mean_dummy,
486     & first, last, startofmonth, endofmonth, inmonth,
487     & sum1mon, monrec, 1, mythid )
488     #endif
489    
490     #ifdef ALLOW_SEAICE
491     if (useSEAICE) then
492     # ifdef ALLOW_SEAICE_COST_SMR_AREA
493     c
494     #ifdef ALLOW_DEBUG
495     IF ( debugLevel .GE. debLevB )
496     & CALL DEBUG_CALL('cost_averagesgeneric smrareabar',myThid)
497     #endif
498     call cost_averagesgeneric(
499     & smrareabarfile,
500     & smrareabar, area, xx_smrareabar_mean_dummy,
501     & first, last, startofday, endofday, inday,
502     & sum1day, dayrec, 1, mythid )
503     c
504     #ifdef ALLOW_DEBUG
505     IF ( debugLevel .GE. debLevB )
506     & CALL DEBUG_CALL('cost_averagesgeneric smrsstbar',myThid)
507     #endif
508     call cost_averagesgeneric(
509     & smrsstbarfile,
510     & smrsstbar, theta(1-Olx,1-Oly,1,1,1),
511     & xx_smrsstbar_mean_dummy,
512     & first, last, startofday, endofday, inday,
513     & sum1day, dayrec, 1, mythid )
514     c
515     #ifdef ALLOW_DEBUG
516     IF ( debugLevel .GE. debLevB )
517     & CALL DEBUG_CALL('cost_averagesgeneric smrsssbar',myThid)
518     #endif
519     call cost_averagesgeneric(
520     & smrsssbarfile,
521     & smrsssbar, salt(1-Olx,1-Oly,1,1,1),
522     & xx_smrsssbar_mean_dummy,
523     & first, last, startofday, endofday, inday,
524     & sum1day, dayrec, 1, mythid )
525     c
526     # endif
527     endif
528     #endif /* ALLOW_SEAICE */
529    
530     #if (defined (ALLOW_PROFILES) && defined (ALLOW_PROFILES_CONTRIBUTION))
531     cph moved to the_main_loop to separate from cost package
532     cph CALL profiles_inloop(mytime,mythid)
533     #endif
534    
535     #ifdef ALLOW_TRANSPORT_COST_CONTRIBUTION
536     c-- Currently hard-coded Florida Strait transport for 1x1 deg.
537     c-- ECCO-GODAE version 1,2,3
538     c-- Next, do the averages for velocitty.
539     cph For some funny reason cal only increments dayrec at the end
540     cph of the day, i.e. for endofday.EQ.T
541     cph Should fix/change this at some point.
542     cph In the mean time increment ad hoc during day
543     locdayrec = 0
544     if (last .or. endofday) then
545     locdayrec = dayrec
546     else
547     locdayrec = dayrec+1
548     endif
549     do bj = jtlo,jthi
550     do bi = itlo,ithi
551     if (first.or.startofday)
552     & transpbar(locdayrec,bi,bj) = 0. _d 0
553     do k = 1,nr
554     do j = jmin,jmax
555     jg = myYGlobalLo-1+(bj-1)*sNy+j
556     do i = imin,imax
557     ig = myXGlobalLo-1+(bi-1)*sNx+i
558     if ( jg.EQ.106 .AND. ig.GE.280 .AND. ig.LE.285 ) then
559     transpbar(locdayrec,bi,bj) = transpbar(locdayrec,bi,bj)
560     & +vVel(i,j,k,bi,bj)
561     & *_dxG(i,j,bi,bj)*drF(k)*_hFacS(i,j,k,bi,bj)
562     endif
563     enddo
564     enddo
565     enddo
566     if (last .or. endofday) then
567     transpbar(locdayrec,bi,bj) =
568     & transpbar(locdayrec,bi,bj)/float(sum1day)
569     endif
570     enddo
571     enddo
572     #endif
573    
574     #ifdef ALLOW_DEBUG
575     IF ( debugLevel .GE. debLevB )
576     & CALL DEBUG_CALL('cost_averagesgeneric leave',myThid)
577     #endif
578    
579     return
580     end
581    

  ViewVC Help
Powered by ViewVC 1.1.22