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

Contents 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 - (show 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 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