/[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.1 by heimbach, Sun Mar 25 22:33:54 2001 UTC revision 1.23 by heimbach, Fri Jan 7 12:35:58 2011 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "COST_CPPOPTIONS.h"  #include "COST_CPPOPTIONS.h"
6    
7          subroutine cost_final( mythid )
       subroutine cost_Final(  
      I                       mythid  
      &                     )  
8    
9  c     ==================================================================  c     ==================================================================
10  c     SUBROUTINE cost_Final  c     SUBROUTINE cost_final
11  c     ==================================================================  c     ==================================================================
12  c  c
13  c     o Sum of all cost function contributions.  c     o Sum of all cost function contributions.
14  c  c
 c     started: Christian Eckert eckert@mit.edu 30-Jun-1999  
 c  
 c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000  
 c  
 c              - Restructured the code in order to create a package  
 c                for the MITgcmUV.  
 c  
15  c     ==================================================================  c     ==================================================================
16  c     SUBROUTINE cost_Final  c     SUBROUTINE cost_final
17  c     ==================================================================  c     ==================================================================
18    
19        implicit none        implicit none
# Line 30  c     == global variables == Line 22  c     == global variables ==
22    
23  #include "EEPARAMS.h"  #include "EEPARAMS.h"
24  #include "SIZE.h"  #include "SIZE.h"
25    #include "PARAMS.h"
26    
27  #include "cost.h"  #include "cost.h"
28  #include "ctrl.h"  #ifdef ALLOW_CTRL
29    # include "ctrl.h"
30    #endif
31    #ifdef ALLOW_DIC
32    # include "DIC_COST.h"
33    #endif
34    #ifdef ALLOW_COST_SHELFICE
35    # include "SHELFICE_COST.h"
36    #endif
37    
38    
39  c     == routine arguments ==  c     == routine arguments ==
40    
41        integer mythid        integer mythid
42    
43    #ifdef ALLOW_COST
44  c     == local variables ==  c     == local variables ==
45    
46          integer i,j,k
47        integer bi,bj        integer bi,bj
48        integer itlo,ithi        integer itlo,ithi
49        integer jtlo,jthi        integer jtlo,jthi
50    
 #ifdef ECCO_VERBOSE  
       character*(MAX_LEN_MBUF) msgbuf  
 #endif  
   
51  c     == end of interface ==  c     == end of interface ==
52    
53        jtlo = mybylo(mythid)        jtlo = mybylo(mythid)
# Line 55  c     == end of interface == Line 55  c     == end of interface ==
55        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
56        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
57    
58  #ifdef ECCO_VERBOSE  #ifdef ALLOW_SEAICE
59        write(msgbuf,'(a)') ' '        CALL SEAICE_COST_FINAL (myThid)
60        call print_message( msgbuf, standardmessageunit,  #endif
61       &                    SQUEEZE_RIGHT , mythid)  
62        write(msgbuf,'(a)') ' '  #if (defined (ALLOW_ECCO))
63        call print_message( msgbuf, standardmessageunit,        CALL ECCO_COST_FINAL (myThid)
64       &                    SQUEEZE_RIGHT , mythid)  
65        write(msgbuf,'(a)')  #elif (defined (ALLOW_COST_VECTOR))
66       &  ' cost_Final: Evaluating the final cost function.'        CALL COST_VECTOR (myThid)
67        call print_message( msgbuf, standardmessageunit,  
68       &                    SQUEEZE_RIGHT , mythid)  #elif (defined (ALLOW_COST_STATE_FINAL))
69        write(msgbuf,'(a)') ' '        CALL COST_STATE_FINAL (myThid)
70        call print_message( msgbuf, standardmessageunit,  
71       &                    SQUEEZE_RIGHT , mythid)  #endif /* above stuff undef */
72    
73    #ifndef ALLOW_ECCO
74    
75    # ifdef ALLOW_COST_TEST
76          CALL COST_TEST (myThid)
77    # endif
78    # ifdef ALLOW_COST_ATLANTIC_HEAT
79          CALL COST_ATLANTIC_HEAT (myThid)
80    # endif
81    #ifdef ALLOW_COST_HFLUXM
82          CALL COST_HFLUX (myThid)
83    #endif
84    #ifdef ALLOW_COST_TEMP
85          CALL COST_TEMP (myThid)
86    #endif
87    #ifdef ALLOW_SHELFICE
88    # ifdef ALLOW_COST_SHELFICE
89          CALL SHELFICE_COST_FINAL (myThid)
90    # endif
91  #endif  #endif
92    
93  c--   Sum up all contributions.  c--   Sum up all contributions.
94        do bj = jtlo,jthi        do bj = jtlo,jthi
95          do bi = itlo,ithi          do bi = itlo,ithi
96    
97            print*,' --> objf_temp(bi,bj) =',objf_temp(bi,bj)            write(standardmessageunit,'(A,D22.15)')
98            print*,' --> objf_salt(bi,bj) =',objf_salt(bi,bj)       &          ' --> objf_test(bi,bj)   = ', objf_test(bi,bj)
99            print*,' --> objf_tauu(bi,bj) =',objf_tauu(bi,bj)            write(standardmessageunit,'(A,D22.15)')
100            print*,' --> objf_tauv(bi,bj) =',objf_tauv(bi,bj)       &         ' --> objf_tracer(bi,bj) = ', objf_tracer(bi,bj)
101            print*,' --> objf_hflux(bi,bj)   =',objf_hflux(bi,bj)            write(standardmessageunit,'(A,D22.15)')
102            print*,' --> objf_sflux(bi,bj)   =',objf_sflux(bi,bj)       &         ' --> objf_atl(bi,bj)    = ', objf_atl(bi,bj)
103            print*,' --> objf_sst(bi,bj)  =',objf_sst(bi,bj)  #ifdef ALLOW_COST_TEMP
104            print*,' --> objf_h(bi,bj)    =',objf_h(bi,bj)            write(standardmessageunit,'(A,D22.15)')
105            print*,' --> objf_atl(bi,bj)  =',objf_atl(bi,bj)       &          ' --> objf_temp_tut(bi,bj)   = ', objf_temp_tut(bi,bj)
106            print*,' --> objf_ctdt(bi,bj) =',objf_ctdt(bi,bj)  #endif
107            print*,' --> objf_ctds(bi,bj) =',objf_ctds(bi,bj)  #ifdef ALLOW_COST_HFLUXM
108            print*,' --> objf_test(bi,bj) =',objf_test(bi,bj)            write(standardmessageunit,'(A,D22.15)')
109         &         ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
110    #endif
111    #ifdef ALLOW_COST_TRANSPORT
112              write(standardmessageunit,'(A,D22.15)')
113         &         ' --> objf_transport(bi,bj) = ', objf_transport(bi,bj)
114    #endif
115    #ifdef ALLOW_COST_SHELFICE
116              write(standardmessageunit,'(A,D22.15)')
117         &         ' --> objf_shelfice(bi,bj) = ', objf_shelfice(bi,bj)
118    #endif
119    
120            fc = fc            fc = fc
121       &            + mult_temp * objf_temp(bi,bj)       &            + mult_test   * objf_test(bi,bj)
122       &            + mult_salt * objf_salt(bi,bj)       &            + mult_tracer * objf_tracer(bi,bj)
123       &            + mult_tauu * objf_tauu(bi,bj)       &            + mult_atl    * objf_atl(bi,bj)
124       &            + mult_tauv * objf_tauv(bi,bj)  #ifdef ALLOW_COST_TRANSPORT
125       &            + mult_hq   * objf_hflux(bi,bj)         &            + mult_transport * objf_transport(bi,bj)
126       &            + mult_hs   * objf_sflux(bi,bj)    #endif
127       &            + mult_sst  * objf_sst(bi,bj)  #ifdef ALLOW_COST_TEMP
128       &            + mult_h    * objf_h(bi,bj)       &            + mult_temp_tut  * objf_temp_tut(bi,bj)
129       &            + mult_atl  * objf_atl(bi,bj)  #endif
130       &            + mult_ctdt * objf_ctdt(bi,bj)  #ifdef ALLOW_COST_HFLUXM
131       &            + mult_ctds * objf_ctds(bi,bj)       &            + mult_hflux_tut * objf_hflux_tut(bi,bj)
132       &            + mult_test * objf_test(bi,bj)  #endif
133    #ifdef ALLOW_COST_SHELFICE
134         &            + mult_shelfice * objf_shelfice(bi,bj)
135    #endif
136          enddo          enddo
137        enddo        enddo
138    
139          write(standardmessageunit,'(A,D22.15)') '  local fc = ', fc
140    
141  c--   Do global summation.  c--   Do global summation.
142        _GLOBAL_SUM_R8( fc , myThid )        _GLOBAL_SUM_RL( fc , myThid )
143    
144  c--   Each process has calculated the global part for itself.  #ifdef ALLOW_DIC
145        _BEGIN_MASTER( mythid )  cph-- quickly for testing
146          fc = fc + mult_hmean*objf_hmean        fc = totcost
       _END_MASTER( mythid )  
       print*,' --> fc               =',fc  
   
 #ifdef ECCO_VERBOSE  
       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)  
147  #endif  #endif
148    
149          write(standardmessageunit,'(A,D22.15)') ' global fc = ', fc
150    
151    #endif /* ALLOW_ECCO */
152    
153    c--   to avoid re-write of output in reverse checkpointing loops,
154    c--   switch off output flag :
155          CALL TURNOFF_MODEL_IO( 0, myThid )
156    
157    #endif /* ALLOW_COST */
158    
159        return        return
160        end        end
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22