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

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

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

revision 1.2 by heimbach, Fri Jul 13 13:37:45 2001 UTC revision 1.2.6.4 by dimitri, Thu Feb 27 07:04:39 2003 UTC
# Line 14  c Line 14  c
14  c     o Sum of all cost function contributions.  c     o Sum of all cost function contributions.
15  c  c
16  c     started: Christian Eckert eckert@mit.edu 30-Jun-1999  c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
 c  
17  c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000  c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
 c  
18  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
19  c                for the MITgcmUV.  c                for the MITgcmUV.
20    c     added sea-ice term: menemenlis@jpl.nasa.gov 26-Feb-2003
21  c  c
22  c     ==================================================================  c     ==================================================================
23  c     SUBROUTINE cost_Final  c     SUBROUTINE cost_Final
# Line 33  c     == global variables == Line 32  c     == global variables ==
32    
33  #include "cost.h"  #include "cost.h"
34  #include "ctrl.h"  #include "ctrl.h"
35    #include "optim.h"
36    
37  c     == routine arguments ==  c     == routine arguments ==
38    
39        integer mythid        integer mythid
40    
 #ifdef ALLOW_COST  
41  c     == local variables ==  c     == local variables ==
42    
43        integer bi,bj        integer bi,bj
44        integer itlo,ithi        integer itlo,ithi
45        integer jtlo,jthi        integer jtlo,jthi
46          integer ifc
47    
48          _RL f_temp0, f_salt0,  f_temp, f_salt
49          _RL f_tauu, f_tauv, f_hflux, f_sflux
50          _RL f_tauum, f_tauvm, f_hfluxm, f_sfluxm
51          _RL f_hfluxmm, f_sfluxmm
52          _RL f_sst, f_sss, f_atl, f_ctdt, f_ctds
53          _RL f_drifter, f_xbt, f_tdrift, f_sdrift, f_wdrift
54          _RL f_argot, f_argos, f_ssh
55          _RL f_scatx, f_scaty, f_scatxm, f_scatym
56    
57          character*20 cfname
58    #ifdef ECCO_VERBOSE
59          character*(MAX_LEN_MBUF) msgbuf
60    #endif
61    
62  c     == end of interface ==  c     == end of interface ==
63    
# Line 52  c     == end of interface == Line 66  c     == end of interface ==
66        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
67        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
68    
69  #ifdef ALLOW_COST_TEST        ifc = 30
70        CALL COST_TEST (myThid)        
71          f_temp = 0. _d 0
72          f_salt = 0. _d 0
73          f_temp0 = 0. _d 0
74          f_salt0 = 0. _d 0
75          f_tauu = 0. _d 0
76          f_tauum = 0. _d 0
77          f_tauv = 0. _d 0
78          f_tauvm = 0. _d 0
79          f_hflux = 0. _d 0
80          f_hfluxm = 0. _d 0
81          f_hfluxmm = 0. _d 0
82          f_sflux  = 0. _d 0
83          f_sfluxm  = 0. _d 0
84          f_sfluxmm  = 0. _d 0
85          f_ssh = 0. _d 0
86          f_sst = 0. _d 0
87          f_sss = 0. _d 0
88          f_atl = 0. _d 0
89          f_ctdt = 0. _d 0
90          f_ctds = 0. _d 0
91          f_xbt = 0. _d 0
92          f_argot = 0. _d 0
93          f_argos = 0. _d 0
94          f_drifter = 0. _d 0
95          f_sdrift = 0. _d 0
96          f_tdrift = 0. _d 0
97          f_wdrift = 0. _d 0
98          f_scatx = 0. _d 0
99          f_scaty = 0. _d 0
100          f_scatxm = 0. _d 0
101          f_scatym = 0. _d 0
102    
103    #ifdef ECCO_VERBOSE
104          write(msgbuf,'(a)') ' '
105          call print_message( msgbuf, standardmessageunit,
106         &                    SQUEEZE_RIGHT , mythid)
107          write(msgbuf,'(a)') ' '
108          call print_message( msgbuf, standardmessageunit,
109         &                    SQUEEZE_RIGHT , mythid)
110          write(msgbuf,'(a)')
111         &  ' cost_Final: Evaluating the final cost function.'
112          call print_message( msgbuf, standardmessageunit,
113         &                    SQUEEZE_RIGHT , mythid)
114          write(msgbuf,'(a)') ' '
115          call print_message( msgbuf, standardmessageunit,
116         &                    SQUEEZE_RIGHT , mythid)
117  #endif  #endif
118    
119  c--   Sum up all contributions.  c--   Sum up all contributions.
120        do bj = jtlo,jthi        do bj = jtlo,jthi
121          do bi = itlo,ithi          do bi = itlo,ithi
122    
123            print*,' --> objf_test(bi,bj)   =',objf_test(bi,bj)            print*,' --> objf_temp(bi,bj)    =',objf_temp(bi,bj)
124            print*,' --> objf_tracer(bi,bj) =',objf_tracer(bi,bj)            print*,' --> objf_salt(bi,bj)    =',objf_salt(bi,bj)
125              print*,' --> objf_temp0(bi,bj)   =',objf_temp0(bi,bj)
126              print*,' --> objf_salt0(bi,bj)   =',objf_salt0(bi,bj)
127              print*,' --> objf_sst(bi,bj)     =',objf_sst(bi,bj)
128              print*,' --> objf_sss(bi,bj)     =',objf_sss(bi,bj)
129              print*,' --> objf_h(bi,bj)       =',objf_h(bi,bj)
130              print*,' --> objf_hmean          =',objf_hmean
131              print*,' --> objf_tauu(bi,bj)    =',objf_tauu(bi,bj)
132              print*,' --> objf_tauum(bi,bj)   =',objf_tauum(bi,bj)
133              print*,' --> objf_tauv(bi,bj)    =',objf_tauv(bi,bj)
134              print*,' --> objf_tauvm(bi,bj)   =',objf_tauvm(bi,bj)
135              print*,' --> objf_hflux(bi,bj)   =',objf_hflux(bi,bj)
136              print*,' --> objf_hflux(bi,bj)   =',objf_hfluxm(bi,bj)
137              print*,' --> objf_hflux(bi,bj)   =',objf_hfluxmm(bi,bj)
138              print*,' --> objf_sflux(bi,bj)   =',objf_sflux(bi,bj)
139              print*,' --> objf_sflux(bi,bj)   =',objf_sfluxm(bi,bj)
140              print*,' --> objf_sflux(bi,bj)   =',objf_sfluxmm(bi,bj)
141              print*,' --> objf_atl(bi,bj)     =',objf_atl(bi,bj)
142              print*,' --> objf_ctdt(bi,bj)    =',objf_ctdt(bi,bj)
143              print*,' --> objf_ctds(bi,bj)    =',objf_ctds(bi,bj)
144              print*,' --> objf_xbt(bi,bj)     =',objf_xbt(bi,bj)
145              print*,' --> objf_argot(bi,bj)   =',objf_argot(bi,bj)
146              print*,' --> objf_argos(bi,bj)   =',objf_argos(bi,bj)
147              print*,' --> objf_drift(bi,bj)   =',objf_drift(bi,bj)
148              print*,' --> objf_tdrift(bi,bj)  =',objf_tdrift(bi,bj)
149              print*,' --> objf_sdrift(bi,bj)  =',objf_sdrift(bi,bj)
150              print*,' --> objf_wdrift(bi,bj)  =',objf_wdrift(bi,bj)
151              print*,' --> objf_scatx(bi,bj)   =',objf_scatx(bi,bj)
152              print*,' --> objf_scaty(bi,bj)   =',objf_scaty(bi,bj)
153              print*,' --> objf_scatxm(bi,bj)  =',objf_scatxm(bi,bj)
154              print*,' --> objf_scatym(bi,bj)  =',objf_scatym(bi,bj)
155              print*,' --> objf_uwind(bi,bj)   =',objf_uwind(bi,bj)
156              print*,' --> objf_vwind(bi,bj)   =',objf_vwind(bi,bj)
157              print*,' --> objf_atemp(bi,bj)   =',objf_atemp(bi,bj)
158              print*,' --> objf_aqh(bi,bj)     =',objf_aqh(bi,bj)
159              print*,' --> objf_obcsn(bi,bj)   =',objf_obcsn(bi,bj)
160              print*,' --> objf_obcss(bi,bj)   =',objf_obcss(bi,bj)
161              print*,' --> objf_obcsw(bi,bj)   =',objf_obcsw(bi,bj)
162              print*,' --> objf_obcse(bi,bj)   =',objf_obcse(bi,bj)
163              print*,' --> objf_ice(bi,bj)     =',objf_ice(bi,bj)
164    
165            fc = fc            fc = fc
166       &            + mult_test   * objf_test(bi,bj)       &            + mult_temp    * objf_temp(bi,bj)
167       &            + mult_tracer * objf_tracer(bi,bj)       &            + mult_salt    * objf_salt(bi,bj)
168         &            + mult_temp0   * objf_temp0(bi,bj)
169         &            + mult_salt0   * objf_salt0(bi,bj)
170         &            + mult_sst     * objf_sst(bi,bj)
171         &            + mult_sss     * objf_sss(bi,bj)
172         &            + mult_tauu    * objf_tauu(bi,bj)
173         &            + mult_tauu    * objf_tauum(bi,bj)
174         &            + mult_tauv    * objf_tauv(bi,bj)
175         &            + mult_tauv    * objf_tauvm(bi,bj)
176         &            + mult_hflux   * objf_hflux(bi,bj)  
177         &            + mult_hflux   * objf_hfluxm(bi,bj)  
178         &            + mult_hflux   * objf_hfluxmm(bi,bj)  
179         &            + mult_sflux   * objf_sflux(bi,bj)  
180         &            + mult_sflux   * objf_sfluxm(bi,bj)  
181         &            + mult_sflux   * objf_sfluxmm(bi,bj)  
182         &            + 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         &            + 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         &            + 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         &            + mult_ice     * objf_ice(bi,bj)  
206    
207              f_temp = f_temp + objf_temp(bi,bj)
208              f_salt = f_salt + objf_salt(bi,bj)
209              f_temp0 = f_temp0 + objf_temp0(bi,bj)
210              f_salt0 = f_salt0 + objf_salt0(bi,bj)
211              f_tauu = f_tauu + objf_tauu(bi,bj)
212              f_tauum  = f_tauum + objf_tauum(bi,bj)
213              f_tauv = f_tauv + objf_tauv(bi,bj)
214              f_tauvm  = f_tauvm + objf_tauvm(bi,bj)
215              f_hflux= f_hflux + objf_hflux(bi,bj)  
216              f_hfluxm = f_hfluxm + objf_hfluxm(bi,bj)  
217              f_hfluxmm = f_hfluxmm + objf_hfluxmm(bi,bj)  
218              f_sflux= f_sflux + objf_sflux(bi,bj)  
219              f_sfluxm = f_sfluxm + objf_sfluxm(bi,bj)  
220              f_sfluxmm = f_sfluxmm + objf_sfluxmm(bi,bj)  
221              f_ssh  = f_ssh + objf_h(bi,bj)
222              f_sst  = f_sst + objf_sst(bi,bj)
223              f_sss  = f_sss + objf_sss(bi,bj)
224              f_atl  = f_atl + objf_atl(bi,bj)
225              f_ctdt = f_ctdt + objf_ctdt(bi,bj)
226              f_ctds = f_ctds + objf_ctds(bi,bj)
227              f_xbt  = f_xbt + objf_xbt(bi,bj)
228              f_argot  = f_argot + objf_argot(bi,bj)
229              f_argos  = f_argos + objf_argos(bi,bj)
230              f_drifter = f_drifter + objf_drift(bi,bj)
231              f_sdrift = f_sdrift + objf_sdrift(bi,bj)
232              f_tdrift = f_tdrift + objf_tdrift(bi,bj)
233              f_wdrift = f_wdrift + objf_wdrift(bi,bj)
234              f_scatx = f_scatx + objf_scatx(bi,bj)
235              f_scaty = f_scaty + objf_scaty(bi,bj)
236              f_scatxm = f_scatxm + objf_scatxm(bi,bj)
237              f_scatym = f_scatym + objf_scatym(bi,bj)
238    
239          enddo          enddo
240        enddo        enddo
241    
       print*,' fc = ', fc  
