/[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.8 by heimbach, Fri Nov 14 23:07:30 2003 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    
3    #include "PACKAGES_CONFIG.h"
4  #include "COST_CPPOPTIONS.h"  #include "COST_CPPOPTIONS.h"
5    
6          subroutine cost_final( mythid )
       subroutine cost_Final(  
      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
16  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.  
17  c  c
18  c     ==================================================================  c     ==================================================================
19  c     SUBROUTINE cost_Final  c     SUBROUTINE cost_final
20  c     ==================================================================  c     ==================================================================
21    
22        implicit none        implicit none
# Line 30  c     == global variables == Line 25  c     == global variables ==
25    
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27  #include "SIZE.h"  #include "SIZE.h"
28    #include "PARAMS.h"
29    
30  #include "cost.h"  #include "cost.h"
31  #include "ctrl.h"  #include "ctrl.h"
# Line 38  c     == routine arguments == Line 34  c     == routine arguments ==
34    
35        integer mythid        integer mythid
36    
37    #ifdef ALLOW_COST
38  c     == local variables ==  c     == local variables ==
39    
40          integer i,j,k
41        integer bi,bj        integer bi,bj
42        integer itlo,ithi        integer itlo,ithi
43        integer jtlo,jthi        integer jtlo,jthi
44    
 #ifdef ECCO_VERBOSE  
       character*(MAX_LEN_MBUF) msgbuf  
 #endif  
   
45  c     == end of interface ==  c     == end of interface ==
46    
47        jtlo = mybylo(mythid)        jtlo = mybylo(mythid)
# Line 55  c     == end of interface == Line 49  c     == end of interface ==
49        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
50        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
51    
52  #ifdef ECCO_VERBOSE  #if (defined (ALLOW_ECCO))
53        write(msgbuf,'(a)') ' '        CALL ECCO_COST_FINAL (myThid)
54        call print_message( msgbuf, standardmessageunit,  
55       &                    SQUEEZE_RIGHT , mythid)  #elif (defined (ALLOW_COST_VECTOR))
56        write(msgbuf,'(a)') ' '        CALL COST_VECTOR (myThid)
57        call print_message( msgbuf, standardmessageunit,  
58       &                    SQUEEZE_RIGHT , mythid)  #elif (defined (ALLOW_COST_STATE_FINAL))
59        write(msgbuf,'(a)')        CALL COST_STATE_FINAL (myThid)
60       &  ' cost_Final: Evaluating the final cost function.'  
61        call print_message( msgbuf, standardmessageunit,  #endif /* above stuff undef */
62       &                    SQUEEZE_RIGHT , mythid)  
63        write(msgbuf,'(a)') ' '  #ifndef ALLOW_ECCO
64        call print_message( msgbuf, standardmessageunit,  
65       &                    SQUEEZE_RIGHT , mythid)  # ifdef ALLOW_COST_TEST
66  #endif        CALL COST_TEST (myThid)
67    # endif
68    # ifdef ALLOW_COST_ATLANTIC_HEAT
69          CALL COST_ATLANTIC_HEAT (myThid)
70    # endif
71    
72  c--   Sum up all contributions.  c--   Sum up all contributions.
73        do bj = jtlo,jthi        do bj = jtlo,jthi
74          do bi = itlo,ithi          do bi = itlo,ithi
75    
76            print*,' --> objf_temp(bi,bj) =',objf_temp(bi,bj)            print*,' --> objf_test(bi,bj)   =',objf_test(bi,bj)
77            print*,' --> objf_salt(bi,bj) =',objf_salt(bi,bj)            print*,' --> objf_tracer(bi,bj) =',objf_tracer(bi,bj)
78            print*,' --> objf_tauu(bi,bj) =',objf_tauu(bi,bj)            print*,' --> objf_atl(bi,bj)    =',objf_atl(bi,bj)
           print*,' --> objf_tauv(bi,bj) =',objf_tauv(bi,bj)  
           print*,' --> objf_hflux(bi,bj)   =',objf_hflux(bi,bj)  
           print*,' --> objf_sflux(bi,bj)   =',objf_sflux(bi,bj)  
           print*,' --> objf_sst(bi,bj)  =',objf_sst(bi,bj)  
           print*,' --> objf_h(bi,bj)    =',objf_h(bi,bj)  
           print*,' --> objf_atl(bi,bj)  =',objf_atl(bi,bj)  
           print*,' --> objf_ctdt(bi,bj) =',objf_ctdt(bi,bj)  
           print*,' --> objf_ctds(bi,bj) =',objf_ctds(bi,bj)  
           print*,' --> objf_test(bi,bj) =',objf_test(bi,bj)  
79    
80            fc = fc            fc = fc
81       &            + mult_temp * objf_temp(bi,bj)       &            + mult_test   * objf_test(bi,bj)
82       &            + mult_salt * objf_salt(bi,bj)       &            + mult_tracer * objf_tracer(bi,bj)
83       &            + mult_tauu * objf_tauu(bi,bj)       &            + mult_atl    * objf_atl(bi,bj)
      &            + mult_tauv * objf_tauv(bi,bj)  
      &            + mult_hq   * objf_hflux(bi,bj)    
      &            + mult_hs   * objf_sflux(bi,bj)    
      &            + mult_sst  * objf_sst(bi,bj)  
      &            + mult_h    * objf_h(bi,bj)  
      &            + mult_atl  * objf_atl(bi,bj)  
      &            + mult_ctdt * objf_ctdt(bi,bj)  
      &            + mult_ctds * objf_ctds(bi,bj)  
      &            + mult_test * objf_test(bi,bj)  
84          enddo          enddo
85        enddo        enddo
86    
87          print*,' local fc = ', fc
88    
89  c--   Do global summation.  c--   Do global summation.
90        _GLOBAL_SUM_R8( fc , myThid )        _GLOBAL_SUM_R8( fc , myThid )
91    
92  c--   Each process has calculated the global part for itself.        print*,' global fc = ', fc
93        _BEGIN_MASTER( mythid )  
94          fc = fc + mult_hmean*objf_hmean  #endif /* ALLOW_ECCO */
95        _END_MASTER( mythid )  
96        print*,' --> fc               =',fc  c--   set averaging freq. to zero to avoid re-write of
97    c--   averaged fields in reverse checkpointing loops
98  #ifdef ECCO_VERBOSE        taveFreq = 0.
99        write(msgbuf,'(a,D22.15)')  
100       &  ' cost_Final: final cost function = ',fc  #endif /* ALLOW_COST */
       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)  
 #endif  
101    
102        return        return
103        end        end

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.22