/[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.4.1 by heimbach, Mon Apr 8 20:10:38 2002 UTC revision 1.37 by gforget, Sat Feb 18 16:20:12 2017 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "COST_CPPOPTIONS.h"  #include "COST_OPTIONS.h"
5    #ifdef ALLOW_CTRL
6    # include "CTRL_OPTIONS.h"
7    #endif
8    
9        subroutine cost_final( mythid )        SUBROUTINE COST_FINAL( myThid )
10    
11  c     ==================================================================  c     ==================================================================
12  c     SUBROUTINE cost_final  c     SUBROUTINE cost_final
# Line 11  c     ================================== Line 14  c     ==================================
14  c  c
15  c     o Sum of all cost function contributions.  c     o Sum of all cost function contributions.
16  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  
17  c     ==================================================================  c     ==================================================================
18  c     SUBROUTINE cost_final  c     SUBROUTINE cost_final
19  c     ==================================================================  c     ==================================================================
20    
21        implicit none        IMPLICIT NONE
22    
23  c     == global variables ==  c     == global variables ==
   
24  #include "EEPARAMS.h"  #include "EEPARAMS.h"
25  #include "SIZE.h"  #include "SIZE.h"
26    #include "PARAMS.h"
27    
28  #include "cost.h"  #include "cost.h"
29  #include "ctrl.h"  #ifdef ALLOW_CTRL
30    # include "ctrl.h"
31    #endif
32    #ifdef ALLOW_DIC
33    # include "DIC_COST.h"
34    #endif
35    #ifdef ALLOW_COST_SHELFICE
36    # include "SHELFICE_COST.h"
37    #endif
38    
39  c     == routine arguments ==  #ifdef ALLOW_PROFILES
40    # include "PROFILES_SIZE.h"
41    # include "profiles.h"
42    #endif
43    
44        integer mythid  c     == routine arguments ==
45          INTEGER myThid
46    
47  #ifdef ALLOW_COST  #ifdef ALLOW_COST
48  c     == local variables ==  c     == local variables ==
49          INTEGER bi,bj
50        integer i,j,k        _RL glob_fc, loc_fc
51        integer bi,bj  #ifdef ALLOW_PROFILES
52        integer itlo,ithi        integer num_file,num_var
53        integer jtlo,jthi  #endif
54          character*(MAX_LEN_MBUF) msgBuf
55    
56  c     == end of interface ==  c     == end of interface ==
57    
58        jtlo = mybylo(mythid)  #ifdef ALLOW_SEAICE
59        jthi = mybyhi(mythid)        if (useSEAICE) CALL SEAICE_COST_FINAL (myThid)
60        itlo = mybxlo(mythid)  #endif
       ithi = mybxhi(mythid)  
61    
62  #ifdef ALLOW_COST_VECTOR  #ifdef ALLOW_SHELFICE
63          CALL SHELFICE_COST_FINAL (myThid)
64    #endif
65    
66        CALL COST_VECTOR (myThid)  c     print *, 'ph-1 in thsice_cost_final'
67    #ifdef ALLOW_THSICE
68          IF (useThSIce) CALL THSICE_COST_FINAL (myThid)
69    #endif
70    c     print *, 'ph-3 in thsice_cost_final'
71    
72        do bj = jtlo,jthi  #ifdef ALLOW_ECCO
73          do bi = itlo,ithi        IF (useECCO) CALL ECCO_COST_FINAL (myThid)
74            do i = 1,sNx  #endif
             print*,' --> objf_vector(i,bi,bj)  = ',  
      &            objf_vector(i,bi,bj)  
           end do  
         end do  
       end do  
75    
76  #else /* ALLOW_COST_VECTOR undef */  #ifdef ALLOW_COST_STATE_FINAL
77          CALL COST_STATE_FINAL (myThid)
78    cgf : effectively using this in adjoint requires the
79    c     use of adjoint_state_final. That will activate the
80    c     objf_state_final vector in place of the fc scalar.
81    c     objf_state_final is therefore not added to fc.
82    #endif
83    
84  #ifdef ALLOW_COST_TEST  #ifdef ALLOW_COST_VECTOR
85        CALL COST_TEST (myThid)  cgf : same idea as for ALLOW_COST_STATE_FINAL
86          CALL COST_VECTOR (myThid)
87  #endif  #endif
88    
89  #ifdef ALLOW_COST_ATLANTIC_HEAT  # ifdef ALLOW_COST_TEST
90          CALL COST_TEST (myThid)
91    # endif
92    
93    # ifdef ALLOW_COST_ATLANTIC_HEAT
94        CALL COST_ATLANTIC_HEAT (myThid)        CALL COST_ATLANTIC_HEAT (myThid)
95    # endif
96    
97    #ifdef ALLOW_COST_HFLUXM
98    cgf : to compile previous line user is expected to provide cost_hflux.F
99          CALL COST_HFLUX (myThid)
100    #endif
101    
102    #ifdef ALLOW_COST_TEMP
103          CALL COST_TEMP (myThid)
104    cgf : to compile previous line user is expected to provide cost_temp.F
105  #endif  #endif
106    
107          write(msgBuf,'(A,D22.15)') '  early fc = ', fc
108          call print_message( msgBuf, standardmessageunit,
109         &                    SQUEEZE_RIGHT , mythid)
110    
111  c--   Sum up all contributions.  c--   Sum up all contributions.
112        do bj = jtlo,jthi        loc_fc = 0.
113          do bi = itlo,ithi        DO bj = myByLo(myThid), myByHi(myThid)
114           DO bi = myBxLo(myThid), myBxHi(myThid)
115    
116            print*,' --> objf_test(bi,bj)   =',objf_test(bi,bj)  #ifdef ALLOW_COST_TEST
117            print*,' --> objf_tracer(bi,bj) =',objf_tracer(bi,bj)            write(standardmessageunit,'(A,D22.15)')
118            print*,' --> objf_atl(bi,bj) =',objf_atl(bi,bj)       &          ' --> objf_test(bi,bj)   = ', objf_test(bi,bj)
119    #endif
120    #ifdef ALLOW_COST_TRACER
121              write(standardmessageunit,'(A,D22.15)')
122         &         ' --> objf_tracer(bi,bj) = ', objf_tracer(bi,bj)
123    #endif
124    #if ( !defined (ALLOW_ECCO) || !defined (ALLOW_COST_ATLANTIC) )
125    # ifdef ALLOW_COST_ATLANTIC_HEAT
126              write(standardmessageunit,'(A,D22.15)')
127         &         ' --> objf_atl(bi,bj)    = ', objf_atl(bi,bj)
128    # endif
129    #endif
130    #ifdef ALLOW_COST_TEMP
131              write(standardmessageunit,'(A,D22.15)')
132         &          ' --> objf_temp_tut(bi,bj)   = ', objf_temp_tut(bi,bj)
133    #endif
134    #ifdef ALLOW_COST_HFLUXM
135              write(standardmessageunit,'(A,D22.15)')
136         &         ' --> objf_hflux_tut(bi,bj) = ', objf_hflux_tut(bi,bj)
137    #endif
138    #ifdef ALLOW_COST_TRANSPORT
139              write(standardmessageunit,'(A,D22.15)')
140         &         ' --> objf_transport(bi,bj) = ', objf_transport(bi,bj)
141    #endif
142    
143            fc = fc           tile_fc(bi,bj) = tile_fc(bi,bj)
144    #ifdef ALLOW_COST_TEST
145       &            + mult_test   * objf_test(bi,bj)       &            + mult_test   * objf_test(bi,bj)
146    #endif
147    #ifdef ALLOW_COST_TRACER
148       &            + mult_tracer * objf_tracer(bi,bj)       &            + mult_tracer * objf_tracer(bi,bj)
149    #endif
150    #if ( !defined (ALLOW_ECCO) || !defined (ALLOW_COST_ATLANTIC) )
151    # ifdef ALLOW_COST_ATLANTIC_HEAT
152       &            + mult_atl    * objf_atl(bi,bj)       &            + mult_atl    * objf_atl(bi,bj)
153          enddo  # endif
154    #endif
155    #ifdef ALLOW_COST_TRANSPORT
156         &            + mult_transport * objf_transport(bi,bj)
157    #endif
158    #ifdef ALLOW_COST_TEMP
159         &            + mult_temp_tut  * objf_temp_tut(bi,bj)
160    #endif
161    #ifdef ALLOW_COST_HFLUXM
162         &            + mult_hflux_tut * objf_hflux_tut(bi,bj)
163    #endif
164    
165    #ifdef ALLOW_PROFILES
166          if (.NOT.useECCO) then
167          do num_file=1,NFILESPROFMAX
168           do num_var=1,NVARMAX
169              tile_fc(bi,bj) = tile_fc(bi,bj)
170         &            + mult_profiles(num_file,num_var)
171         &            *objf_profiles(num_file,num_var,bi,bj)
172           enddo
173        enddo        enddo
174          endif
175    #endif
176    
177             loc_fc = loc_fc + tile_fc(bi,bj)
178    
179        print*,' fc = ', fc         ENDDO
180          ENDDO
181    
182          write(msgBuf,'(A,D22.15)') '  local fc = ', loc_fc
183          call print_message( msgBuf, standardmessageunit,
184         &                    SQUEEZE_RIGHT , mythid)
185    
186  c--   Do global summation.  c--   Do global summation.
187        _GLOBAL_SUM_R8( fc , myThid )        CALL GLOBAL_SUM_TILE_RL( tile_fc, glob_fc, myThid )
188          _BEGIN_MASTER( myThid )
189          fc = fc + glob_fc
190          _END_MASTER( myThid )
191    
192    c--   Add contributions from global mean constraints
193          _BEGIN_MASTER( myThid )
194          fc = fc + glofc
195          _END_MASTER( myThid )
196    
197    #ifdef ALLOW_DIC_COST
198    cph-- quickly for testing
199          fc = totcost
200    #endif
201    
202  #endif /* ALLOW_COST_VECTOR */        write(msgBuf,'(A,D22.15)') ' global fc = ', fc
203          call print_message( msgBuf, standardmessageunit,
204         &                    SQUEEZE_RIGHT , mythid)
205    
206    c--   to avoid re-write of output in reverse checkpointing loops,
207    c--   switch off output flag :
208          CALL TURNOFF_MODEL_IO( 0, myThid )
209    
210  #endif /* ALLOW_COST */  #endif /* ALLOW_COST */
211    
212        return        return
213        end        end
   
Legend:
Removed from v.1.2.4.1  
changed lines
  Added in v.1.37
  ViewVC Help
Powered by ViewVC 1.1.22