pkg/profiles/profiles_cost_final.F

69361556c2 Mart*0001 #include "PROFILES_OPTIONS.h"
                0002 #ifdef ALLOW_COST
                0003 #include "COST_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
                0007 C     !ROUTINE: PROFILES_COST_FINAL
                0008 C     !INTERFACE:
                0009       SUBROUTINE PROFILES_COST_FINAL( ifc, optimcycle, myThid )
                0010
                0011 C     !DESCRIPTION:
                0012 C     *==========================================================*
                0013 C     | SUBROUTINE PROFILES_COST_FINAL
                0014 C     *==========================================================*
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018
                0019 C     == global variables ==
                0020 #include "EEPARAMS.h"
                0021 #include "SIZE.h"
                0022 #include "PARAMS.h"
                0023 #ifdef ALLOW_COST
                0024 # include "cost.h"
                0025 #endif
                0026 #include "PROFILES_SIZE.h"
                0027 #include "profiles.h"
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     ifc        :: file unit for costfunction_profiles.XXXX
                0031 C     optimcycle :: cycle number of the off-line optimization.
                0032 C     myThid     :: my Thread Id number
                0033       INTEGER ifc
                0034       INTEGER optimcycle
                0035       INTEGER myThid
                0036
                0037 #ifdef ALLOW_COST
                0038 C     ! FUNCTIONS:
                0039       INTEGER  ILNBLNK
                0040       EXTERNAL ILNBLNK
                0041
                0042 C     !LOCAL VARIABLES:
                0043       INTEGER bi, bj, num_var
                0044       INTEGER num_file
                0045       _RL f_profiles(NFILESPROFMAX,NVARMAX)
                0046       _RL f_profiles_mean(NVARMAX)
                0047       _RL no_profiles(NFILESPROFMAX,NVARMAX)
                0048       _RL no_profiles_mean(NVARMAX)
                0049
                0050       CHARACTER*26 cfname
                0051       INTEGER IL
                0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0053 CEOP
                0054
                0055 C     Initialise cost function variables zo zero
                0056       DO num_var=1,NVARMAX
                0057        DO num_file=1,NFILESPROFMAX
                0058         f_profiles(num_file,num_var)= 0. _d 0
                0059         no_profiles(num_file,num_var)= 0. _d 0
                0060        ENDDO
                0061        f_profiles_mean(num_var)= 0. _d 0
                0062        no_profiles_mean(num_var)= 0. _d 0
                0063       ENDDO
                0064
                0065 c--   Sum up all contributions.
                0066       DO bj = myByLo(myThid), myByHi(myThid)
                0067        DO bi = myBxLo(myThid), myBxHi(myThid)
                0068
                0069         DO num_var=1,NVARMAX
                0070          DO num_file=1,NFILESPROFMAX
                0071           tile_fc(bi,bj) = tile_fc(bi,bj)
                0072      &            + mult_profiles(num_file,num_var)
                0073      &            *objf_profiles(num_file,num_var,bi,bj)
                0074           f_profiles(num_file,num_var)=f_profiles(num_file,num_var)
                0075      &            +objf_profiles(num_file,num_var,bi,bj)
                0076           no_profiles(num_file,num_var)=no_profiles(num_file,num_var)
                0077      &            +num_profiles(num_file,num_var,bi,bj)
                0078          ENDDO
                0079          tile_fc(bi,bj) = tile_fc(bi,bj)
                0080      &           + mult_profiles_mean(num_var)
                0081      &           *objf_profiles_mean(num_var,bi,bj)
                0082          f_profiles_mean(num_var)=f_profiles_mean(num_var)
                0083      &           +objf_profiles_mean(num_var,bi,bj)
                0084          no_profiles_mean(num_var)=no_profiles_mean(num_var)
                0085      &           +num_profiles_mean(num_var,bi,bj)
                0086         ENDDO
                0087
                0088 C-   end bi,bj loops
                0089        ENDDO
                0090       ENDDO
                0091
                0092 c--   Do global summation for each part of the cost function
                0093       DO num_var=1,NVARMAX
                0094        DO num_file=1,NFILESPROFMAX
                0095         _GLOBAL_SUM_RL(f_profiles(num_file,num_var), myThid )
                0096         _GLOBAL_SUM_RL(no_profiles(num_file,num_var), myThid )
                0097        ENDDO
                0098        _GLOBAL_SUM_RL(f_profiles_mean(num_var), myThid )
                0099        _GLOBAL_SUM_RL(no_profiles_mean(num_var), myThid )
                0100       ENDDO
                0101
                0102 C     start printing to STDOUT
                0103       DO num_file=1,NFILESPROFMAX
                0104        DO num_var=1,NVARMAX
                0105         IF ( no_profiles(num_file,num_var).GT.zeroRL ) THEN
                0106          WRITE(msgBuf,'(A,1PE22.14,2I3,1X,1PE9.2)')
                0107      &     ' --> f_profiles =',f_profiles(num_file,num_var),
                0108      &      num_file, num_var, mult_profiles(num_file,num_var)
                0109
                0110          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0111      &                       SQUEEZE_RIGHT, myThid )
                0112         ENDIF
                0113        ENDDO
                0114       ENDDO
                0115       DO num_var=1,NVARMAX
                0116        IF ( no_profiles_mean(num_var).GT.zeroRL ) THEN
                0117         WRITE(msgBuf,'(A,1PE22.14,I3,1X,1PE9.2)')
                0118      &     ' --> f_profiles_mean =',f_profiles_mean(num_var),
                0119      &      num_var, mult_profiles_mean(num_var)
                0120
                0121         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0122      &                      SQUEEZE_RIGHT, myThid )
                0123        ENDIF
                0124       ENDDO
                0125
                0126 c--   Each process has calculated the global part for itself.
                0127
                0128 C     only master thread of master CPU open and write to file
                0129       IF ( ifc .NE. -1 ) THEN
                0130
                0131        WRITE(cfname,'(A,I4.4)') 'costfunction_profiles.',optimcycle
                0132        OPEN(unit=ifc,file=cfname)
                0133        WRITE(msgBuf,'(A,A)')
                0134      &      'Writing profiles cost function info to ', cfname
                0135        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0136      &                     SQUEEZE_RIGHT, myThid )
                0137
                0138        DO num_file=1,NFILESPROFMAX
                0139         DO num_var=1,NVARMAX
                0140          IF ( no_profiles(num_file,num_var).GT.zeroRL ) THEN
                0141           IL = ILNBLNK( profilesfiles(num_file) )
                0142           IL = MAX(IL,30)
                0143           WRITE(ifc,'(4A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0144      &         profilesfiles(num_file)(1:IL),' ',
                0145      &         prof_names(num_file,num_var), ' = ',
                0146      &         f_profiles(num_file,num_var),
                0147      &         no_profiles(num_file,num_var),
                0148      &         mult_profiles(num_file,num_var)
                0149          ENDIF
                0150         ENDDO
                0151        ENDDO
                0152        DO num_var=1,NVARMAX
                0153         IF ( no_profiles_mean(num_var).GT.zeroRL ) THEN
                0154          WRITE(ifc,'(3A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0155      &        'profile_mean ', prof_names(1,num_var), ' = ',
                0156      &        f_profiles_mean(num_var), no_profiles_mean(num_var),
                0157      &        mult_profiles_mean(num_var)
                0158         ENDIF
                0159        ENDDO
                0160        CLOSE(ifc)
                0161
                0162       ENDIF
                0163
                0164 #endif /* ALLOW_COST */
                0165
                0166       RETURN
                0167       END