/[MITgcm]/MITgcm/pkg/seaice/seaice_cost_final.F
ViewVC logotype

Diff of /MITgcm/pkg/seaice/seaice_cost_final.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.16 by heimbach, Fri Nov 9 22:15:18 2012 UTC revision 1.17 by jmc, Wed Nov 6 19:04:36 2013 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "SEAICE_OPTIONS.h"  #include "SEAICE_OPTIONS.h"
5    
6        subroutine seaice_cost_final( mythid )  CBOP
7    C     !ROUTINE: SEAICE_COST_FINAL
8    C     !INTERFACE:
9          SUBROUTINE SEAICE_COST_FINAL( myThid )
10    
11    C     !DESCRIPTION:
12    C     *==========================================================*
13    C     | SUBROUTINE SEAICE_COST_FINAL
14    C     *==========================================================*
15    
16  c     ==================================================================  C     !USES:
17  c     SUBROUTINE seaice_cost_final        IMPLICIT NONE
 c     ==================================================================  
   
       implicit none  
   
 c     == global variables ==  
18    
19    C     == global variables ==
20  #include "EEPARAMS.h"  #include "EEPARAMS.h"
21  #include "SIZE.h"  #include "SIZE.h"
22  #include "PARAMS.h"  #include "PARAMS.h"
 #include "DYNVARS.h"  
23  #include "SEAICE_SIZE.h"  #include "SEAICE_SIZE.h"
24  #include "SEAICE_PARAMS.h"  #include "SEAICE_PARAMS.h"
25  #ifdef ALLOW_COST  #ifdef ALLOW_COST
# Line 26  c     == global variables == Line 29  c     == global variables ==
29  #include "optim.h"  #include "optim.h"
30  #endif  #endif
31    
32  c     == routine arguments ==  C     !INPUT/OUTPUT PARAMETERS:
33          INTEGER myThid
       integer mythid  
34    
35  #ifdef ALLOW_COST  #ifdef ALLOW_COST
36    C     ! FUNCTIONS:
 C     === Functions ====  
37        LOGICAL  MASTER_CPU_THREAD        LOGICAL  MASTER_CPU_THREAD
38        EXTERNAL MASTER_CPU_THREAD        EXTERNAL MASTER_CPU_THREAD
39    
40  c     == local variables ==  C     !LOCAL VARIABLES:
41          INTEGER bi, bj
42        integer bi,bj        INTEGER ifc
       integer itlo,ithi  
       integer jtlo,jthi  
       integer ifc  
       integer totnum  
   
43        _RL f_ice        _RL f_ice
44        _RL f_smrarea        _RL f_smrarea
45        _RL f_smrsst        _RL f_smrsst
46        _RL f_smrsss        _RL f_smrsss
   
47        _RL no_ice        _RL no_ice
48        _RL no_smrarea        _RL no_smrarea
49        _RL no_smrsst        _RL no_smrsst
50        _RL no_smrsss        _RL no_smrsss
51          CHARACTER*23 cfname
52        character*23 cfname  c     CHARACTER*(MAX_LEN_MBUF) msgBuf
53  #ifdef ECCO_VERBOSE  CEOP
       character*(MAX_LEN_MBUF) msgbuf  
 #endif  
   
 c     == end of interface ==  
   
       jtlo = mybylo(mythid)  
       jthi = mybyhi(mythid)  
       itlo = mybxlo(mythid)  
       ithi = mybxhi(mythid)  
54    
55        ifc = 30        ifc = 30
56    
# Line 72  c     == end of interface == Line 58  c     == end of interface ==
58        f_smrarea  = 0. _d 0        f_smrarea  = 0. _d 0
59        f_smrsst   = 0. _d 0        f_smrsst   = 0. _d 0
60        f_smrsss   = 0. _d 0        f_smrsss   = 0. _d 0
61  c  
62        no_ice     = 0. _d 0        no_ice     = 0. _d 0
63        no_smrarea = 0. _d 0        no_smrarea = 0. _d 0
64        no_smrsst  = 0. _d 0        no_smrsst  = 0. _d 0
65        no_smrsss  = 0. _d 0        no_smrsss  = 0. _d 0
66    
67  #ifdef ALLOW_SEAICE_COST_EXPORT  #ifdef ALLOW_SEAICE_COST_EXPORT
68        call seaice_cost_export( myThid )        CALL SEAICE_COST_EXPORT( myThid )
69  #endif  #endif
70    
71  c--   Sum up all contributions.  C--   Sum up all contributions.
72        do bj = jtlo,jthi        DO bj = myByLo(myThid), myByHi(myThid)
73          do bi = itlo,ithi         DO bi = myBxLo(myThid), myBxHi(myThid)
74    
75            fc = fc            tile_fc(bi,bj) = tile_fc(bi,bj)
76       &          + mult_ice_export * objf_ice_export(bi,bj)       &          + mult_ice_export * objf_ice_export(bi,bj)
77       &          + mult_ice        * objf_ice(bi,bj)       &          + mult_ice        * objf_ice(bi,bj)
78       &          + mult_smrarea    * objf_smrarea(bi,bj)       &          + mult_smrarea    * objf_smrarea(bi,bj)
79       &          + mult_smrsst     * objf_smrsst(bi,bj)       &          + mult_smrsst     * objf_smrsst(bi,bj)
80       &          + mult_smrsss     * objf_smrsss(bi,bj)       &          + mult_smrsss     * objf_smrsss(bi,bj)
81    
82            f_ice = f_ice + objf_ice(bi,bj)         ENDDO
83            f_smrarea = f_smrarea + objf_smrarea(bi,bj)        ENDDO
84            f_smrsst = f_smrsst + objf_smrsst(bi,bj)  
85            f_smrsss = f_smrsss + objf_smrsss(bi,bj)  C--   Note: global summation (tile_fc --> fc) is done only in cost_final
   
           no_ice = no_ice + num_ice(bi,bj)  
           no_smrarea = no_smrarea + num_smrarea(bi,bj)  
           no_smrsst = no_smrsst + num_smrsst(bi,bj)  
           no_smrsss = no_smrsss + num_smrsss(bi,bj)  
   
         enddo  
       enddo  
   
 c--   Do global summation.  
 cph this is done only in ecco_cost_final!  
 cph      _GLOBAL_SUM_RL( fc , myThid )  
   
 c--   Do global summation for each part of the cost function  
   
       _GLOBAL_SUM_RL( f_ice , myThid )  
       _GLOBAL_SUM_RL( f_smrarea , myThid )  
       _GLOBAL_SUM_RL( f_smrsst , myThid )  
       _GLOBAL_SUM_RL( f_smrsss , myThid )  
   
       _GLOBAL_SUM_RL( no_ice , myThid )  
       _GLOBAL_SUM_RL( no_smrarea , myThid )  
       _GLOBAL_SUM_RL( no_smrsst , myThid )  
       _GLOBAL_SUM_RL( no_smrsss , myThid )  
