pkg/obsfit/obsfit_cost_final.F

69361556c2 Mart*0001 #include "OBSFIT_OPTIONS.h"
                0002 #ifdef ALLOW_COST
                0003 #include "COST_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
                0007 C     !ROUTINE: OBSFIT_COST_FINAL
                0008 C     !INTERFACE:
                0009       SUBROUTINE OBSFIT_COST_FINAL( ifc, optimcycle, myThid )
                0010
                0011 C     !DESCRIPTION:
                0012 C     *==========================================================*
                0013 C     | SUBROUTINE OBSFIT_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 "OBSFIT_SIZE.h"
                0027 #include "OBSFIT.h"
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     ifc        :: file unit for costfunction_obsfit.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 num_file_obs
                0044       _RL f_obsfit(NFILESMAX_OBS)
                0045       _RL no_obsfit(NFILESMAX_OBS)
                0046
                0047       CHARACTER*24 cfname
                0048       INTEGER IL
                0049       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0050 CEOP
                0051
                0052 c--   Each process has calculated the global part for itself.
                0053       DO num_file_obs=1,NFILESMAX_OBS
                0054         glofc = glofc + mult_obsfit(num_file_obs)
                0055      &                 *objf_obsfit(num_file_obs)
                0056       ENDDO
                0057
                0058 C     This is just a copy since obsfit does not have the tile logic of
                0059 C     other part of the code
                0060       DO num_file_obs=1,NFILESMAX_OBS
                0061        f_obsfit(num_file_obs) = objf_obsfit(num_file_obs)
                0062        no_obsfit(num_file_obs) = num_obsfit(num_file_obs)
                0063       ENDDO
                0064
                0065 CML I do not understand, why we do not need this or something like this here
                0066 CMLc--   Do global summation for each part of the cost function
                0067 CML      DO num_var=1,NVARMAX
                0068 CML       DO num_file=1,NFILESPROFMAX
                0069 CML        _GLOBAL_SUM_RL(f_obsfit(num_file_obs), myThid )
                0070 CML        _GLOBAL_SUM_RL(no_obsfit(num_file_obs), myThid )
                0071 CML       ENDDO
                0072 CML      ENDDO
                0073
                0074 C     start printing to STDOUT
                0075       DO num_file_obs=1,NFILESMAX_OBS
                0076        IF ( no_obsfit(num_file_obs).GT.zeroRL ) THEN
                0077         WRITE(msgBuf,'(A,1PE22.14,I2,1X,1PE9.2)')
                0078      &       ' --> f_obsfit =', f_obsfit(num_file_obs), num_file_obs,
                0079      &       mult_obsfit(num_file_obs)
                0080         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0081      &                      SQUEEZE_RIGHT, myThid )
                0082        ENDIF
                0083       ENDDO
                0084
                0085 c--   Each process has calculated the global part for itself.
                0086
                0087 C     only master thread of master CPU open and write to file
                0088       IF ( ifc .NE. -1 ) THEN
                0089
                0090        WRITE(cfname,'(A,I4.4)') 'costfunction_obsfit.',optimcycle
                0091        OPEN(unit=ifc,file=cfname)
                0092        WRITE(msgBuf,'(A,A)')
                0093      &      'Writing obsfit cost function info to ', cfname
                0094        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0095      &                     SQUEEZE_RIGHT, myThid )
                0096
                0097        DO num_file_obs=1,NFILESMAX_OBS
                0098         IF ( no_obsfit(num_file_obs).GT.zeroRL ) THEN
                0099          IL = ILNBLNK( obsfitfiles(num_file_obs) )
                0100          IL = MAX(IL,30)
                0101          WRITE(ifc,'(4A,1PE22.14,1PE22.14,1X,1PE9.2)')
                0102      &        obsfitfiles(num_file_obs)(1:IL), ' ', obsfit_nameval,
                0103      &        ' = ', f_obsfit(num_file_obs), no_obsfit(num_file_obs),
                0104      &        mult_obsfit(num_file_obs)
                0105         ENDIF
                0106        ENDDO
                0107        CLOSE(ifc)
                0108
                0109       ENDIF
                0110
                0111 #endif /* ALLOW_COST */
                0112
                0113       RETURN
                0114       END