3 |
#include "COST_CPPOPTIONS.h" |
#include "COST_CPPOPTIONS.h" |
4 |
|
|
5 |
|
|
6 |
subroutine cost_Final( |
subroutine cost_final( mythid ) |
|
I mythid |
|
|
& ) |
|
7 |
|
|
8 |
c ================================================================== |
c ================================================================== |
9 |
c SUBROUTINE cost_Final |
c SUBROUTINE cost_final |
10 |
c ================================================================== |
c ================================================================== |
11 |
c |
c |
12 |
c o Sum of all cost function contributions. |
c o Sum of all cost function contributions. |
19 |
c for the MITgcmUV. |
c for the MITgcmUV. |
20 |
c |
c |
21 |
c ================================================================== |
c ================================================================== |
22 |
c SUBROUTINE cost_Final |
c SUBROUTINE cost_final |
23 |
c ================================================================== |
c ================================================================== |
24 |
|
|
25 |
implicit none |
implicit none |
28 |
|
|
29 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
30 |
#include "SIZE.h" |
#include "SIZE.h" |
31 |
|
#include "PARAMS.h" |
32 |
|
|
33 |
#include "cost.h" |
#include "cost.h" |
34 |
#include "ctrl.h" |
#include "ctrl.h" |
37 |
|
|
38 |
integer mythid |
integer mythid |
39 |
|
|
40 |
|
#ifdef ALLOW_COST |
41 |
c == local variables == |
c == local variables == |
42 |
|
|
43 |
|
integer i,j,k |
44 |
integer bi,bj |
integer bi,bj |
45 |
integer itlo,ithi |
integer itlo,ithi |
46 |
integer jtlo,jthi |
integer jtlo,jthi |
47 |
|
|
|
#ifdef ECCO_VERBOSE |
|
|
character*(MAX_LEN_MBUF) msgbuf |
|
|
#endif |
|
|
|
|
48 |
c == end of interface == |
c == end of interface == |
49 |
|
|
50 |
jtlo = mybylo(mythid) |
jtlo = mybylo(mythid) |
52 |
itlo = mybxlo(mythid) |
itlo = mybxlo(mythid) |
53 |
ithi = mybxhi(mythid) |
ithi = mybxhi(mythid) |
54 |
|
|
55 |
#ifdef ECCO_VERBOSE |
#ifdef ALLOW_COST_VECTOR |
56 |
write(msgbuf,'(a)') ' ' |
|
57 |
call print_message( msgbuf, standardmessageunit, |
CALL COST_VECTOR (myThid) |
58 |
& SQUEEZE_RIGHT , mythid) |
|
59 |
write(msgbuf,'(a)') ' ' |
do bj = jtlo,jthi |
60 |
call print_message( msgbuf, standardmessageunit, |
do bi = itlo,ithi |
61 |
& SQUEEZE_RIGHT , mythid) |
do i = 1,sNx |
62 |
write(msgbuf,'(a)') |
print*,' --> objf_vector(i,bi,bj) = ', |
63 |
& ' cost_Final: Evaluating the final cost function.' |
& objf_vector(i,bi,bj) |
64 |
call print_message( msgbuf, standardmessageunit, |
end do |
65 |
& SQUEEZE_RIGHT , mythid) |
end do |
66 |
write(msgbuf,'(a)') ' ' |
end do |
67 |
call print_message( msgbuf, standardmessageunit, |
|
68 |
& SQUEEZE_RIGHT , mythid) |
#else /* ALLOW_COST_VECTOR undef */ |
69 |
|
|
70 |
|
#ifdef ALLOW_COST_TEST |
71 |
|
CALL COST_TEST (myThid) |
72 |
|
#endif |
73 |
|
|
74 |
|
#ifdef ALLOW_COST_ATLANTIC_HEAT |
75 |
|
CALL COST_ATLANTIC_HEAT (myThid) |
76 |
#endif |
#endif |
77 |
|
|
78 |
c-- Sum up all contributions. |
c-- Sum up all contributions. |
79 |
do bj = jtlo,jthi |
do bj = jtlo,jthi |
80 |
do bi = itlo,ithi |
do bi = itlo,ithi |
81 |
|
|
82 |
print*,' --> objf_temp(bi,bj) =',objf_temp(bi,bj) |
print*,' --> objf_test(bi,bj) =',objf_test(bi,bj) |
83 |
print*,' --> objf_salt(bi,bj) =',objf_salt(bi,bj) |
print*,' --> objf_tracer(bi,bj) =',objf_tracer(bi,bj) |
84 |
print*,' --> objf_tauu(bi,bj) =',objf_tauu(bi,bj) |
print*,' --> objf_atl(bi,bj) =',objf_atl(bi,bj) |
|
print*,' --> objf_tauv(bi,bj) =',objf_tauv(bi,bj) |
|
|
print*,' --> objf_hflux(bi,bj) =',objf_hflux(bi,bj) |
|
|
print*,' --> objf_sflux(bi,bj) =',objf_sflux(bi,bj) |
|
|
print*,' --> objf_sst(bi,bj) =',objf_sst(bi,bj) |
|
|
print*,' --> objf_h(bi,bj) =',objf_h(bi,bj) |
|
|
print*,' --> objf_atl(bi,bj) =',objf_atl(bi,bj) |
|
|
print*,' --> objf_ctdt(bi,bj) =',objf_ctdt(bi,bj) |
|
|
print*,' --> objf_ctds(bi,bj) =',objf_ctds(bi,bj) |
|
|
print*,' --> objf_test(bi,bj) =',objf_test(bi,bj) |
|
85 |
|
|
86 |
fc = fc |
fc = fc |
87 |
& + mult_temp * objf_temp(bi,bj) |
& + mult_test * objf_test(bi,bj) |
88 |
& + mult_salt * objf_salt(bi,bj) |
& + mult_tracer * objf_tracer(bi,bj) |
89 |
& + mult_tauu * objf_tauu(bi,bj) |
& + mult_atl * objf_atl(bi,bj) |
|
& + mult_tauv * objf_tauv(bi,bj) |
|
|
& + mult_hq * objf_hflux(bi,bj) |
|
|
& + mult_hs * objf_sflux(bi,bj) |
|
|
& + mult_sst * objf_sst(bi,bj) |
|
|
& + mult_h * objf_h(bi,bj) |
|
|
& + mult_atl * objf_atl(bi,bj) |
|
|
& + mult_ctdt * objf_ctdt(bi,bj) |
|
|
& + mult_ctds * objf_ctds(bi,bj) |
|
|
& + mult_test * objf_test(bi,bj) |
|
90 |
enddo |
enddo |
91 |
enddo |
enddo |
92 |
|
|
93 |
|
print*,' fc = ', fc |
94 |
|
|
95 |
c-- Do global summation. |
c-- Do global summation. |
96 |
_GLOBAL_SUM_R8( fc , myThid ) |
_GLOBAL_SUM_R8( fc , myThid ) |
97 |
|
|
98 |
c-- Each process has calculated the global part for itself. |
#endif /* ALLOW_COST_VECTOR */ |
99 |
_BEGIN_MASTER( mythid ) |
|
100 |
fc = fc + mult_hmean*objf_hmean |
c-- set averaging freq. to zero to avoid re-write of |
101 |
_END_MASTER( mythid ) |
c-- averaged fields in reverse checkpointing loops |
102 |
print*,' --> fc =',fc |
taveFreq = 0. |
103 |
|
|
104 |
#ifdef ECCO_VERBOSE |
#endif /* ALLOW_COST */ |
|
write(msgbuf,'(a,D22.15)') |
|
|
& ' cost_Final: final cost function = ',fc |
|
|
call print_message( msgbuf, standardmessageunit, |
|
|
& SQUEEZE_RIGHT , mythid) |
|
|
write(msgbuf,'(a)') ' ' |
|
|
call print_message( msgbuf, standardmessageunit, |
|
|
& SQUEEZE_RIGHT , mythid) |
|
|
write(msgbuf,'(a)') |
|
|
& ' cost function evaluation finished.' |
|
|
call print_message( msgbuf, standardmessageunit, |
|
|
& SQUEEZE_RIGHT , mythid) |
|
|
write(msgbuf,'(a)') ' ' |
|
|
call print_message( msgbuf, standardmessageunit, |
|
|
& SQUEEZE_RIGHT , mythid) |
|
|
#endif |
|
105 |
|
|
106 |
return |
return |
107 |
end |
end |