/[MITgcm]/MITgcm/pkg/cost/cost_final.F
ViewVC logotype

Annotation of /MITgcm/pkg/cost/cost_final.F

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


Revision 1.2.6.3 - (hide annotations) (download)
Thu May 30 20:01:26 2002 UTC (22 years ago) by heimbach
Branch: ecco-branch
CVS Tags: icebear3, icebear2, ecco_ice2, ecco_ice1, ecco_c44_e25, ecco_c44_e26, ecco_c44_e24
Branch point for: c24_e25_ice
Changes since 1.2.6.2: +5 -5 lines
Bug fixes and updates in cost package
o cost_final: correct multiplier mult_tauv, mult_sflux
o cost_hyd: added call cost_ssh
o cost_init_barfiles.F: replaced arrays by tmpfld's
o cost_readtopexmean.F: ersmask -> tpmeanmask
o cost_weights.F: corrected wtheta[2], wsalt[2]

1 heimbach 1.2.6.3 C $Header: /u/gcmpack/MITgcm/pkg/cost/cost_final.F,v 1.2.6.2 2002/04/04 10:58:58 heimbach Exp $
2 heimbach 1.1
3     #include "COST_CPPOPTIONS.h"
4    
5    
6     subroutine cost_Final(
7     I mythid
8     & )
9    
10     c ==================================================================
11     c SUBROUTINE cost_Final
12     c ==================================================================
13     c
14     c o Sum of all cost function contributions.
15     c
16     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
17     c
18     c changed: Christian Eckert eckert@mit.edu 25-Feb-2000
19     c
20     c - Restructured the code in order to create a package
21     c for the MITgcmUV.
22     c
23     c ==================================================================
24     c SUBROUTINE cost_Final
25     c ==================================================================
26    
27     implicit none
28    
29     c == global variables ==
30    
31     #include "EEPARAMS.h"
32     #include "SIZE.h"
33    
34     #include "cost.h"
35     #include "ctrl.h"
36 heimbach 1.2.6.2 #include "optim.h"
37 heimbach 1.1
38     c == routine arguments ==
39    
40     integer mythid
41    
42     c == local variables ==
43    
44     integer bi,bj
45     integer itlo,ithi
46     integer jtlo,jthi
47 heimbach 1.2.6.2 integer ifc
48 heimbach 1.1
49 heimbach 1.2.6.2 _RL f_temp0, f_salt0, f_temp, f_salt
50     _RL f_tauu, f_tauv, f_hflux, f_sflux
51     _RL f_tauum, f_tauvm, f_hfluxm, f_sfluxm
52     _RL f_hfluxmm, f_sfluxmm
53     _RL f_sst, f_sss, f_atl, f_ctdt, f_ctds
54     _RL f_drifter, f_xbt, f_tdrift, f_sdrift, f_wdrift
55     _RL f_argot, f_argos, f_ssh
56     _RL f_scatx, f_scaty, f_scatxm, f_scatym
57    
58     character*20 cfname
59     #ifdef ECCO_VERBOSE
60 heimbach 1.2.6.1 character*(MAX_LEN_MBUF) msgbuf
61 heimbach 1.2.6.2 #endif
62 heimbach 1.2.6.1
63 heimbach 1.1 c == end of interface ==
64    
65     jtlo = mybylo(mythid)
66     jthi = mybyhi(mythid)
67     itlo = mybxlo(mythid)
68     ithi = mybxhi(mythid)
69    
70 heimbach 1.2.6.2 ifc = 30
71    
72     f_temp = 0. _d 0
73     f_salt = 0. _d 0
74     f_temp0 = 0. _d 0
75     f_salt0 = 0. _d 0
76     f_tauu = 0. _d 0
77     f_tauum = 0. _d 0
78     f_tauv = 0. _d 0
79     f_tauvm = 0. _d 0
80     f_hflux = 0. _d 0
81     f_hfluxm = 0. _d 0
82     f_hfluxmm = 0. _d 0
83     f_sflux = 0. _d 0
84     f_sfluxm = 0. _d 0
85     f_sfluxmm = 0. _d 0
86     f_ssh = 0. _d 0
87     f_sst = 0. _d 0
88     f_sss = 0. _d 0
89     f_atl = 0. _d 0
90     f_ctdt = 0. _d 0
91     f_ctds = 0. _d 0
92     f_xbt = 0. _d 0
93     f_argot = 0. _d 0
94     f_argos = 0. _d 0
95     f_drifter = 0. _d 0
96     f_sdrift = 0. _d 0
97     f_tdrift = 0. _d 0
98     f_wdrift = 0. _d 0
99     f_scatx = 0. _d 0
100     f_scaty = 0. _d 0
101     f_scatxm = 0. _d 0
102     f_scatym = 0. _d 0
103    
104 heimbach 1.2.6.1 #ifdef ECCO_VERBOSE
105     write(msgbuf,'(a)') ' '
106     call print_message( msgbuf, standardmessageunit,
107     & SQUEEZE_RIGHT , mythid)
108     write(msgbuf,'(a)') ' '
109     call print_message( msgbuf, standardmessageunit,
110     & SQUEEZE_RIGHT , mythid)
111     write(msgbuf,'(a)')
112     & ' cost_Final: Evaluating the final cost function.'
113     call print_message( msgbuf, standardmessageunit,
114     & SQUEEZE_RIGHT , mythid)
115     write(msgbuf,'(a)') ' '
116     call print_message( msgbuf, standardmessageunit,
117     & SQUEEZE_RIGHT , mythid)
118 heimbach 1.1 #endif
119    
120     c-- Sum up all contributions.
121     do bj = jtlo,jthi
122     do bi = itlo,ithi
123    
124 heimbach 1.2.6.1 print*,' --> objf_temp(bi,bj) =',objf_temp(bi,bj)
125     print*,' --> objf_salt(bi,bj) =',objf_salt(bi,bj)
126 heimbach 1.2.6.2 print*,' --> objf_temp0(bi,bj) =',objf_temp0(bi,bj)
127     print*,' --> objf_salt0(bi,bj) =',objf_salt0(bi,bj)
128 heimbach 1.2.6.1 print*,' --> objf_sst(bi,bj) =',objf_sst(bi,bj)
129     print*,' --> objf_sss(bi,bj) =',objf_sss(bi,bj)
130     print*,' --> objf_h(bi,bj) =',objf_h(bi,bj)
131     print*,' --> objf_hmean =',objf_hmean
132     print*,' --> objf_tauu(bi,bj) =',objf_tauu(bi,bj)
133 heimbach 1.2.6.2 print*,' --> objf_tauum(bi,bj) =',objf_tauum(bi,bj)
134 heimbach 1.2.6.1 print*,' --> objf_tauv(bi,bj) =',objf_tauv(bi,bj)
135 heimbach 1.2.6.3 print*,' --> objf_tauvm(bi,bj) =',objf_tauvm(bi,bj)
136 heimbach 1.2.6.1 print*,' --> objf_hflux(bi,bj) =',objf_hflux(bi,bj)
137 heimbach 1.2.6.2 print*,' --> objf_hflux(bi,bj) =',objf_hfluxm(bi,bj)
138     print*,' --> objf_hflux(bi,bj) =',objf_hfluxmm(bi,bj)
139 heimbach 1.2.6.1 print*,' --> objf_sflux(bi,bj) =',objf_sflux(bi,bj)
140 heimbach 1.2.6.2 print*,' --> objf_sflux(bi,bj) =',objf_sfluxm(bi,bj)
141     print*,' --> objf_sflux(bi,bj) =',objf_sfluxmm(bi,bj)
142 heimbach 1.2.6.1 print*,' --> objf_atl(bi,bj) =',objf_atl(bi,bj)
143     print*,' --> objf_ctdt(bi,bj) =',objf_ctdt(bi,bj)
144     print*,' --> objf_ctds(bi,bj) =',objf_ctds(bi,bj)
145 heimbach 1.2.6.2 print*,' --> objf_xbt(bi,bj) =',objf_xbt(bi,bj)
146     print*,' --> objf_argot(bi,bj) =',objf_argot(bi,bj)
147     print*,' --> objf_argos(bi,bj) =',objf_argos(bi,bj)
148     print*,' --> objf_drift(bi,bj) =',objf_drift(bi,bj)
149     print*,' --> objf_tdrift(bi,bj) =',objf_tdrift(bi,bj)
150     print*,' --> objf_sdrift(bi,bj) =',objf_sdrift(bi,bj)
151     print*,' --> objf_wdrift(bi,bj) =',objf_wdrift(bi,bj)
152     print*,' --> objf_scatx(bi,bj) =',objf_scatx(bi,bj)
153     print*,' --> objf_scaty(bi,bj) =',objf_scaty(bi,bj)
154     print*,' --> objf_scatxm(bi,bj) =',objf_scatxm(bi,bj)
155     print*,' --> objf_scatym(bi,bj) =',objf_scatym(bi,bj)
156 heimbach 1.2.6.1 print*,' --> objf_uwind(bi,bj) =',objf_uwind(bi,bj)
157     print*,' --> objf_vwind(bi,bj) =',objf_vwind(bi,bj)
158     print*,' --> objf_atemp(bi,bj) =',objf_atemp(bi,bj)
159     print*,' --> objf_aqh(bi,bj) =',objf_aqh(bi,bj)
160     print*,' --> objf_obcsn(bi,bj) =',objf_obcsn(bi,bj)
161     print*,' --> objf_obcss(bi,bj) =',objf_obcss(bi,bj)
162     print*,' --> objf_obcsw(bi,bj) =',objf_obcsw(bi,bj)
163     print*,' --> objf_obcse(bi,bj) =',objf_obcse(bi,bj)
164 heimbach 1.1
165     fc = fc
166 heimbach 1.2.6.1 & + mult_temp * objf_temp(bi,bj)
167     & + mult_salt * objf_salt(bi,bj)
168 heimbach 1.2.6.2 & + mult_temp0 * objf_temp0(bi,bj)
169     & + mult_salt0 * objf_salt0(bi,bj)
170 heimbach 1.2.6.1 & + mult_sst * objf_sst(bi,bj)
171     & + mult_sss * objf_sss(bi,bj)
172     & + mult_tauu * objf_tauu(bi,bj)
173 heimbach 1.2.6.2 & + mult_tauu * objf_tauum(bi,bj)
174 heimbach 1.2.6.1 & + mult_tauv * objf_tauv(bi,bj)
175 heimbach 1.2.6.3 & + mult_tauv * objf_tauvm(bi,bj)
176 heimbach 1.2.6.1 & + mult_hflux * objf_hflux(bi,bj)
177 heimbach 1.2.6.2 & + mult_hflux * objf_hfluxm(bi,bj)
178     & + mult_hflux * objf_hfluxmm(bi,bj)
179 heimbach 1.2.6.1 & + mult_sflux * objf_sflux(bi,bj)
180 heimbach 1.2.6.3 & + mult_sflux * objf_sfluxm(bi,bj)
181     & + mult_sflux * objf_sfluxmm(bi,bj)
182 heimbach 1.2.6.1 & + mult_h * objf_h(bi,bj)
183     & + mult_atl * objf_atl(bi,bj)
184     & + mult_ctdt * objf_ctdt(bi,bj)
185     & + mult_ctds * objf_ctds(bi,bj)
186 heimbach 1.2.6.2 & + mult_xbt * objf_xbt(bi,bj)
187     & + mult_argot * objf_argot(bi,bj)
188     & + mult_argos * objf_argos(bi,bj)
189     & + mult_drift * objf_drift(bi,bj)
190     & + mult_sdrift * objf_sdrift(bi,bj)
191     & + mult_tdrift * objf_tdrift(bi,bj)
192     & + mult_wdrift * objf_wdrift(bi,bj)
193     & + mult_scatx * objf_scatx(bi,bj)
194     & + mult_scaty * objf_scaty(bi,bj)
195     & + mult_scatx * objf_scatxm(bi,bj)
196     & + mult_scaty * objf_scatym(bi,bj)
197 heimbach 1.2.6.1 & + mult_uwind * objf_uwind(bi,bj)
198     & + mult_vwind * objf_vwind(bi,bj)
199     & + mult_atemp * objf_atemp(bi,bj)
200     & + mult_aqh * objf_aqh(bi,bj)
201     & + mult_obcsn * objf_obcsn(bi,bj)
202     & + mult_obcss * objf_obcss(bi,bj)
203     & + mult_obcsw * objf_obcsw(bi,bj)
204     & + mult_obcse * objf_obcse(bi,bj)
205 heimbach 1.2.6.2
206     f_temp = f_temp + objf_temp(bi,bj)
207     f_salt = f_salt + objf_salt(bi,bj)
208     f_temp0 = f_temp0 + objf_temp0(bi,bj)
209     f_salt0 = f_salt0 + objf_salt0(bi,bj)
210     f_tauu = f_tauu + objf_tauu(bi,bj)
211     f_tauum = f_tauum + objf_tauum(bi,bj)
212     f_tauv = f_tauv + objf_tauv(bi,bj)
213     f_tauvm = f_tauvm + objf_tauvm(bi,bj)
214     f_hflux= f_hflux + objf_hflux(bi,bj)
215     f_hfluxm = f_hfluxm + objf_hfluxm(bi,bj)
216     f_hfluxmm = f_hfluxmm + objf_hfluxmm(bi,bj)
217     f_sflux= f_sflux + objf_sflux(bi,bj)
218     f_sfluxm = f_sfluxm + objf_sfluxm(bi,bj)
219     f_sfluxmm = f_sfluxmm + objf_sfluxmm(bi,bj)
220     f_ssh = f_ssh + objf_h(bi,bj)
221     f_sst = f_sst + objf_sst(bi,bj)
222     f_sss = f_sss + objf_sss(bi,bj)
223     f_atl = f_atl + objf_atl(bi,bj)
224     f_ctdt = f_ctdt + objf_ctdt(bi,bj)
225     f_ctds = f_ctds + objf_ctds(bi,bj)
226     f_xbt = f_xbt + objf_xbt(bi,bj)
227     f_argot = f_argot + objf_argot(bi,bj)
228     f_argos = f_argos + objf_argos(bi,bj)
229     f_drifter = f_drifter + objf_drift(bi,bj)
230     f_sdrift = f_sdrift + objf_sdrift(bi,bj)
231     f_tdrift = f_tdrift + objf_tdrift(bi,bj)
232     f_wdrift = f_wdrift + objf_wdrift(bi,bj)
233     f_scatx = f_scatx + objf_scatx(bi,bj)
234     f_scaty = f_scaty + objf_scaty(bi,bj)
235     f_scatxm = f_scatxm + objf_scatxm(bi,bj)
236     f_scatym = f_scatym + objf_scatym(bi,bj)
237    
238 heimbach 1.1 enddo
239     enddo
240    
241    
242     c-- Do global summation.
243     _GLOBAL_SUM_R8( fc , myThid )
244    
245 heimbach 1.2.6.2 c-- Do global summation for each part of the cost function
246    
247     _GLOBAL_SUM_R8( f_temp , myThid )
248     _GLOBAL_SUM_R8( f_salt , myThid )
249     _GLOBAL_SUM_R8( f_temp0, myThid )
250     _GLOBAL_SUM_R8( f_salt0, myThid )
251     _GLOBAL_SUM_R8( f_tauu , myThid )
252     _GLOBAL_SUM_R8( f_tauum , myThid )
253     _GLOBAL_SUM_R8( f_tauv , myThid )
254     _GLOBAL_SUM_R8( f_tauvm , myThid )
255     _GLOBAL_SUM_R8( f_hflux , myThid )
256     _GLOBAL_SUM_R8( f_hfluxm , myThid )
257     _GLOBAL_SUM_R8( f_hfluxmm , myThid )
258     _GLOBAL_SUM_R8( f_sflux , myThid )
259     _GLOBAL_SUM_R8( f_sfluxm , myThid )
260     _GLOBAL_SUM_R8( f_sfluxmm , myThid )
261     _GLOBAL_SUM_R8( f_ssh , myThid )
262     _GLOBAL_SUM_R8( f_sst , myThid )
263     _GLOBAL_SUM_R8( f_sss , myThid )
264     _GLOBAL_SUM_R8( f_atl , myThid )
265     _GLOBAL_SUM_R8( f_ctdt , myThid )
266     _GLOBAL_SUM_R8( f_ctds , myThid )
267     _GLOBAL_SUM_R8( f_xbt , myThid )
268     _GLOBAL_SUM_R8( f_argot , myThid )
269     _GLOBAL_SUM_R8( f_argos , myThid )
270     _GLOBAL_SUM_R8( f_drifter , myThid )
271     _GLOBAL_SUM_R8( f_sdrift , myThid )
272     _GLOBAL_SUM_R8( f_tdrift , myThid )
273     _GLOBAL_SUM_R8( f_wdrift , myThid )
274     _GLOBAL_SUM_R8( f_scatx , myThid )
275     _GLOBAL_SUM_R8( f_scaty , myThid )
276     _GLOBAL_SUM_R8( f_scatxm , myThid )
277     _GLOBAL_SUM_R8( f_scatym , myThid )
278    
279 heimbach 1.2.6.1 c-- Each process has calculated the global part for itself.
280     _BEGIN_MASTER( mythid )
281 heimbach 1.2.6.2
282 heimbach 1.2.6.1 fc = fc + mult_hmean*objf_hmean
283 heimbach 1.2.6.2
284     print*, ' --> objf_hmean =',objf_hmean
285     print*, ' --> fc =', fc
286    
287     write(cfname,'(A,i4.4)') 'costfunction',optimcycle
288     open(unit=ifc,file=cfname)
289    
290     write(ifc,*) 'fc =', fc
291     write(ifc,*) 'f_temp =', f_temp
292     write(ifc,*) 'f_salt =', f_salt
293     write(ifc,*) 'f_temp0 =', f_temp0
294     write(ifc,*) 'f_salt0 =', f_salt0
295     write(ifc,*) 'f_tauu =', f_tauu
296     write(ifc,*) 'f_tauum =', f_tauum
297     write(ifc,*) 'f_tauv =', f_tauv
298     write(ifc,*) 'f_tauvm =', f_tauvm
299     write(ifc,*) 'f_hflux =', f_hflux
300     write(ifc,*) 'f_hfluxm =', f_hfluxm
301     write(ifc,*) 'f_hfluxmm =', f_hfluxmm
302     write(ifc,*) 'f_sflux =', f_sflux
303     write(ifc,*) 'f_sfluxm =', f_sfluxm
304     write(ifc,*) 'f_sfluxmm =', f_sfluxmm
305     write(ifc,*) 'f_ssh =', f_ssh
306     write(ifc,*) 'f_sst =', f_sst
307     write(ifc,*) 'f_sss =', f_sss
308     write(ifc,*) 'f_atl =', f_atl
309     write(ifc,*) 'f_ctdt =', f_ctdt
310     write(ifc,*) 'f_ctds =', f_ctds
311     write(ifc,*) 'f_xbt =', f_xbt
312     write(ifc,*) 'f_argot =', f_argot
313     write(ifc,*) 'f_argos =', f_argos
314     write(ifc,*) 'objf_hmean =', objf_hmean
315     write(ifc,*) 'f_drifter =', f_drifter
316     write(ifc,*) 'f_sdrift =', f_sdrift
317     write(ifc,*) 'f_tdrift =', f_tdrift
318     write(ifc,*) 'f_wdrift =', f_wdrift
319     write(ifc,*) 'f_scatx =', f_scatx
320     write(ifc,*) 'f_scaty =', f_scaty
321     write(ifc,*) 'f_scatxm =', f_scatxm
322     write(ifc,*) 'f_scatym =', f_scatym
323    
324     close(ifc)
325    
326 heimbach 1.2.6.1 _END_MASTER( mythid )
327    
328     #ifdef ECCO_VERBOSE
329     write(msgbuf,'(a,D22.15)')
330     & ' cost_Final: final cost function = ',fc
331     call print_message( msgbuf, standardmessageunit,
332     & SQUEEZE_RIGHT , mythid)
333     write(msgbuf,'(a)') ' '
334     call print_message( msgbuf, standardmessageunit,
335     & SQUEEZE_RIGHT , mythid)
336     write(msgbuf,'(a)')
337     & ' cost function evaluation finished.'
338     call print_message( msgbuf, standardmessageunit,
339     & SQUEEZE_RIGHT , mythid)
340     write(msgbuf,'(a)') ' '
341     call print_message( msgbuf, standardmessageunit,
342     & SQUEEZE_RIGHT , mythid)
343     #endif
344 heimbach 1.1
345     end

  ViewVC Help
Powered by ViewVC 1.1.22