pkg/obcs/obcs_cost_final.F

69361556c2 Mart*0001 #include "OBCS_OPTIONS.h"
                0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
                0005 c#ifdef ALLOW_COST
                0006 c# include "COST_OPTIONS.h"
                0007 c#endif
                0008
                0009 CBOP
                0010 C !ROUTINE: OBCS_COST_FINAL
                0011
                0012 C !INTERFACE: ==========================================================
                0013       SUBROUTINE OBCS_COST_FINAL( ifc, optimcycle, myThid )
                0014
                0015 C !DESCRIPTION:
                0016 C     Compute cost function contribution (Tikhonov regularisation)
                0017 C     of pkg/obcs and print to STDOUT and costfunction_obcs-file.
                0018
                0019 C !USES: ===============================================================
                0020       IMPLICIT NONE
                0021 C     == Global variables ==
                0022 #include "EEPARAMS.h"
                0023 #include "SIZE.h"
                0024 #ifdef ALLOW_COST
                0025 # include "cost.h"
                0026 #endif
                0027 #ifdef ALLOW_CTRL
                0028 # include "CTRL_OBCS.h"
                0029 #endif
                0030
                0031 C !INPUT PARAMETERS: ===================================================
                0032 C     ifc        :: file unit for costfunction_obcs.XXXX
                0033 C     optimcycle :: cycle number of the off-line optimization.
                0034 C     myThid     :: my Thread Id number
                0035       INTEGER ifc
                0036       INTEGER optimcycle
                0037       INTEGER myThid
                0038
                0039 #if defined ALLOW_COST && defined ALLOW_CTRL
                0040 C    defined ALLOW_OBCS_CONTROL
                0041 C    defined ALLOW_OBCS_COST_CONTRIBUTION
                0042
                0043 C !LOCAL VARIABLES: ====================================================
                0044       INTEGER bi, bj
                0045       _RL f_obcsN, f_obcsS, f_obcsE, f_obcsW, f_ageos
                0046       _RL no_obcsN, no_obcsS, no_obcsE, no_obcsW, no_ageos
                0047
                0048       CHARACTER*23 cfname
                0049       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0050 CEOP
                0051
                0052       IF ( useObcsCostContribution ) THEN
                0053        f_obcsN  = 0. _d 0
                0054        f_obcsS  = 0. _d 0
                0055        f_obcsE  = 0. _d 0
                0056        f_obcsW  = 0. _d 0
                0057        f_ageos  = 0. _d 0
                0058        no_obcsN = 0. _d 0
                0059        no_obcsS = 0. _d 0
                0060        no_obcsE = 0. _d 0
                0061        no_obcsW = 0. _d 0
                0062        no_ageos = 0. _d 0
                0063
                0064 c--   Sum up all contributions.
                0065        DO bj = myByLo(myThid), myByHi(myThid)
                0066         DO bi = myBxLo(myThid), myBxHi(myThid)
                0067
                0068          tile_fc(bi,bj) = tile_fc(bi,bj)
                0069      &        + mult_obcsN   * objf_obcsN(bi,bj)
                0070      &        + mult_obcsS   * objf_obcsS(bi,bj)
                0071      &        + mult_obcsE   * objf_obcsE(bi,bj)
                0072      &        + mult_obcsW   * objf_obcsW(bi,bj)
                0073 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0074      &        + mult_ageos   * objf_ageos(bi,bj)
                0075 # endif
                0076          f_obcsN  = f_obcsN + objf_obcsN(bi,bj)
                0077          f_obcsS  = f_obcsS + objf_obcsS(bi,bj)
                0078          f_obcsE  = f_obcsE + objf_obcsE(bi,bj)
                0079          f_obcsW  = f_obcsW + objf_obcsW(bi,bj)
                0080          no_obcsN = no_obcsN + num_obcsN(bi,bj)
                0081          no_obcsS = no_obcsS + num_obcsS(bi,bj)
                0082          no_obcsE = no_obcsE + num_obcsE(bi,bj)
                0083          no_obcsW = no_obcsW + num_obcsW(bi,bj)
                0084 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0085          f_ageos  = f_ageos + objf_ageos(bi,bj)
                0086          no_ageos = no_ageos + num_ageos(bi,bj)
                0087 # endif
                0088         ENDDO
                0089        ENDDO
                0090
                0091        _GLOBAL_SUM_RL( f_obcsN , myThid )
                0092        _GLOBAL_SUM_RL( f_obcsS , myThid )
                0093        _GLOBAL_SUM_RL( f_obcsE , myThid )
                0094        _GLOBAL_SUM_RL( f_obcsW , myThid )
                0095        _GLOBAL_SUM_RL( no_obcsN, myThid )
                0096        _GLOBAL_SUM_RL( no_obcsS, myThid )
                0097        _GLOBAL_SUM_RL( no_obcsE, myThid )
                0098        _GLOBAL_SUM_RL( no_obcsW, myThid )
                0099 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0100        _GLOBAL_SUM_RL( f_ageos , myThid )
                0101        _GLOBAL_SUM_RL( no_ageos, myThid )
                0102 # endif
                0103
                0104 C     start printing to STDOUT
                0105        WRITE(msgBuf,'(A,1PE22.14,1X,1PE9.2)')
                0106      &      ' --> f_obcsN    =', f_obcsN, mult_obcsN
                0107        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0108      &                     SQUEEZE_RIGHT, myThid )
                0109        WRITE(msgBuf,'(A,1PE22.14,1X,1PE9.2)')
                0110      &      ' --> f_obcsS    =', f_obcsS, mult_obcsS
                0111        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0112      &                     SQUEEZE_RIGHT, myThid )
                0113        WRITE(msgBuf,'(A,1PE22.14,1X,1PE9.2)')
                0114      &      ' --> f_obcsE    =', f_obcsE, mult_obcsE
                0115        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0116      &                     SQUEEZE_RIGHT, myThid )
                0117        WRITE(msgBuf,'(A,1PE22.14,1X,1PE9.2)')
                0118      &      ' --> f_obcsW    =', f_obcsW, mult_obcsW
                0119        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0120      &                     SQUEEZE_RIGHT, myThid )
                0121 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0122        WRITE(msgBuf,'(A,1PE22.14,1X,1PE9.2)')
                0123      &      ' --> f_ageos    =', f_ageos, mult_ageos
                0124        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0125      &                     SQUEEZE_RIGHT, myThid )
                0126 # endif
                0127
                0128 C     write contributions to costfunction file
                0129
                0130 C--   Each process has calculated the global part for itself.
                0131        IF ( ifc .NE. -1 ) THEN
                0132         WRITE(cfname,'(A,I4.4)') 'costfunction_obcs.',optimcycle
                0133         OPEN(unit=ifc,file=cfname)
                0134         WRITE(msgBuf,'(A,A)')
                0135      &       'Writing obcs ctrl cost function info to ', cfname
                0136         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0137      &                      SQUEEZE_RIGHT, myThid )
                0138
                0139         WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0140      &       'f_obcsN =', f_obcsN, no_obcsN, mult_obcsN
                0141         WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0142      &       'f_obcsS =', f_obcsS, no_obcsS, mult_obcsS
                0143         WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0144      &       'f_obcsE =', f_obcsE, no_obcsE, mult_obcsE
                0145         WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0146      &       'f_obcsW =', f_obcsW, no_obcsW, mult_obcsW
                0147 # ifdef OBCS_AGEOS_COST_CONTRIBUTION
                0148         WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0149      &       'f_ageos =', f_ageos, no_ageos, mult_ageos
                0150 # endif
                0151         CLOSE(ifc)
                0152        ENDIF
                0153
                0154 C     useObcsCostContribution
                0155       ENDIF
                0156 #endif /* ALLOW_COST etc */
                0157
                0158       RETURN
                0159       END