pkg/seaice/seaice_cost_final.F

869864d4b6 Patr*0001 #include "SEAICE_OPTIONS.h"
772b2ed80e Gael*0002 #ifdef ALLOW_COST
                0003 #include "COST_OPTIONS.h"
                0004 #endif
                0005 #ifdef ALLOW_CTRL
                0006 #include "CTRL_OPTIONS.h"
                0007 #endif
869864d4b6 Patr*0008
e4eb5b7d6f Jean*0009 CBOP
                0010 C     !ROUTINE: SEAICE_COST_FINAL
                0011 C     !INTERFACE:
69361556c2 Mart*0012       SUBROUTINE SEAICE_COST_FINAL( ifc, optimcycle, myThid )
869864d4b6 Patr*0013
e4eb5b7d6f Jean*0014 C     !DESCRIPTION:
                0015 C     *==========================================================*
                0016 C     | SUBROUTINE SEAICE_COST_FINAL
                0017 C     *==========================================================*
869864d4b6 Patr*0018
e4eb5b7d6f Jean*0019 C     !USES:
                0020       IMPLICIT NONE
869864d4b6 Patr*0021
e4eb5b7d6f Jean*0022 C     == global variables ==
869864d4b6 Patr*0023 #include "EEPARAMS.h"
                0024 #include "SIZE.h"
                0025 #include "PARAMS.h"
7303eab4f2 Patr*0026 #include "SEAICE_SIZE.h"
7ba6c40f2b Patr*0027 #include "SEAICE_PARAMS.h"
869864d4b6 Patr*0028 #include "SEAICE_COST.h"
772b2ed80e Gael*0029 #ifdef ALLOW_COST
                0030 # include "cost.h"
                0031 #endif
                0032 #ifdef ALLOW_CTRL
5cf4364659 Mart*0033 # include "CTRL_SIZE.h"
4d72283393 Mart*0034 # include "CTRL.h"
461bfd4bed Patr*0035 #endif
869864d4b6 Patr*0036
e4eb5b7d6f Jean*0037 C     !INPUT/OUTPUT PARAMETERS:
69361556c2 Mart*0038 C     ifc        :: file unit for costfunction_seaice.XXXX
                0039 C     optimcycle :: cycle number of the off-line optimization.
                0040 C     myThid     :: my Thread Id number
                0041       INTEGER ifc
                0042       INTEGER optimcycle
e4eb5b7d6f Jean*0043       INTEGER myThid
869864d4b6 Patr*0044
2b959ba38e Mart*0045 #if (defined ALLOW_COST && defined ALLOW_COST_ICE)
e4eb5b7d6f Jean*0046 C     !LOCAL VARIABLES:
                0047       INTEGER bi, bj
869864d4b6 Patr*0048       _RL f_ice
                0049       _RL no_ice
69361556c2 Mart*0050       CHARACTER*24 cfname
e4eb5b7d6f Jean*0051 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0052 CEOP
869864d4b6 Patr*0053
3ad0d94cb0 Patr*0054       f_ice      = 0. _d 0
                0055       no_ice     = 0. _d 0
869864d4b6 Patr*0056
1e22f5fc71 Patr*0057 #ifdef ALLOW_SEAICE_COST_EXPORT
e4eb5b7d6f Jean*0058       CALL SEAICE_COST_EXPORT( myThid )
1e22f5fc71 Patr*0059 #endif
                0060
e4eb5b7d6f Jean*0061 C--   Sum up all contributions.
                0062       DO bj = myByLo(myThid), myByHi(myThid)
                0063        DO bi = myBxLo(myThid), myBxHi(myThid)
7c7521a1da Jean*0064
e4eb5b7d6f Jean*0065           tile_fc(bi,bj) = tile_fc(bi,bj)
1e22f5fc71 Patr*0066      &          + mult_ice_export * objf_ice_export(bi,bj)
                0067      &          + mult_ice        * objf_ice(bi,bj)
869864d4b6 Patr*0068
e4eb5b7d6f Jean*0069        ENDDO
                0070       ENDDO
869864d4b6 Patr*0071
e4eb5b7d6f Jean*0072 C--   Note: global summation (tile_fc --> fc) is done only in cost_final
869864d4b6 Patr*0073
e4eb5b7d6f Jean*0074 C--   Do global summation for each part of the cost function
869864d4b6 Patr*0075
e4eb5b7d6f Jean*0076       CALL GLOBAL_SUM_TILE_RL( objf_ice,     f_ice,     myThid )
                0077       CALL GLOBAL_SUM_TILE_RL( num_ice,     no_ice,     myThid )
7c7521a1da Jean*0078
69361556c2 Mart*0079       WRITE(standardMessageUnit,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0080      &     ' --> f_ice     =',f_ice, no_ice, mult_ice
869864d4b6 Patr*0081
e4eb5b7d6f Jean*0082 C--   Each process has calculated the global part for itself.
69361556c2 Mart*0083       IF ( ifc .NE. -1 ) THEN
7c7521a1da Jean*0084
69361556c2 Mart*0085         WRITE(cfname,'(A,i4.4)') 'costfunction_seaice.',optimcycle
e4eb5b7d6f Jean*0086         OPEN(unit=ifc,file=cfname)
7c7521a1da Jean*0087
69361556c2 Mart*0088 C     makes little sense to print this now, because it is zero at this point
                0089 c       WRITE(ifc,*) 'fc =', fc
                0090         WRITE(ifc,'(A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0091      &       'f_ice   =', f_ice, no_ice, mult_ice
869864d4b6 Patr*0092
e4eb5b7d6f Jean*0093         CLOSE(ifc)
7c7521a1da Jean*0094
8716d94355 Dimi*0095       ENDIF
869864d4b6 Patr*0096
2b959ba38e Mart*0097 #endif /* ALLOW_COST and ALLOW_COST_ICE */
461bfd4bed Patr*0098
e4eb5b7d6f Jean*0099       RETURN
                0100       END