pkg/cost/cost_final.F

C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_final.F,v 1.20 2009/10/15 05:21:50 heimbach Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "COST_CPPOPTIONS.h"

      subroutine cost_final( mythid )

c     ==================================================================
c     SUBROUTINE cost_final
c     ==================================================================
c
c     o Sum of all cost function contributions.
c
c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
c     heimbach@mit.edu 05-Nov-2003 Modularize cost package
c
c     ==================================================================
c     SUBROUTINE cost_final
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"

#include "cost.h"
#ifdef ALLOW_CTRL
# include "ctrl.h"
#endif
#ifdef ALLOW_DIC
cph-- quickly for testing
# include "DIC_COST.h"
#endif
#ifdef ALLOW_MNC
# include "MNC_PARAMS.h"
#endif

c     == routine arguments ==

      integer mythid

#ifdef ALLOW_COST
c     == local variables ==

      integer i,j,k
      integer bi,bj
      integer itlo,ithi
      integer jtlo,jthi

c     == end of interface ==

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)

#ifdef ALLOW_SEAICE
      CALL SEAICE_COST_FINAL (myThid)
#endif

#if (defined (ALLOW_ECCO))
      CALL ECCO_COST_FINAL (myThid)

#elif (defined (ALLOW_COST_VECTOR))
      CALL COST_VECTOR (myThid)

#elif (defined (ALLOW_COST_STATE_FINAL))
      CALL COST_STATE_FINAL (myThid)

#endif /* above stuff undef */

#ifndef ALLOW_ECCO

# ifdef ALLOW_COST_TEST
      CALL COST_TEST (myThid)
# endif
# ifdef ALLOW_COST_ATLANTIC_HEAT
      CALL COST_ATLANTIC_HEAT (myThid)
# endif
#ifdef ALLOW_COST_HFLUXM
      CALL COST_HFLUX (myThid)
#endif
#ifdef ALLOW_COST_TEMP
      CALL COST_TEMP (myThid)
#endif

c--   Sum up all contributions.
      do bj = jtlo,jthi
        do bi = itlo,ithi

          write(standardmessageunit,'(A,D22.15)')
     &          ' --> objf_test(bi,bj)   = ', objf_test(bi,bj)
          write(standardmessageunit,'(A,D22.15)')
     &         ' --> objf_tracer(bi,bj) = ', objf_tracer(bi,bj)
          write(standardmessageunit,'(A,D22.15)')
     &         ' --> objf_atl(bi,bj)    = ', objf_atl(bi,bj)
#ifdef ALLOW_COST_TEMP
          write(standardmessageunit,'(A,D22.15)')
     &          ' --> objf_temp_tut(bi,bj)   = ', objf_temp_tut(bi,bj)
#endif
#ifdef ALLOW_COST_HFLUXM
          write(standardmessageunit,'(A,D22.15)')
     &         ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
#endif
#ifdef ALLOW_COST_TRANSPORT
          write(standardmessageunit,'(A,D22.15)')
     &         ' --> objf_transport(bi,bj) = ', objf_transport(bi,bj)
#endif

          fc = fc
     &            + mult_test   * objf_test(bi,bj)
     &            + mult_tracer * objf_tracer(bi,bj)
     &            + mult_atl    * objf_atl(bi,bj)
#ifdef ALLOW_COST_TRANSPORT
     &            + mult_transport * objf_transport(bi,bj)
#endif
#ifdef ALLOW_COST_TEMP
     &            + mult_temp_tut  * objf_temp_tut(bi,bj)
#endif
#ifdef ALLOW_COST_HFLUXM
     &            + mult_hflux_tut * objf_hflux_tut(bi,bj)
#endif
        enddo
      enddo

      write(standardmessageunit,'(A,D22.15)') '  local fc = ', fc

c--   Do global summation.
      _GLOBAL_SUM_RL( fc , myThid )

