/[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.5 by heimbach, Tue Jan 21 19:20:52 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.
# Line 21  c              - Restructured the code i Line 19  c              - Restructured the code i
19  c                for the MITgcmUV.  c                for the MITgcmUV.
20  c  c
21  c     ==================================================================  c     ==================================================================
22  c     SUBROUTINE cost_Final  c     SUBROUTINE cost_final
23  c     ==================================================================  c     ==================================================================
24    
25        implicit none        implicit none
# Line 30  c     == global variables == Line 28  c     == global variables ==
28    
29  #include "EEPARAMS.h"  #include "EEPARAMS.h"
30  #include "SIZE.h"  #include "SIZE.h"
31    #include "PARAMS.h"
32    
33  #include "cost.h"  #include "cost.h"
34  #include "ctrl.h"  #include "ctrl.h"
# Line 38  c     == routine arguments == Line 37  c     == routine arguments ==
37    
38        integer mythid        integer mythid
39    
40    #ifdef ALLOW_COST
41  c     == local variables ==  c     == local variables ==
42    
43          integer i,j,k
44        integer bi,bj        integer bi,bj
45        integer itlo,ithi        integer itlo,ithi
46        integer jtlo,jthi        integer jtlo,jthi
47    
 #ifdef ECCO_VERBOSE  
       character*(MAX_LEN_MBUF) msgbuf  
 #endif  
   
48  c     == end of interface ==  c     == end of interface ==
49    
50        jtlo = mybylo(mythid)        jtlo = mybylo(mythid)
# Line 55  c     == end of interface == Line 52  c     == end of interface ==
52        itlo = mybxlo(mythid)        itlo = mybxlo(mythid)
53        ithi = mybxhi(mythid)        ithi = mybxhi(mythid)
54    
55  #ifdef ECCO_VERBOSE  #ifdef ALLOW_COST_VECTOR
56        write(msgbuf,'(a)') ' '  
57        call print_message( msgbuf, standardmessageunit,        CALL COST_VECTOR (myThid)
58       &                    SQUEEZE_RIGHT , mythid)  
59        write(msgbuf,'(a)') ' '        do bj = jtlo,jthi
60        call print_message( msgbuf, standardmessageunit,          do bi = itlo,ithi
61       &                    SQUEEZE_RIGHT , mythid)            do i = 1,sNx
62        write(msgbuf,'(a)')              print*,' --> objf_vector(i,bi,bj)  = ',
63       &  ' cost_Final: Evaluating the final cost function.'       &            objf_vector(i,bi,bj)
64        call print_message( msgbuf, standardmessageunit,            end do
65       &                    SQUEEZE_RIGHT , mythid)          end do
66        write(msgbuf,'(a)') ' '        end do
67        call print_message( msgbuf, standardmessageunit,  
68       &                    SQUEEZE_RIGHT , mythid)  #else /* ALLOW_COST_VECTOR undef */
69    
70    #ifdef ALLOW_COST_TEST
71          CALL COST_TEST (myThid)
72    #endif
73    
74    #ifdef ALLOW_COST_ATLANTIC_HEAT
75          CALL COST_ATLANTIC_HEAT (myThid)
76  #endif  #endif
77    
78  c--   Sum up all contributions.  c--   Sum up all contributions.
79        do bj = jtlo,jthi        do bj = jtlo,jthi
80          do bi = itlo,ithi          do bi = itlo,ithi
81    
82            print*,' --> objf_temp(bi,bj) =',objf_temp(bi,bj)            print*,' --> objf_test(bi,bj)   =',objf_test(bi,bj)
83            print*,' --> objf_salt(bi,bj) =',objf_salt(bi,bj)            print*,' --> objf_tracer(bi,bj) =',objf_tracer(bi,bj)
84            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)  
85    
86            fc = fc            fc = fc
87       &            + mult_temp * objf_temp(bi,bj)       &            + mult_test   * objf_test(bi,bj)
88       &            + mult_salt * objf_salt(bi,bj)       &            + mult_tracer * objf_tracer(bi,bj)
89       &            + 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)  
90          enddo          enddo
91        enddo        enddo
92    
93          print*,' fc = ', fc
94    
95  c--   Do global summation.  c--   Do global summation.
96        _GLOBAL_SUM_R8( fc , myThid )        _GLOBAL_SUM_R8( fc , myThid )
97    
98  c--   Each process has calculated the global part for itself.  #endif /* ALLOW_COST_VECTOR */
99        _BEGIN_MASTER( mythid )  
100          fc = fc + mult_hmean*objf_hmean  c--   set averaging freq. to zero to avoid re-write of
101        _END_MASTER( mythid )  c--   averaged fields in reverse checkpointing loops
102        print*,' --> fc               =',fc        taveFreq = 0.
103    
104  #ifdef ECCO_VERBOSE  #endif /* ALLOW_COST */
       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)  
 #endif  
105    
106        return        return
107        end        end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22