86    
87        write(standardmessageunit,'(A,D22.15)')  C--   Do global summation for each part of the cost function
88    
89          CALL GLOBAL_SUM_TILE_RL( objf_ice,     f_ice,     myThid )
90          CALL GLOBAL_SUM_TILE_RL( objf_smrarea, f_smrarea, myThid )
91          CALL GLOBAL_SUM_TILE_RL( objf_smrsst,  f_smrsst,  myThid )
92          CALL GLOBAL_SUM_TILE_RL( objf_smrsss,  f_smrsss,  myThid )
93    
94          CALL GLOBAL_SUM_TILE_RL( num_ice,     no_ice,     myThid )
95          CALL GLOBAL_SUM_TILE_RL( num_smrarea, no_smrarea, myThid )
96          CALL GLOBAL_SUM_TILE_RL( num_smrsst,  no_smrsst,  myThid )
97          CALL GLOBAL_SUM_TILE_RL( num_smrsss,  no_smrsss,  myThid )
98    
99          WRITE(standardMessageUnit,'(A,D22.15)')
100       &     ' --> f_ice     =',f_ice       &     ' --> f_ice     =',f_ice
101        write(standardmessageunit,'(A,D22.15)')        WRITE(standardMessageUnit,'(A,D22.15)')
102       &     ' --> f_smrarea =',f_smrarea       &     ' --> f_smrarea =',f_smrarea
103        write(standardmessageunit,'(A,D22.15)')        WRITE(standardMessageUnit,'(A,D22.15)')
104       &     ' --> f_smrarea =',f_smrsst       &     ' --> f_smrarea =',f_smrsst
105        write(standardmessageunit,'(A,D22.15)')        WRITE(standardMessageUnit,'(A,D22.15)')
106       &     ' --> f_smrarea =',f_smrsss       &     ' --> f_smrarea =',f_smrsss
107    
108  c--   Each process has calculated the global part for itself.  C--   Each process has calculated the global part for itself.
109        IF ( MASTER_CPU_THREAD(myThid) ) THEN        IF ( MASTER_CPU_THREAD(myThid) ) THEN
110    
111          write(cfname,'(A,i4.4)') 'costfunction_seaice',optimcycle          WRITE(cfname,'(A,i4.4)') 'costfunction_seaice',optimcycle
112          open(unit=ifc,file=cfname)          OPEN(unit=ifc,file=cfname)
113    
114          write(ifc,*) 'fc =', fc          WRITE(ifc,*) 'fc =', fc
115          write(ifc,*) 'f_ice   =', f_ice, no_ice          WRITE(ifc,*) 'f_ice   =', f_ice, no_ice
116          write(ifc,*) 'f_smrarea   =', f_smrarea, no_smrarea          WRITE(ifc,*) 'f_smrarea   =', f_smrarea, no_smrarea
117          write(ifc,*) 'f_smrsst    =', f_smrsst, no_smrsst          WRITE(ifc,*) 'f_smrsst    =', f_smrsst, no_smrsst
118          write(ifc,*) 'f_smrsss    =', f_smrsss, no_smrsss          WRITE(ifc,*) 'f_smrsss    =', f_smrsss, no_smrsss
119    
120          close(ifc)          CLOSE(ifc)
121    
122        ENDIF        ENDIF
123    
       SEAICE_dumpFreq = 0.  
       SEAICE_taveFreq = 0.  
   
124  #endif /* ALLOW_COST */  #endif /* ALLOW_COST */
125    
126        return        RETURN
127        end        END
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22