pkg/ecco/ecco_cost_final.F

8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
6805a315c1 Gael*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
5001c65f45 Patr*0005
69361556c2 Mart*0006       SUBROUTINE ECCO_COST_FINAL( ifc, optimcycle, myThid )
5001c65f45 Patr*0007
                0008 c     ==================================================================
c9dc83bee0 Patr*0009 c     SUBROUTINE cost_final
5001c65f45 Patr*0010 c     ==================================================================
                0011 c
                0012 c     o Sum of all cost function contributions.
                0013 c
                0014 c     ==================================================================
c9dc83bee0 Patr*0015 c     SUBROUTINE cost_final
5001c65f45 Patr*0016 c     ==================================================================
                0017
9f85ea262e Mart*0018       IMPLICIT NONE
5001c65f45 Patr*0019
                0020 c     == global variables ==
                0021
                0022 #include "EEPARAMS.h"
                0023 #include "SIZE.h"
55d9759e14 Patr*0024 #include "PARAMS.h"
5001c65f45 Patr*0025
960ed3a8f0 Gael*0026 #ifdef ALLOW_COST
                0027 # include "cost.h"
                0028 #endif
49484c0542 Gael*0029 #ifdef ALLOW_ECCO
cf705a6c8e Mart*0030 # include "ECCO_SIZE.h"
                0031 # include "ECCO.h"
49484c0542 Gael*0032 #endif
5001c65f45 Patr*0033
                0034 c     == routine arguments ==
                0035
69361556c2 Mart*0036 C     ifc        :: file unit for costfunction_ecco.XXXX
                0037 C     optimcycle :: cycle number of the off-line optimization (same as eccoiter)
                0038 C     myThid     :: my Thread Id number
                0039       INTEGER ifc
                0040       INTEGER optimcycle
9f85ea262e Mart*0041       INTEGER myThid
5001c65f45 Patr*0042
69361556c2 Mart*0043 #ifdef ALLOW_COST
8716d94355 Dimi*0044 C     === Functions ====
9f5240b52a Jean*0045       INTEGER  ILNBLNK
                0046       EXTERNAL ILNBLNK
8716d94355 Dimi*0047
5001c65f45 Patr*0048 c     == local variables ==
                0049
9f85ea262e Mart*0050       INTEGER bi,bj
                0051       INTEGER num_var
5001c65f45 Patr*0052
69361556c2 Mart*0053 #ifdef ECCO_VERBOSE
b16dd4be7d Gael*0054       _RL locfc
c1d030d006 Gael*0055 #endif
69361556c2 Mart*0056 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0057       _RL f_gencost(NGENCOST)
b0f9ab3790 Gael*0058       _RL no_gencost(NGENCOST)
6b47d550f4 Mart*0059 #endif
6a770e0a24 Patr*0060       INTEGER IL
69361556c2 Mart*0061       CHARACTER*23 cfname
                0062       CHARACTER*(MAX_LEN_MBUF) msgBuf
6a770e0a24 Patr*0063
5001c65f45 Patr*0064 c     == end of interface ==
                0065
df3aa3e753 Gael*0066 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0067       DO num_var=1,NGENCOST
69361556c2 Mart*0068        f_gencost(num_var) = 0. _d 0
9f85ea262e Mart*0069        no_gencost(num_var)= 0. _d 0
                0070       ENDDO
69a6648502 Patr*0071
5001c65f45 Patr*0072 c--   Sum up all contributions.
9f5240b52a Jean*0073       DO bj = myByLo(myThid), myByHi(myThid)
                0074        DO bi = myBxLo(myThid), myBxHi(myThid)
951926fb9b Jean*0075
9f85ea262e Mart*0076         DO num_var=1,NGENCOST
                0077          tile_fc(bi,bj) = tile_fc(bi,bj)
df3aa3e753 Gael*0078      &            + mult_gencost(num_var)
8c157ed454 Patr*0079      &            *objf_gencost(bi,bj,num_var)
9f85ea262e Mart*0080          f_gencost(num_var)=f_gencost(num_var)
8c157ed454 Patr*0081      &            +objf_gencost(bi,bj,num_var)
9f85ea262e Mart*0082          no_gencost(num_var)=no_gencost(num_var)
8c157ed454 Patr*0083      &            +num_gencost(bi,bj,num_var)
9f85ea262e Mart*0084         ENDDO
69a6648502 Patr*0085
9f5240b52a Jean*0086 C-   end bi,bj loops
                0087        ENDDO
                0088       ENDDO
5001c65f45 Patr*0089
                0090 c--   Do global summation for each part of the cost function
