pkg/thsice/thsice_cost_final.F

6c747cb1b2 Patr*0001 #include "THSICE_OPTIONS.h"
                0002
e4eb5b7d6f Jean*0003 CBOP
                0004 C     !ROUTINE: THSICE_COST_FINAL
                0005 C     !INTERFACE:
69361556c2 Mart*0006       SUBROUTINE THSICE_COST_FINAL( ifc, optimcycle, myThid )
6c747cb1b2 Patr*0007
e4eb5b7d6f Jean*0008 C     !DESCRIPTION:
                0009 C     *==========================================================*
                0010 C     | SUBROUTINE THSICE_COST_FINAL
                0011 C     *==========================================================*
6c747cb1b2 Patr*0012
e4eb5b7d6f Jean*0013 C     !USES:
                0014       IMPLICIT NONE
6c747cb1b2 Patr*0015
e4eb5b7d6f Jean*0016 C     == global variables ==
6c747cb1b2 Patr*0017 #include "EEPARAMS.h"
                0018 #include "SIZE.h"
                0019 #include "PARAMS.h"
                0020 #include "DYNVARS.h"
                0021 #include "THSICE_PARAMS.h"
                0022 #ifdef ALLOW_COST
65754df434 Mart*0023 # include "THSICE_COST.h"
                0024 # include "cost.h"
6c747cb1b2 Patr*0025 #endif
                0026
e4eb5b7d6f Jean*0027 C     !INPUT/OUTPUT PARAMETERS:
69361556c2 Mart*0028 C     ifc        :: file unit for costfunction_thsice.XXXX
                0029 C     optimcycle :: cycle number of the off-line optimization.
                0030 C     myThid     :: my Thread Id number
                0031       INTEGER ifc
                0032       INTEGER optimcycle
e4eb5b7d6f Jean*0033       INTEGER myThid
6c747cb1b2 Patr*0034
                0035 #ifdef ALLOW_COST
e4eb5b7d6f Jean*0036 C     !LOCAL VARIABLES:
                0037       INTEGER bi,bj
6c747cb1b2 Patr*0038       _RL f_thsice
                0039       _RL no_thsice
69361556c2 Mart*0040 c     CHARACTER*24 cfname
e4eb5b7d6f Jean*0041 CEOP
6c747cb1b2 Patr*0042
e4eb5b7d6f Jean*0043 c     print *, 'ph-2 in thsice_cost_final'
6c747cb1b2 Patr*0044
                0045       f_thsice      = 0. _d 0
                0046       no_thsice     = 0. _d 0
                0047
e4eb5b7d6f Jean*0048 C--   Sum up all contributions.
                0049       DO bj = myByLo(myThid), myByHi(myThid)
                0050        DO bi = myBxLo(myThid), myBxHi(myThid)
6c747cb1b2 Patr*0051
e4eb5b7d6f Jean*0052           tile_fc(bi,bj) = tile_fc(bi,bj)
6c747cb1b2 Patr*0053      &          + mult_thsice        * objf_thsice(bi,bj)
                0054
                0055           f_thsice = f_thsice + objf_thsice(bi,bj)
                0056
e4eb5b7d6f Jean*0057        ENDDO
                0058       ENDDO
6c747cb1b2 Patr*0059
e4eb5b7d6f Jean*0060 C--   Do global summation for each part of the cost function
                0061 c     CALL GLOBAL_SUM_TILE_RL( objf_thsice, f_thsice, myThid )
                0062 c     CALL GLOBAL_SUM_TILE_RL( num_thsice, no_thsice, myThid )
6c747cb1b2 Patr*0063
69361556c2 Mart*0064       WRITE(standardMessageUnit,'(A,1PE22.14)')
6c747cb1b2 Patr*0065      &     ' --> f_thsice     = ', f_thsice
                0066
69361556c2 Mart*0067 c     IF ( ifc .NE. -1 ) THEN
                0068 c       WRITE(cfname,'(A,i4.4)') 'costfunction_thsice.',optimcycle
                0069 c       OPEN(unit=ifc,file=cfname)
                0070 c       WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0071 c    &       'f_thsice =', f_thsice, no_thsice, mult_thsice
                0072 c       CLOSE(ifc)
                0073 c     ENDIF
                0074
6c747cb1b2 Patr*0075 #endif /* ALLOW_COST */
                0076
e4eb5b7d6f Jean*0077       RETURN
                0078       END