/[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.5 by heimbach, Fri May 23 16:26:26 2003 UTC
# Line 3  C $Header$ Line 3  C $Header$
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.
13  c  c
14  c     started: Christian Eckert eckert@mit.edu 30-Jun-1999  c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
 c  
15  c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000  c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
 c  
16  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
17  c                for the MITgcmUV.  c                for the MITgcmUV.
18    c     added sea-ice term: menemenlis@jpl.nasa.gov 26-Feb-2003
19  c  c
20  c     ==================================================================  c     ==================================================================
21  c     SUBROUTINE cost_Final  c     SUBROUTINE cost_final
22  c     ==================================================================  c     ==================================================================
23    
24        implicit none        implicit none
# Line 33  c     == global variables == Line 30  c     == global variables ==
30    
31  #include "cost.h"  #include "cost.h"
32  #include "ctrl.h"  #include "ctrl.h"
33    #include "optim.h"
34    
35  c     == routine arguments ==  c     == routine arguments ==
36    
37        integer mythid        integer mythid
38    
 #ifdef ALLOW_COST  
39  c     == local variables ==  c     == local variables ==
40    
41        integer bi,bj        integer bi,bj
42        integer itlo,ithi        integer itlo,ithi
43        integer jtlo,jthi        integer jtlo,jthi
44          integer ifc
45    
46          _RL f_temp0, f_salt0,  f_temp, f_salt
47          _RL f_tauu, f_tauv, f_hflux, f_sflux
48          _RL f_tauum, f_tauvm, f_hfluxm, f_sfluxm
49          _RL f_hfluxmm, f_sfluxmm
50          _RL f_sst, f_sss, f_atl, f_ctdt, f_ctds
51          _RL f_drifter, f_xbt, f_tdrift, f_sdrift, f_wdrift
52          _RL f_argot, f_argos, f_ssh
53          _RL f_scatx, f_scaty, f_scatxm, f_scatym
54          _RL f_ice
55          _RL f_ini_fin
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          f_ice = 0. _d 0
103          f_ini_fin = 0. _d 0
104    
105    #ifdef ECCO_VERBOSE
106          write(msgbuf,'(a)') ' '
107          call print_message( msgbuf, standardmessageunit,
108         &                    SQUEEZE_RIGHT , mythid)
109          write(msgbuf,'(a)') ' '
110          call print_message( msgbuf, standardmessageunit,
111         &                    SQUEEZE_RIGHT , mythid)
112          write(msgbuf,'(a)')
113         &  ' cost_Final: Evaluating the final cost function.'
114          call print_message( msgbuf, standardmessageunit,
115         &                    SQUEEZE_RIGHT , mythid)
116          write(msgbuf,'(a)') ' '
117          call print_message( msgbuf, standardmessageunit,
118         &                    SQUEEZE_RIGHT , mythid)
119  #endif  #endif
120    
121  c--   Sum up all contributions.  c--   Sum up all contributions.
122        do bj = jtlo,jthi        do bj = jtlo,jthi
123          do bi = itlo,ithi          do bi = itlo,ithi
124    
125            print*,' --> objf_test(bi,bj)   =',objf_test(bi,bj)            print*,' --> objf_temp(bi,bj)    =',objf_temp(bi,bj)
126            print*,' --> objf_tracer(bi,bj) =',objf_tracer(bi,bj)            print*,' --> objf_salt(bi,bj)    =',objf_salt(bi,bj)
127              print*,' --> objf_temp0(bi,bj)   =',objf_temp0(bi,bj)
128              print*,' --> objf_salt0(bi,bj)   =',objf_salt0(bi,bj)
129              print*,' --> objf_sst(bi,bj)     =',objf_sst(bi,bj)
130              print*,' --> objf_sss(bi,bj)     =',objf_sss(bi,bj)
131              print*,' --> objf_h(bi,bj)       =',objf_h(bi,bj)
132              print*,' --> objf_hmean          =',objf_hmean
133              print*,' --> objf_tauu(bi,bj)    =',objf_tauu(bi,bj)
134              print*,' --> objf_tauum(bi,bj)   =',objf_tauum(bi,bj)
135              print*,' --> objf_tauv(bi,bj)    =',objf_tauv(bi,bj)
136              print*,' --> objf_tauvm(bi,bj)   =',objf_tauvm(bi,bj)
137              print*,' --> objf_hflux(bi,bj)   =',objf_hflux(bi,bj)
138              print*,' --> objf_hflux(bi,bj)   =',objf_hfluxm(bi,bj)
139              print*,' --> objf_hflux(bi,bj)   =',objf_hfluxmm(bi,bj)
140              print*,' --> objf_sflux(bi,bj)   =',objf_sflux(bi,bj)
141              print*,' --> objf_sflux(bi,bj)   =',objf_sfluxm(bi,bj)
142              print*,' --> objf_sflux(bi,bj)   =',objf_sfluxmm(bi,bj)
143              print*,' --> objf_atl(bi,bj)     =',objf_atl(bi,bj)
144              print*,' --> objf_ctdt(bi,bj)    =',objf_ctdt(bi,bj)
145              print*,' --> objf_ctds(bi,bj)    =',objf_ctds(bi,bj)
146              print*,' --> objf_xbt(bi,bj)     =',objf_xbt(bi,bj)
147              print*,' --> objf_argot(bi,bj)   =',objf_argot(bi,bj)
148              print*,' --> objf_argos(bi,bj)   =',objf_argos(bi,bj)
149              print*,' --> objf_drift(bi,bj)   =',objf_drift(bi,bj)
150              print*,' --> objf_tdrift(bi,bj)  =',objf_tdrift(bi,bj)
151              print*,' --> objf_sdrift(bi,bj)  =',objf_sdrift(bi,bj)
152              print*,' --> objf_wdrift(bi,bj)  =',objf_wdrift(bi,bj)
153              print*,' --> objf_scatx(bi,bj)   =',objf_scatx(bi,bj)
154              print*,' --> objf_scaty(bi,bj)   =',objf_scaty(bi,bj)
155              print*,' --> objf_scatxm(bi,bj)  =',objf_scatxm(bi,bj)
156              print*,' --> objf_scatym(bi,bj)  =',objf_scatym(bi,bj)
157              print*,' --> objf_uwind(bi,bj)   =',objf_uwind(bi,bj)
158              print*,' --> objf_vwind(bi,bj)   =',objf_vwind(bi,bj)
159              print*,' --> objf_atemp(bi,bj)   =',objf_atemp(bi,bj)
160              print*,' --> objf_aqh(bi,bj)     =',objf_aqh(bi,bj)
161              print*,' --> objf_obcsn(bi,bj)   =',objf_obcsn(bi,bj)
162              print*,' --> objf_obcss(bi,bj)   =',objf_obcss(bi,bj)
163              print*,' --> objf_obcsw(bi,bj)   =',objf_obcsw(bi,bj)
164              print*,' --> objf_obcse(bi,bj)   =',objf_obcse(bi,bj)
165              print*,' --> objf_ice(bi,bj)     =',objf_ice(bi,bj)
166              print*,' --> objf_ini_fin(bi,bj) =',
167         &         objf_theta_ini_fin(bi,bj) + objf_salt_ini_fin(bi,bj)
168    
169            fc = fc            fc = fc
170       &            + mult_test   * objf_test(bi,bj)       &            + mult_temp    * objf_temp(bi,bj)
171       &            + mult_tracer * objf_tracer(bi,bj)       &            + mult_salt    * objf_salt(bi,bj)
172         &            + mult_temp0   * objf_temp0(bi,bj)
173         &            + mult_salt0   * objf_salt0(bi,bj)
174         &            + mult_sst     * objf_sst(bi,bj)
175         &            + mult_sss     * objf_sss(bi,bj)
176         &            + mult_tauu    * objf_tauu(bi,bj)
177         &            + mult_tauu    * objf_tauum(bi,bj)
178         &            + mult_tauv    * objf_tauv(bi,bj)
179         &            + mult_tauv    * objf_tauvm(bi,bj)
180         &            + mult_hflux   * objf_hflux(bi,bj)  
181         &            + mult_hflux   * objf_hfluxm(bi,bj)  
182         &            + mult_hflux   * objf_hfluxmm(bi,bj)  
183         &            + mult_sflux   * objf_sflux(bi,bj)  
184         &            + mult_sflux   * objf_sfluxm(bi,bj)  
185         &            + mult_sflux   * objf_sfluxmm(bi,bj)  
186         &            + mult_h       * objf_h(bi,bj)
187         &            + mult_atl     * objf_atl(bi,bj)
188         &            + mult_ctdt    * objf_ctdt(bi,bj)
189         &            + mult_ctds    * objf_ctds(bi,bj)
190         &            + mult_xbt     * objf_xbt(bi,bj)
191         &            + mult_argot   * objf_argot(bi,bj)
192         &            + mult_argos   * objf_argos(bi,bj)
193         &            + mult_drift   * objf_drift(bi,bj)
194         &            + mult_sdrift  * objf_sdrift(bi,bj)
195         &            + mult_tdrift  * objf_tdrift(bi,bj)
196         &            + mult_wdrift  * objf_wdrift(bi,bj)
197         &            + mult_scatx   * objf_scatx(bi,bj)
198         &            + mult_scaty   * objf_scaty(bi,bj)
199         &            + mult_scatx   * objf_scatxm(bi,bj)
200         &            + mult_scaty   * objf_scatym(bi,bj)
201         &            + mult_uwind   * objf_uwind(bi,bj)
202         &            + mult_vwind   * objf_vwind(bi,bj)
203         &            + mult_atemp   * objf_atemp(bi,bj)  
204         &            + mult_aqh     * objf_aqh(bi,bj)  
205         &            + mult_obcsn   * objf_obcsn(bi,bj)  
206         &            + mult_obcss   * objf_obcss(bi,bj)  
207         &            + mult_obcsw   * objf_obcsw(bi,bj)  
208         &            + mult_obcse   * objf_obcse(bi,bj)  
209         &            + mult_ice     * objf_ice(bi,bj)
210         &            + mult_ini_fin *(objf_theta_ini_fin(bi,bj) +
211         &                             objf_salt_ini_fin(bi,bj))
212    
213              f_temp = f_temp + objf_temp(bi,bj)
214              f_salt = f_salt + objf_salt(bi,bj)
215              f_temp0 = f_temp0 + objf_temp0(bi,bj)
216              f_salt0 = f_salt0 + objf_salt0(bi,bj)
217              f_tauu = f_tauu + objf_tauu(bi,bj)
218              f_tauum  = f_tauum + objf_tauum(bi,bj)
219              f_tauv = f_tauv + objf_tauv(bi,bj)
220              f_tauvm  = f_tauvm + objf_tauvm(bi,bj)
221              f_hflux= f_hflux + objf_hflux(bi,bj)  
222              f_hfluxm = f_hfluxm + objf_hfluxm(bi,bj)  
223              f_hfluxmm = f_hfluxmm + objf_hfluxmm(bi,bj)  
224              f_sflux= f_sflux + objf_sflux(bi,bj)  
225              f_sfluxm = f_sfluxm + objf_sfluxm(bi,bj)  
226              f_sfluxmm = f_sfluxmm + objf_sfluxmm(bi,bj)  
227              f_ssh  = f_ssh + objf_h(bi,bj)
228              f_sst  = f_sst + objf_sst(bi,bj)
229              f_sss  = f_sss + objf_sss(bi,bj)
230              f_atl  = f_atl + objf_atl(bi,bj)
231              f_ctdt = f_ctdt + objf_ctdt(bi,bj)
232              f_ctds = f_ctds + objf_ctds(bi,bj)
233              f_xbt  = f_xbt + objf_xbt(bi,bj)
234              f_argot  = f_argot + objf_argot(bi,bj)
235              f_argos  = f_argos + objf_argos(bi,bj)
236              f_drifter = f_drifter + objf_drift(bi,bj)
237              f_sdrift = f_sdrift + objf_sdrift(bi,bj)
238              f_tdrift = f_tdrift + objf_tdrift(bi,bj)
239              f_wdrift = f_wdrift + objf_wdrift(bi,bj)
240              f_scatx = f_scatx + objf_scatx(bi,bj)
241              f_scaty = f_scaty + objf_scaty(bi,bj)
242              f_scatxm = f_scatxm + objf_scatxm(bi,bj)
243              f_scatym = f_scatym + objf_scatym(bi,bj)
244              f_ice = f_ice + objf_ice(bi,bj)
245              f_ini_fin = f_ini_fin +
246         &         objf_theta_ini_fin(bi,bj) + objf_salt_ini_fin(bi,bj)
247    
248          enddo          enddo
249        enddo        enddo
250    
       print*,' fc = ', fc  
251    
252  c--   Do global summation.  c--   Do global summation.
253        _GLOBAL_SUM_R8( fc , myThid )        _GLOBAL_SUM_R8( fc , myThid )
254    
255  #endif /* ALLOW_COST */  c--   Do global summation for each part of the cost function
256                
257          _GLOBAL_SUM_R8( f_temp , myThid )
258          _GLOBAL_SUM_R8( f_salt , myThid )
259          _GLOBAL_SUM_R8( f_temp0, myThid )
260          _GLOBAL_SUM_R8( f_salt0, myThid )
261          _GLOBAL_SUM_R8( f_tauu , myThid )
262          _GLOBAL_SUM_R8( f_tauum , myThid )
263          _GLOBAL_SUM_R8( f_tauv , myThid )
264          _GLOBAL_SUM_R8( f_tauvm , myThid )
265          _GLOBAL_SUM_R8( f_hflux , myThid )
266          _GLOBAL_SUM_R8( f_hfluxm , myThid )
267          _GLOBAL_SUM_R8( f_hfluxmm , myThid )
268          _GLOBAL_SUM_R8( f_sflux , myThid )
269          _GLOBAL_SUM_R8( f_sfluxm , myThid )
270          _GLOBAL_SUM_R8( f_sfluxmm , myThid )
271          _GLOBAL_SUM_R8( f_ssh , myThid )
272          _GLOBAL_SUM_R8( f_sst , myThid )
273          _GLOBAL_SUM_R8( f_sss , myThid )
274          _GLOBAL_SUM_R8( f_atl , myThid )
275          _GLOBAL_SUM_R8( f_ctdt , myThid )
276          _GLOBAL_SUM_R8( f_ctds , myThid )
277          _GLOBAL_SUM_R8( f_xbt , myThid )
278          _GLOBAL_SUM_R8( f_argot , myThid )
279          _GLOBAL_SUM_R8( f_argos , myThid )
280          _GLOBAL_SUM_R8( f_drifter , myThid )
281          _GLOBAL_SUM_R8( f_sdrift , myThid )
282          _GLOBAL_SUM_R8( f_tdrift , myThid )    
283          _GLOBAL_SUM_R8( f_wdrift , myThid )    
284          _GLOBAL_SUM_R8( f_scatx , myThid )    
285          _GLOBAL_SUM_R8( f_scaty , myThid )    
286          _GLOBAL_SUM_R8( f_scatxm , myThid )    
287          _GLOBAL_SUM_R8( f_scatym , myThid )    
288          _GLOBAL_SUM_R8( f_ice , myThid )    
289          _GLOBAL_SUM_R8( f_ini_fin , myThid )    
290    
291    c--   Each process has calculated the global part for itself.
292          _BEGIN_MASTER( mythid )
293    
294            fc = fc + mult_hmean*objf_hmean
295          
296            print*, ' --> objf_hmean           =',objf_hmean
297            print*, ' --> fc               =', fc
298        
299            write(cfname,'(A,i4.4)') 'costfunction',optimcycle
300            open(unit=ifc,file=cfname)
301          
302            write(ifc,*) 'fc =', fc
303            write(ifc,*) 'f_temp =', f_temp
304            write(ifc,*) 'f_salt =', f_salt
305            write(ifc,*) 'f_temp0 =', f_temp0
306            write(ifc,*) 'f_salt0 =', f_salt0
307            write(ifc,*) 'f_tauu =', f_tauu
308            write(ifc,*) 'f_tauum =', f_tauum
309            write(ifc,*) 'f_tauv =', f_tauv
310            write(ifc,*) 'f_tauvm =', f_tauvm
311            write(ifc,*) 'f_hflux =', f_hflux
312            write(ifc,*) 'f_hfluxm =', f_hfluxm
313            write(ifc,*) 'f_hfluxmm =', f_hfluxmm
314            write(ifc,*) 'f_sflux =', f_sflux
315            write(ifc,*) 'f_sfluxm =', f_sfluxm
316            write(ifc,*) 'f_sfluxmm =', f_sfluxmm
317            write(ifc,*) 'f_ssh =', f_ssh
318            write(ifc,*) 'f_sst =', f_sst
319            write(ifc,*) 'f_sss =', f_sss
320            write(ifc,*) 'f_atl =', f_atl
321            write(ifc,*) 'f_ctdt =', f_ctdt
322            write(ifc,*) 'f_ctds =', f_ctds
323            write(ifc,*) 'f_xbt =', f_xbt
324            write(ifc,*) 'f_argot =', f_argot
325            write(ifc,*) 'f_argos =', f_argos
326            write(ifc,*) 'objf_hmean =', objf_hmean
327            write(ifc,*) 'f_drifter =', f_drifter
328            write(ifc,*) 'f_sdrift =', f_sdrift
329            write(ifc,*) 'f_tdrift =', f_tdrift
330            write(ifc,*) 'f_wdrift =', f_wdrift
331            write(ifc,*) 'f_scatx =', f_scatx
332            write(ifc,*) 'f_scaty =', f_scaty
333            write(ifc,*) 'f_scatxm =', f_scatxm
334            write(ifc,*) 'f_scatym =', f_scatym
335            write(ifc,*) 'f_ini_fin =', f_ini_fin
336            
337            close(ifc)
338            
339          _END_MASTER( mythid )
340    
341    #ifdef ECCO_VERBOSE
342          write(msgbuf,'(a,D22.15)')
343         &  ' cost_Final: final cost function = ',fc
344          call print_message( msgbuf, standardmessageunit,
345         &                    SQUEEZE_RIGHT , mythid)
346          write(msgbuf,'(a)') ' '
347          call print_message( msgbuf, standardmessageunit,
348         &                    SQUEEZE_RIGHT , mythid)
349          write(msgbuf,'(a)')
350         &  '             cost function evaluation finished.'
351          call print_message( msgbuf, standardmessageunit,
352         &                    SQUEEZE_RIGHT , mythid)
353          write(msgbuf,'(a)') ' '
354          call print_message( msgbuf, standardmessageunit,
355         &                    SQUEEZE_RIGHT , mythid)
356    #endif
357    
       return  
358        end        end
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.2.6.5
  ViewVC Help
Powered by ViewVC 1.1.22