9f85ea262e Mart*0091       DO num_var=1,NGENCOST
                0092        _GLOBAL_SUM_RL(f_gencost(num_var), myThid )
                0093        _GLOBAL_SUM_RL(no_gencost(num_var), myThid )
                0094       ENDDO
69a6648502 Patr*0095
69361556c2 Mart*0096 C     start printing to STDOUT
9f85ea262e Mart*0097       DO num_var=1,NGENCOST
                0098        IF (no_gencost(num_var).GT.0) THEN
69361556c2 Mart*0099         IL  = ILNBLNK( gencost_name(num_var) )
                0100         WRITE(msgBuf,'(A,1PE22.14,I3,1X,1PE9.2,3A)')
                0101      &     ' --> f_gencost  =', f_gencost(num_var), num_var,
                0102      &     mult_gencost(num_var),
                0103      &     ' (', gencost_name(num_var)(1:IL), ')'
9f85ea262e Mart*0104         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0105      &                      SQUEEZE_RIGHT, myThid )
                0106        ENDIF
                0107       ENDDO
951926fb9b Jean*0108 #endif
ad59256d7d aver*0109
69361556c2 Mart*0110 C     only master thread of master CPU open and write to file with file unit > 0
                0111       IF ( ifc .NE. -1 ) THEN
b16dd4be7d Gael*0112
69361556c2 Mart*0113 C     For consistency we use variable optimcycle rather than eccoiter,
                0114 C     but they have the same value.
                0115 C       WRITE(cfname,'(A,i4.4)') 'costfunction_ecco.',eccoiter
                0116         WRITE(cfname,'(A,i4.4)') 'costfunction_ecco.',optimcycle
9f85ea262e Mart*0117         WRITE(msgBuf,'(A,A)')
69361556c2 Mart*0118      &           'Writing ecco cost function info to ', cfname
9f85ea262e Mart*0119         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
69361556c2 Mart*0120      &                     SQUEEZE_RIGHT, myThid )
                0121         OPEN(unit=ifc,file=cfname)
951926fb9b Jean*0122
df3aa3e753 Gael*0123 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f85ea262e Mart*0124         DO num_var=1,NGENCOST
                0125          IF (no_gencost(num_var).GT.0) THEN
                0126           IL  = ILNBLNK( gencost_name(num_var) )
                0127           IL  = max (IL,15)
69361556c2 Mart*0128           WRITE(ifc,'(2A,I3.0,A,1PE22.14,1PE22.14,1X,1PE9.2)')
1fa8e77fb9 Gael*0129      &    gencost_name(num_var)(1:IL),' (gencost ', num_var, ') = ',
df3aa3e753 Gael*0130      &    f_gencost(num_var),
69361556c2 Mart*0131      &    no_gencost(num_var), mult_gencost(num_var)
9f85ea262e Mart*0132          ENDIF
                0133         ENDDO
c1d030d006 Gael*0134 #endif
                0135
ad59256d7d aver*0136         CLOSE(ifc)
951926fb9b Jean*0137
69361556c2 Mart*0138       ELSE
                0139         WRITE(msgBuf,'(A)') ' skip writing to costfunction_ecco.XXXX'
9f85ea262e Mart*0140         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0141      &                      SQUEEZE_RIGHT, myThid )
ad59256d7d aver*0142
69361556c2 Mart*0143 C     ifc .ne. -1
8716d94355 Dimi*0144       ENDIF
5001c65f45 Patr*0145
                0146 #ifdef ECCO_VERBOSE
69361556c2 Mart*0147 c local copy used in print statements, for
                0148 c which we always want to do the global sum.
                0149       locfc = 0. _d 0
                0150       CALL GLOBAL_SUM_TILE_RL( tile_fc, locfc, myThid )
                0151
                0152       WRITE(msgBuf,'(a,1PE22.14)')
                0153      &  ' cost_Final: ecco cost function = ',locfc
9f85ea262e Mart*0154       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0155      &                    SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0156       WRITE(msgBuf,'(a)') ' '
                0157       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0158      &                    SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0159       WRITE(msgBuf,'(a)')
5001c65f45 Patr*0160      &  '             cost function evaluation finished.'
9f85ea262e Mart*0161       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0162      &                    SQUEEZE_RIGHT, myThid )
9f85ea262e Mart*0163       WRITE(msgBuf,'(a)') ' '
                0164       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
9f5240b52a Jean*0165      &                    SQUEEZE_RIGHT, myThid )
5001c65f45 Patr*0166 #endif
                0167
69361556c2 Mart*0168 #endif /*  ALLOW_COST */
                0169
9f85ea262e Mart*0170       RETURN
                0171       END