242    
243  c--   Do global summation.  c--   Do global summation.
244        _GLOBAL_SUM_R8( fc , myThid )        _GLOBAL_SUM_R8( fc , myThid )
245    
246  #endif /* ALLOW_COST */  c--   Do global summation for each part of the cost function
247                
248          _GLOBAL_SUM_R8( f_temp , myThid )
249          _GLOBAL_SUM_R8( f_salt , myThid )
250          _GLOBAL_SUM_R8( f_temp0, myThid )
251          _GLOBAL_SUM_R8( f_salt0, myThid )
252          _GLOBAL_SUM_R8( f_tauu , myThid )
253          _GLOBAL_SUM_R8( f_tauum , myThid )
254          _GLOBAL_SUM_R8( f_tauv , myThid )
255          _GLOBAL_SUM_R8( f_tauvm , myThid )
256          _GLOBAL_SUM_R8( f_hflux , myThid )
257          _GLOBAL_SUM_R8( f_hfluxm , myThid )
258          _GLOBAL_SUM_R8( f_hfluxmm , myThid )
259          _GLOBAL_SUM_R8( f_sflux , myThid )
260          _GLOBAL_SUM_R8( f_sfluxm , myThid )
261          _GLOBAL_SUM_R8( f_sfluxmm , myThid )
262          _GLOBAL_SUM_R8( f_ssh , myThid )
263          _GLOBAL_SUM_R8( f_sst , myThid )
264          _GLOBAL_SUM_R8( f_sss , myThid )
265          _GLOBAL_SUM_R8( f_atl , myThid )
266          _GLOBAL_SUM_R8( f_ctdt , myThid )
267          _GLOBAL_SUM_R8( f_ctds , myThid )
268          _GLOBAL_SUM_R8( f_xbt , myThid )
269          _GLOBAL_SUM_R8( f_argot , myThid )
270          _GLOBAL_SUM_R8( f_argos , myThid )
271          _GLOBAL_SUM_R8( f_drifter , myThid )
272          _GLOBAL_SUM_R8( f_sdrift , myThid )
273          _GLOBAL_SUM_R8( f_tdrift , myThid )    
274          _GLOBAL_SUM_R8( f_wdrift , myThid )    
275          _GLOBAL_SUM_R8( f_scatx , myThid )    
276          _GLOBAL_SUM_R8( f_scaty , myThid )    
277          _GLOBAL_SUM_R8( f_scatxm , myThid )    
278          _GLOBAL_SUM_R8( f_scatym , myThid )    
279    
280    c--   Each process has calculated the global part for itself.
281          _BEGIN_MASTER( mythid )
282    
283            fc = fc + mult_hmean*objf_hmean
284          
285            print*, ' --> objf_hmean           =',objf_hmean
286            print*, ' --> fc               =', fc
287        
288            write(cfname,'(A,i4.4)') 'costfunction',optimcycle
289            open(unit=ifc,file=cfname)
290          
291            write(ifc,*) 'fc =', fc
292            write(ifc,*) 'f_temp =', f_temp
293            write(ifc,*) 'f_salt =', f_salt
294            write(ifc,*) 'f_temp0 =', f_temp0
295            write(ifc,*) 'f_salt0 =', f_salt0
296            write(ifc,*) 'f_tauu =', f_tauu
297            write(ifc,*) 'f_tauum =', f_tauum
298            write(ifc,*) 'f_tauv =', f_tauv
299            write(ifc,*) 'f_tauvm =', f_tauvm
300            write(ifc,*) 'f_hflux =', f_hflux
301            write(ifc,*) 'f_hfluxm =', f_hfluxm
302            write(ifc,*) 'f_hfluxmm =', f_hfluxmm
303            write(ifc,*) 'f_sflux =', f_sflux
304            write(ifc,*) 'f_sfluxm =', f_sfluxm
305            write(ifc,*) 'f_sfluxmm =', f_sfluxmm
306            write(ifc,*) 'f_ssh =', f_ssh
307            write(ifc,*) 'f_sst =', f_sst
308            write(ifc,*) 'f_sss =', f_sss
309            write(ifc,*) 'f_atl =', f_atl
310            write(ifc,*) 'f_ctdt =', f_ctdt
311            write(ifc,*) 'f_ctds =', f_ctds
312            write(ifc,*) 'f_xbt =', f_xbt
313            write(ifc,*) 'f_argot =', f_argot
314            write(ifc,*) 'f_argos =', f_argos
315            write(ifc,*) 'objf_hmean =', objf_hmean
316            write(ifc,*) 'f_drifter =', f_drifter
317            write(ifc,*) 'f_sdrift =', f_sdrift
318            write(ifc,*) 'f_tdrift =', f_tdrift
319            write(ifc,*) 'f_wdrift =', f_wdrift
320            write(ifc,*) 'f_scatx =', f_scatx
321            write(ifc,*) 'f_scaty =', f_scaty
322            write(ifc,*) 'f_scatxm =', f_scatxm
323            write(ifc,*) 'f_scatym =', f_scatym
324            
325            close(ifc)
326            
327          _END_MASTER( mythid )
328    
329    #ifdef ECCO_VERBOSE
330          write(msgbuf,'(a,D22.15)')
331         &  ' cost_Final: final cost function = ',fc
332          call print_message( msgbuf, standardmessageunit,
333         &                    SQUEEZE_RIGHT , mythid)
334          write(msgbuf,'(a)') ' '
335          call print_message( msgbuf, standardmessageunit,
336         &                    SQUEEZE_RIGHT , mythid)
337          write(msgbuf,'(a)')
338         &  '             cost function evaluation finished.'
339          call print_message( msgbuf, standardmessageunit,
340         &                    SQUEEZE_RIGHT , mythid)
341          write(msgbuf,'(a)') ' '
342          call print_message( msgbuf, standardmessageunit,
343         &                    SQUEEZE_RIGHT , mythid)
344    #endif
345    
       return  
346        end        end
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.2.6.4
  ViewVC Help
Powered by ViewVC 1.1.22