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:
                0012       SUBROUTINE SEAICE_COST_FINAL( 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"
65754df434 Mart*0035 # include "OPTIMCYCLE.h"
461bfd4bed Patr*0036 #endif
869864d4b6 Patr*0037
e4eb5b7d6f Jean*0038 C     !INPUT/OUTPUT PARAMETERS:
                0039       INTEGER myThid
869864d4b6 Patr*0040
2b959ba38e Mart*0041 #if (defined ALLOW_COST && defined ALLOW_COST_ICE)
e4eb5b7d6f Jean*0042 C     ! FUNCTIONS:
8716d94355 Dimi*0043       LOGICAL  MASTER_CPU_THREAD
                0044       EXTERNAL MASTER_CPU_THREAD
                0045
e4eb5b7d6f Jean*0046 C     !LOCAL VARIABLES:
                0047       INTEGER bi, bj
                0048       INTEGER ifc
869864d4b6 Patr*0049       _RL f_ice
                0050       _RL no_ice
e4eb5b7d6f Jean*0051       CHARACTER*23 cfname
                0052 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0053 CEOP
869864d4b6 Patr*0054
                0055       ifc = 30
7c7521a1da Jean*0056
3ad0d94cb0 Patr*0057       f_ice      = 0. _d 0
                0058       no_ice     = 0. _d 0
869864d4b6 Patr*0059
1e22f5fc71 Patr*0060 #ifdef ALLOW_SEAICE_COST_EXPORT
e4eb5b7d6f Jean*0061       CALL SEAICE_COST_EXPORT( myThid )
1e22f5fc71 Patr*0062 #endif
                0063
e4eb5b7d6f Jean*0064 C--   Sum up all contributions.
                0065       DO bj = myByLo(myThid), myByHi(myThid)
                0066        DO bi = myBxLo(myThid), myBxHi(myThid)
7c7521a1da Jean*0067
e4eb5b7d6f Jean*0068           tile_fc(bi,bj) = tile_fc(bi,bj)
1e22f5fc71 Patr*0069      &          + mult_ice_export * objf_ice_export(bi,bj)
                0070      &          + mult_ice        * objf_ice(bi,bj)
869864d4b6 Patr*0071
e4eb5b7d6f Jean*0072        ENDDO
                0073       ENDDO
869864d4b6 Patr*0074
e4eb5b7d6f Jean*0075 C--   Note: global summation (tile_fc --> fc) is done only in cost_final
869864d4b6 Patr*0076
e4eb5b7d6f Jean*0077 C--   Do global summation for each part of the cost function
869864d4b6 Patr*0078
e4eb5b7d6f Jean*0079       CALL GLOBAL_SUM_TILE_RL( objf_ice,     f_ice,     myThid )
                0080       CALL GLOBAL_SUM_TILE_RL( num_ice,     no_ice,     myThid )
7c7521a1da Jean*0081
e4eb5b7d6f Jean*0082       WRITE(standardMessageUnit,'(A,D22.15)')
869864d4b6 Patr*0083      &     ' --> f_ice     =',f_ice
                0084
e4eb5b7d6f Jean*0085 C--   Each process has calculated the global part for itself.
8716d94355 Dimi*0086       IF ( MASTER_CPU_THREAD(myThid) ) THEN
7c7521a1da Jean*0087
e4eb5b7d6f Jean*0088         WRITE(cfname,'(A,i4.4)') 'costfunction_seaice',optimcycle
                0089         OPEN(unit=ifc,file=cfname)
7c7521a1da Jean*0090
e4eb5b7d6f Jean*0091         WRITE(ifc,*) 'fc =', fc
                0092         WRITE(ifc,*) 'f_ice   =', f_ice, no_ice
869864d4b6 Patr*0093
e4eb5b7d6f Jean*0094         CLOSE(ifc)
7c7521a1da Jean*0095
8716d94355 Dimi*0096       ENDIF
869864d4b6 Patr*0097
2b959ba38e Mart*0098 #endif /* ALLOW_COST and ALLOW_COST_ICE */
461bfd4bed Patr*0099
e4eb5b7d6f Jean*0100       RETURN
                0101       END