SUBROUTINE OBSCOR_SUMUP_SCALP


!**** *OBSCOR_SUMUP_SCALP*- Routine to compute scalar-product for
!      observation error correlation in a reproducible manner
!      G. RADNOTI   ECMWF     07/03/2006


!**   INTERFACE
!     ---------
!     *CALL* * OBSCOR_SUMUP_SCALP*
USE PARKIND1 ,ONLY : JPIM, JPRB
USE YOMCOSJO, ONLY : OBSCOR_AUX, OBSCOR_SCALPR, NBCORBLK,NRITZ_OBSCOR,DEALLOCATE_OBSCOR_AUX, LOBSCORDIAG
USE YOMOBSET , ONLY : NSETOT
USE YOMCT0   , ONLY : NPROC
USE YOMVAR   , ONLY : LREPRO4DVAR, NSIM4D
USE MPL_MODULE, ONLY : MPL_ALLREDUCE,  MPL_ALLGATHERV
USE ECSORT_MIX   , ONLY : KEYSORT
USE YOMLUN       , ONLY : NULOUT
USE ORDER_INDEPENDENT_SUMMATION_MOD, ONLY : ORDER_INDEP_GLOBAL_SUM
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
IMPLICIT NONE
INTEGER(KIND=JPIM) :: JSET,JEV,JBLK,IACTSUM,IACTSET,ILENGL,IOFF,IRET
INTEGER(KIND=JPIM) :: IRECVCOUNTS(NPROC)
REAL(KIND=JPRB), ALLOCATABLE :: ZPROD(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZRECVGL(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZSUM_NONREPROD_LOCAL(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL  :: LL_USE_ORDER_INDEP_GLOBAL_SUM, LLREPRO

IF (LHOOK) CALL DR_HOOK('OBSCOR_SUMUP_SCALP',0,ZHOOK_HANDLE)
LL_USE_ORDER_INDEP_GLOBAL_SUM=.TRUE.
LLREPRO=LREPRO4DVAR
IF (NBCORBLK == 0) THEN
  IF (LHOOK) CALL DR_HOOK('OBSCOR_SUMUP_SCALP',1,ZHOOK_HANDLE)
  RETURN
ENDIF
DO JBLK=1,NBCORBLK
  IF (LLREPRO) THEN
    IACTSUM=SUM( OBSCOR_AUX(1:NSETOT,JBLK)%NOBSCOR_COUNT)
    ALLOCATE(ZPROD(IACTSUM))
    IF (.NOT. LL_USE_ORDER_INDEP_GLOBAL_SUM) THEN
      ILENGL=IACTSUM
      CALL MPL_ALLREDUCE(ILENGL,'SUM',CDSTRING='OBSCOR_SUMUP_SCALP:')
      ALLOCATE(ZRECVGL(ILENGL))
      IRECVCOUNTS(:) = 0
      CALL MPL_ALLGATHERV(IACTSUM, IRECVCOUNTS,CDSTRING='OBSCOR_SUMUP_SCALP:')
    ENDIF
    DO JEV=1,NRITZ_OBSCOR(JBLK)
      IOFF=0
      DO JSET=1,NSETOT
        IACTSET=OBSCOR_AUX(JSET,JBLK)%NOBSCOR_COUNT
        ZPROD(IOFF+1:IOFF+IACTSET) = &
        & OBSCOR_AUX(JSET,JBLK)%OBSCOR_SCALPR_L(JEV,1:IACTSET)
        IOFF=IOFF+IACTSET
      ENDDO
      IF (LL_USE_ORDER_INDEP_GLOBAL_SUM) THEN
        OBSCOR_SCALPR(JEV,JBLK)=ORDER_INDEP_GLOBAL_SUM(ZPROD)      
      ELSE
        CALL MPL_ALLGATHERV(ZPROD,ZRECVGL,IRECVCOUNTS,CDSTRING='OBSCOR_SUMUP_SCALP:')
        CALL KEYSORT(IRET,ZRECVGL,ILENGL)
        OBSCOR_SCALPR(JEV,JBLK)= SUM(ZRECVGL(1:ILENGL))
      ENDIF
    ENDDO
    DEALLOCATE(ZPROD)
    IF (ALLOCATED(ZRECVGL)) DEALLOCATE(ZRECVGL)
  ELSE
    ALLOCATE(ZSUM_NONREPROD_LOCAL(NRITZ_OBSCOR(JBLK)))
    ZSUM_NONREPROD_LOCAL(:)=0.0_JPRB
    DO JEV=1,NRITZ_OBSCOR(JBLK)
      DO JSET=1,NSETOT
        IACTSET=OBSCOR_AUX(JSET,JBLK)%NOBSCOR_COUNT
        ZSUM_NONREPROD_LOCAL(JEV)=ZSUM_NONREPROD_LOCAL(JEV)+ &
        & SUM(OBSCOR_AUX(JSET,JBLK)%OBSCOR_SCALPR_L(JEV,1:IACTSET))
      ENDDO
    ENDDO
! Overall sum is the sum of the dm-local sums (this in non-reproducible...)
!rg-tmp:try
    CALL MPL_ALLREDUCE(ZSUM_NONREPROD_LOCAL,'SUM',LDREPROD=.false.,CDSTRING='OBSCOR_SUMUP_SCALP:')
    OBSCOR_SCALPR(1:NRITZ_OBSCOR(JBLK),JBLK)=ZSUM_NONREPROD_LOCAL(1:NRITZ_OBSCOR(JBLK))
!rg-tmp: try-end
!!!!!!!!!!!!    DO JEV=1,NRITZ_OBSCOR(JBLK)
!!!!!!!!!!!!      ZSUM=ZSUM_NONREPROD_LOCAL(JEV)
!!!!!!!!!!!!    ! Overall sum is the sum of the dm-local sums (this in non-reproducible...)
!!!!!!!!!!!!      CALL MPL_ALLREDUCE(ZSUM,'SUM',LDREPROD=.false.,CDSTRING='OBSCOR_SUMUP_SCALP:')
!!!!!!!!!!!!      OBSCOR_SCALPR(JEV,JBLK)=ZSUM
!!!!!!!!!!!!    ENDDO
    DEALLOCATE(ZSUM_NONREPROD_LOCAL)
  ENDIF  
  IF (LOBSCORDIAG .AND. (NSIM4D == 0 .OR. NSIM4D == 999)) THEN
      WRITE(NULOUT,*) ' FG DEPARTURE PROJECTION ON LEADING EIGEN-VECTORS OF R AT JBLK=',JBLK
      DO JEV=1,NRITZ_OBSCOR(JBLK)
       WRITE(NULOUT,*) JEV,OBSCOR_SCALPR(JEV,JBLK)
      ENDDO
  ENDIF
ENDDO
DO JSET=1,NSETOT
  DO JBLK=1,NBCORBLK
    CALL DEALLOCATE_OBSCOR_AUX(OBSCOR_AUX(JSET,JBLK))
  ENDDO
ENDDO
IF (LHOOK) CALL DR_HOOK('OBSCOR_SUMUP_SCALP',1,ZHOOK_HANDLE)
END SUBROUTINE  OBSCOR_SUMUP_SCALP