#ifdef ALLOW_DIC
cph-- quickly for testing
      fc = totcost
#endif

      write(standardmessageunit,'(A,D22.15)') ' global fc = ', fc

#endif /* ALLOW_ECCO */

c--   set averaging freq. to zero to avoid re-write of
c--   averaged fields in reverse checkpointing loops
      taveFreq    = 0.
      dumpFreq    = 0.
      pChkptFreq  = 0.
      monitorFreq = 0.
      useDiagnostics = .FALSE.
#ifdef ALLOW_MNC
      monitor_mnc=.FALSE.
      snapshot_mnc=.FALSE.
      timeave_mnc=.FALSE.
#endif

#endif /* ALLOW_COST */

      return
      end
1	jmc	1.21	C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_final.F,v 1.20 2009/10/15 05:21:50 heimbach Exp $
2	jmc	1.16	C $Name: $
3	heimbach	1.1
4	heimbach	1.7	#include "PACKAGES_CONFIG.h"
5	heimbach	1.1	#include "COST_CPPOPTIONS.h"
6
7	heimbach	1.3	subroutine cost_final( mythid )
8	heimbach	1.1
9			c ==================================================================
10	heimbach	1.3	c SUBROUTINE cost_final
11	heimbach	1.1	c ==================================================================
12			c
13			c o Sum of all cost function contributions.
14			c
15			c started: Christian Eckert eckert@mit.edu 30-Jun-1999
16			c changed: Christian Eckert eckert@mit.edu 25-Feb-2000
17	heimbach	1.7	c heimbach@mit.edu 05-Nov-2003 Modularize cost package
18	heimbach	1.1	c
19			c ==================================================================
20	heimbach	1.3	c SUBROUTINE cost_final
21	heimbach	1.1	c ==================================================================
22
23			implicit none
24
25			c == global variables ==
26
27			#include "EEPARAMS.h"
28			#include "SIZE.h"
29	heimbach	1.5	#include "PARAMS.h"
30	heimbach	1.1
31			#include "cost.h"
32	heimbach	1.14	#ifdef ALLOW_CTRL
33			# include "ctrl.h"
34			#endif
35	heimbach	1.20	#ifdef ALLOW_DIC
36			cph-- quickly for testing
37			# include "DIC_COST.h"
38			#endif
39	jmc	1.21	#ifdef ALLOW_MNC
40			# include "MNC_PARAMS.h"
41			#endif
42	heimbach	1.1
43			c == routine arguments ==
44
45			integer mythid
46
47	heimbach	1.2	#ifdef ALLOW_COST
48	heimbach	1.1	c == local variables ==
49
50	heimbach	1.3	integer i,j,k
51	heimbach	1.1	integer bi,bj
52			integer itlo,ithi
53			integer jtlo,jthi
54
55			c == end of interface ==
56
57			jtlo = mybylo(mythid)
58			jthi = mybyhi(mythid)
59			itlo = mybxlo(mythid)
60			ithi = mybxhi(mythid)
61
62	heimbach	1.13	#ifdef ALLOW_SEAICE
63			CALL SEAICE_COST_FINAL (myThid)
64			#endif
65
66	heimbach	1.7	#if (defined (ALLOW_ECCO))
67			CALL ECCO_COST_FINAL (myThid)
68	heimbach	1.3
69	heimbach	1.7	#elif (defined (ALLOW_COST_VECTOR))
70	heimbach	1.3	CALL COST_VECTOR (myThid)
71
72	heimbach	1.6	#elif (defined (ALLOW_COST_STATE_FINAL))
73			CALL COST_STATE_FINAL (myThid)
74	heimbach	1.3
75	heimbach	1.8	#endif /* above stuff undef */
76
77			#ifndef ALLOW_ECCO
78	heimbach	1.3
79	heimbach	1.7	# ifdef ALLOW_COST_TEST
80	heimbach	1.2	CALL COST_TEST (myThid)
81	heimbach	1.7	# endif
82			# ifdef ALLOW_COST_ATLANTIC_HEAT
83	heimbach	1.3	CALL COST_ATLANTIC_HEAT (myThid)
84	heimbach	1.7	# endif
85	dfer	1.17	#ifdef ALLOW_COST_HFLUXM
86			CALL COST_HFLUX (myThid)
87			#endif
88			#ifdef ALLOW_COST_TEMP
89			CALL COST_TEMP (myThid)
90			#endif
91	heimbach	1.3
92	heimbach	1.1	c-- Sum up all contributions.
93			do bj = jtlo,jthi
94			do bi = itlo,ithi
95
96	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
97	heimbach	1.11	& ' --> objf_test(bi,bj) = ', objf_test(bi,bj)
98	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
99	heimbach	1.11	& ' --> objf_tracer(bi,bj) = ', objf_tracer(bi,bj)
100	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
101	heimbach	1.11	& ' --> objf_atl(bi,bj) = ', objf_atl(bi,bj)
102	dfer	1.17	#ifdef ALLOW_COST_TEMP
103			write(standardmessageunit,'(A,D22.15)')
104	dfer	1.18	& ' --> objf_temp_tut(bi,bj) = ', objf_temp_tut(bi,bj)
105	dfer	1.17	#endif
106			#ifdef ALLOW_COST_HFLUXM
107			write(standardmessageunit,'(A,D22.15)')
108	dfer	1.18	& ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
109	dfer	1.17	#endif
110	heimbach	1.15	#ifdef ALLOW_COST_TRANSPORT
111	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
112	heimbach	1.15	& ' --> objf_transport(bi,bj) = ', objf_transport(bi,bj)
113			#endif
114	heimbach	1.1
115			fc = fc
116	heimbach	1.2	& + mult_test * objf_test(bi,bj)
117			& + mult_tracer * objf_tracer(bi,bj)
118	heimbach	1.3	& + mult_atl * objf_atl(bi,bj)
119	heimbach	1.15	#ifdef ALLOW_COST_TRANSPORT
120			& + mult_transport * objf_transport(bi,bj)
121			#endif
122	dfer	1.17	#ifdef ALLOW_COST_TEMP
123	dfer	1.18	& + mult_temp_tut * objf_temp_tut(bi,bj)
124	dfer	1.17	#endif
125			#ifdef ALLOW_COST_HFLUXM
126	dfer	1.18	& + mult_hflux_tut * objf_hflux_tut(bi,bj)
127	dfer	1.17	#endif
128	heimbach	1.1	enddo
129			enddo
130
131	heimbach	1.12	write(standardmessageunit,'(A,D22.15)') ' local fc = ', fc
132	heimbach	1.1
133			c-- Do global summation.
134	jmc	1.19	_GLOBAL_SUM_RL( fc , myThid )
135	heimbach	1.3
136	heimbach	1.20	#ifdef ALLOW_DIC
137			cph-- quickly for testing
138			fc = totcost
139			#endif
140
141	heimbach	1.12	write(standardmessageunit,'(A,D22.15)') ' global fc = ', fc
142	heimbach	1.6
143	heimbach	1.7	#endif /* ALLOW_ECCO */
144	heimbach	1.5
145			c-- set averaging freq. to zero to avoid re-write of
146			c-- averaged fields in reverse checkpointing loops
147	heimbach	1.10	taveFreq = 0.
148			dumpFreq = 0.
149			pChkptFreq = 0.
150			monitorFreq = 0.
151	jmc	1.21	useDiagnostics = .FALSE.
152			#ifdef ALLOW_MNC
153			monitor_mnc=.FALSE.
154			snapshot_mnc=.FALSE.
155			timeave_mnc=.FALSE.
156			#endif
157	heimbach	1.1
158	heimbach	1.2	#endif /* ALLOW_COST */
159	heimbach	1.1
160			return
161			end