pkg/cost/cost_final.F

C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_final.F,v 1.27 2011/08/17 10:19:29 heimbach Exp $
C $Name:  $

#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     ==================================================================
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
# include "DIC_COST.h"
#endif
#ifdef ALLOW_COST_SHELFICE
# include "SHELFICE_COST.h"
#endif


c     == routine arguments ==

      integer mythid

#ifdef ALLOW_COST
c     == local variables ==

      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

#ifdef ALLOW_SHELFICE
      CALL SHELFICE_COST_FINAL (myThid)
#endif

#ifdef ALLOW_ECCO
      CALL ECCO_COST_FINAL (myThid)
#endif

#ifdef ALLOW_COST_STATE_FINAL
      CALL COST_STATE_FINAL (myThid)
cgf : effectively using this in adjoint requires the 
c     use of adjoint_state_final. That will activate the
c     objf_state_final vector in place of the fc scalar.
c     objf_state_final is therefore not added to fc.
#endif

#ifdef ALLOW_COST_VECTOR
cgf : same idea as for ALLOW_COST_STATE_FINAL
      CALL COST_VECTOR (myThid)
#endif

# ifdef ALLOW_COST_TEST
      CALL COST_TEST (myThid)
# endif

# ifdef ALLOW_COST_ATLANTIC_HEAT
      CALL COST_ATLANTIC_HEAT (myThid)
# endif

#ifdef ALLOW_COST_HFLUXM
cgf : to compile previous line user is expected to provide cost_hflux.F
      CALL COST_HFLUX (myThid)
#endif

#ifdef ALLOW_COST_TEMP
      CALL COST_TEMP (myThid)
cgf : to compile previous line user is expected to provide cost_temp.F
#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)
#if ( !defined (ALLOW_ECCO) || !defined (ALLOW_COST_ATLANTIC) )
          write(standardmessageunit,'(A,D22.15)')
     &         ' --> objf_atl(bi,bj)    = ', objf_atl(bi,bj)
#endif
#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)
#if ( !defined (ALLOW_ECCO) || !defined (ALLOW_COST_ATLANTIC) )
     &            + mult_atl    * objf_atl(bi,bj)
#endif
#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_COST
cph-- quickly for testing
      fc = totcost
#endif

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

c--   to avoid re-write of output in reverse checkpointing loops,
c--   switch off output flag :
      CALL TURNOFF_MODEL_IO( 0, myThid )

#endif /* ALLOW_COST */

      return
      end
