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