1	gforget	1.28	C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_final.F,v 1.27 2011/08/17 10:19:29 heimbach Exp $
2	jmc	1.16	C $Name: $
3	heimbach	1.1
4			#include "COST_CPPOPTIONS.h"
5
6	heimbach	1.3	subroutine cost_final( mythid )
7	heimbach	1.1
8			c ==================================================================
9	heimbach	1.3	c SUBROUTINE cost_final
10	heimbach	1.1	c ==================================================================
11			c
12			c o Sum of all cost function contributions.
13			c
14			c ==================================================================
15	heimbach	1.3	c SUBROUTINE cost_final
16	heimbach	1.1	c ==================================================================
17
18			implicit none
19
20			c == global variables ==
21
22			#include "EEPARAMS.h"
23			#include "SIZE.h"
24	heimbach	1.5	#include "PARAMS.h"
25	heimbach	1.1
26			#include "cost.h"
27	heimbach	1.14	#ifdef ALLOW_CTRL
28			# include "ctrl.h"
29			#endif
30	heimbach	1.20	#ifdef ALLOW_DIC
31			# include "DIC_COST.h"
32			#endif
33	heimbach	1.23	#ifdef ALLOW_COST_SHELFICE
34			# include "SHELFICE_COST.h"
35			#endif
36
37	heimbach	1.1
38			c == routine arguments ==
39
40			integer mythid
41
42	heimbach	1.2	#ifdef ALLOW_COST
43	heimbach	1.1	c == local variables ==
44
45			integer bi,bj
46			integer itlo,ithi
47			integer jtlo,jthi
48
49			c == end of interface ==
50
51			jtlo = mybylo(mythid)
52			jthi = mybyhi(mythid)
53			itlo = mybxlo(mythid)
54			ithi = mybxhi(mythid)
55
56	heimbach	1.13	#ifdef ALLOW_SEAICE
57			CALL SEAICE_COST_FINAL (myThid)
58			#endif
59
60	mlosch	1.25	#ifdef ALLOW_SHELFICE
61			CALL SHELFICE_COST_FINAL (myThid)
62			#endif
63
64	gforget	1.28	#ifdef ALLOW_ECCO
65	heimbach	1.7	CALL ECCO_COST_FINAL (myThid)
66	gforget	1.28	#endif
67	heimbach	1.3
68	gforget	1.28	#ifdef ALLOW_COST_STATE_FINAL
69	heimbach	1.6	CALL COST_STATE_FINAL (myThid)
70	gforget	1.28	cgf : effectively using this in adjoint requires the
71			c use of adjoint_state_final. That will activate the
72			c objf_state_final vector in place of the fc scalar.
73			c objf_state_final is therefore not added to fc.
74			#endif
75	heimbach	1.3
76	gforget	1.28	#ifdef ALLOW_COST_VECTOR
77			cgf : same idea as for ALLOW_COST_STATE_FINAL
78			CALL COST_VECTOR (myThid)
79			#endif
80	heimbach	1.3
81	heimbach	1.7	# ifdef ALLOW_COST_TEST
82	heimbach	1.2	CALL COST_TEST (myThid)
83	heimbach	1.7	# endif
84	gforget	1.28
85	heimbach	1.7	# ifdef ALLOW_COST_ATLANTIC_HEAT
86	heimbach	1.3	CALL COST_ATLANTIC_HEAT (myThid)
87	heimbach	1.7	# endif
88	gforget	1.28
89	dfer	1.17	#ifdef ALLOW_COST_HFLUXM
90	gforget	1.28	cgf : to compile previous line user is expected to provide cost_hflux.F
91	dfer	1.17	CALL COST_HFLUX (myThid)
92			#endif
93	gforget	1.28
94	dfer	1.17	#ifdef ALLOW_COST_TEMP
95			CALL COST_TEMP (myThid)
96	gforget	1.28	cgf : to compile previous line user is expected to provide cost_temp.F
97	dfer	1.17	#endif
98	heimbach	1.3
99	heimbach	1.1	c-- Sum up all contributions.
100			do bj = jtlo,jthi
101			do bi = itlo,ithi
102
103	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
104	heimbach	1.11	& ' --> objf_test(bi,bj) = ', objf_test(bi,bj)
105	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
106	heimbach	1.11	& ' --> objf_tracer(bi,bj) = ', objf_tracer(bi,bj)
107	gforget	1.28	#if ( !defined (ALLOW_ECCO) \|\| !defined (ALLOW_COST_ATLANTIC) )
108	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
109	heimbach	1.11	& ' --> objf_atl(bi,bj) = ', objf_atl(bi,bj)
110	gforget	1.28	#endif
111	dfer	1.17	#ifdef ALLOW_COST_TEMP
112			write(standardmessageunit,'(A,D22.15)')
113	dfer	1.18	& ' --> objf_temp_tut(bi,bj) = ', objf_temp_tut(bi,bj)
114	dfer	1.17	#endif
115			#ifdef ALLOW_COST_HFLUXM
116			write(standardmessageunit,'(A,D22.15)')
117	dfer	1.18	& ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
118	dfer	1.17	#endif
119	heimbach	1.15	#ifdef ALLOW_COST_TRANSPORT
120	jmc	1.16	write(standardmessageunit,'(A,D22.15)')
121	heimbach	1.15	& ' --> objf_transport(bi,bj) = ', objf_transport(bi,bj)
122			#endif
123	heimbach	1.1
124			fc = fc
125	heimbach	1.2	& + mult_test * objf_test(bi,bj)
126			& + mult_tracer * objf_tracer(bi,bj)
127	gforget	1.28	#if ( !defined (ALLOW_ECCO) \|\| !defined (ALLOW_COST_ATLANTIC) )
128	heimbach	1.3	& + mult_atl * objf_atl(bi,bj)
129	gforget	1.28	#endif
130	heimbach	1.15	#ifdef ALLOW_COST_TRANSPORT
131			& + mult_transport * objf_transport(bi,bj)
132			#endif
133	dfer	1.17	#ifdef ALLOW_COST_TEMP
134	dfer	1.18	& + mult_temp_tut * objf_temp_tut(bi,bj)
135	dfer	1.17	#endif
136			#ifdef ALLOW_COST_HFLUXM
137	dfer	1.18	& + mult_hflux_tut * objf_hflux_tut(bi,bj)
138	dfer	1.17	#endif
139	heimbach	1.1	enddo
140			enddo
141
142	heimbach	1.12	write(standardmessageunit,'(A,D22.15)') ' local fc = ', fc
143	heimbach	1.1
144			c-- Do global summation.
145	jmc	1.19	_GLOBAL_SUM_RL( fc , myThid )
146	heimbach	1.3
147	heimbach	1.27	#ifdef ALLOW_DIC_COST
148	heimbach	1.20	cph-- quickly for testing
149			fc = totcost
150			#endif
151
152	heimbach	1.12	write(standardmessageunit,'(A,D22.15)') ' global fc = ', fc
153	heimbach	1.6
154	jmc	1.22	c-- to avoid re-write of output in reverse checkpointing loops,
155			c-- switch off output flag :
156			CALL TURNOFF_MODEL_IO( 0, myThid )
157	heimbach	1.1
158	heimbach	1.2	#endif /* ALLOW_COST */
159	heimbach	1.1
160			return
161			end