SUBROUTINE GATHERCOSTO

!**** *GATHERCOSTO*  - Gather Jo function contributions

!     Purpose.
!     --------
!           Build up global diagnostic Jo cost function arrays

!**   Interface.
!     ----------
!        *CALL* *GATHERCOSTO(..)

!        Explicit arguments :
!        --------------------


!        Implicit arguments :
!        --------------------
!        None

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Mats Hamrud ECMWF

!     Modifications.
!     --------------
!        Original  : 96-04-04
!     D. Dent      : 00-09-01 MPE to MPL conversion
!     E. Andersson : 00-11-14 Changes to Jo-table
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        Y.Tremolet    29-May-2008 Print Jo table by bins
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE PARDIMO  , ONLY : JPXVAR   
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMANCS  , ONLY : RMDI
USE YOMCT0   , ONLY : NPROC
USE YOMMP    , ONLY : MYPROC
USE MPL_MODULE
USE YOMCOSJO , ONLY : JOT      ,NJOTTSZ, NPRTBINS
USE YOMCMA   , ONLY : NMXOTP

IMPLICIT NONE

! === END OF INTERFACE BLOCK ===
REAL(KIND=JPRB) :: ZCOMSEND(NJOTTSZ)
REAL(KIND=JPRB),ALLOCATABLE :: ZCOMRECV(:)

INTEGER(KIND=JPIM) :: ISZSEND,  IOFF
INTEGER(KIND=JPIM) :: JROC, JOTP, JCTP, jbin
INTEGER(KIND=JPIM) :: IRECVCOUNTS(NPROC)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('GATHERCOSTO',0,ZHOOK_HANDLE)
ISZSEND = SIZE(ZCOMSEND)

!     1.    Store this PE's cost function contributions in global array
!           -----------------------------------------------------------

IF(NPROC == 1) THEN

!     2.    Make global view
!           ----------------

ELSE
  IF(MYPROC == 1) THEN
    ALLOCATE(ZCOMRECV(NPROC*NJOTTSZ))
  ELSE
    ALLOCATE(ZCOMRECV(1))
  ENDIF
    
  IOFF=0
  DO JOTP=1,NMXOTP
    DO JCTP=1,JOT(JOTP)%size
      DO jbin=1,NPRTBINS
        ZCOMSEND(IOFF+1:IOFF+JPXVAR)=JOT(JOTP)%jost(JCTP)%cost(:,jbin)
        IOFF=IOFF+JPXVAR
        ZCOMSEND(IOFF+1:IOFF+JPXVAR)=JOT(JOTP)%jost(JCTP)%count(:,jbin)
        IOFF=IOFF+JPXVAR
        ZCOMSEND(IOFF+1:IOFF+JPXVAR)=JOT(JOTP)%jost(JCTP)%obimpact(:,jbin)
        IOFF=IOFF+JPXVAR
      ENDDO
      ZCOMSEND(IOFF+1:IOFF+JPXVAR)=JOT(JOTP)%jost(JCTP)%obserr(:)
      IOFF=IOFF+JPXVAR
      ZCOMSEND(IOFF+1:IOFF+JPXVAR)=JOT(JOTP)%jost(JCTP)%bgerr(:)
      IOFF=IOFF+JPXVAR
    ENDDO
  ENDDO
  IF(IOFF /= ISZSEND) CALL ABOR1('GATHERCOSTO: ISZSEND /= IOFF')

  DO JROC=1,NPROC
    IRECVCOUNTS(JROC)=NJOTTSZ
  ENDDO
  
  CALL GSTATS_BARRIER(712)
  CALL GSTATS(610,0)
  CALL MPL_GATHERV(PSENDBUF=ZCOMSEND,PRECVBUF=ZCOMRECV,&
   & KRECVCOUNTS=IRECVCOUNTS,KROOT=1,CDSTRING='GATHERCOSTO:')  
  CALL GSTATS(610,1)
  CALL GSTATS_BARRIER2(712)
  
  IF(MYPROC == 1) THEN
    IOFF=0
    DO JROC=1,NPROC
      IF(JROC /= MYPROC ) THEN
        CALL GSTATS(1826,0)
        DO JOTP=1,NMXOTP
          DO JCTP=1,JOT(JOTP)%size
            DO jbin=1,NPRTBINS
              JOT(JOTP)%jost(JCTP)%cost(:,jbin)  = &
               & JOT(JOTP)%jost(JCTP)%cost(:,jbin) + ZCOMRECV(IOFF+1:IOFF+JPXVAR)
              IOFF=IOFF+JPXVAR
              JOT(JOTP)%jost(JCTP)%count(:,jbin) = &
               & JOT(JOTP)%jost(JCTP)%count(:,jbin) + ZCOMRECV(IOFF+1:IOFF+JPXVAR)
              IOFF=IOFF+JPXVAR
              JOT(JOTP)%jost(JCTP)%obimpact(:,jbin) = &
               & JOT(JOTP)%jost(JCTP)%obimpact(:,jbin) + ZCOMRECV(IOFF+1:IOFF+JPXVAR)  
              IOFF=IOFF+JPXVAR
            ENDDO
            JOT(JOTP)%jost(JCTP)%obserr(:) = &
             & JOT(JOTP)%jost(JCTP)%obserr(:) + ZCOMRECV(IOFF+1:IOFF+JPXVAR)
            IOFF=IOFF+JPXVAR
            WHERE(ZCOMRECV(IOFF+1:IOFF+JPXVAR) == RMDI)
               JOT(JOTP)%jost(JCTP)%bgerr(:) = RMDI
            ELSEWHERE
               JOT(JOTP)%jost(JCTP)%bgerr(:) = &
             &   JOT(JOTP)%jost(JCTP)%bgerr(:) + ZCOMRECV(IOFF+1:IOFF+JPXVAR)
            ENDWHERE
            IOFF=IOFF+JPXVAR
          ENDDO
        ENDDO
        CALL GSTATS(1826,1)
      ELSE
        IOFF=IOFF+NJOTTSZ
      ENDIF
    
    ENDDO
  ENDIF
  DEALLOCATE(ZCOMRECV)
ENDIF

IF (LHOOK) CALL DR_HOOK('GATHERCOSTO',1,ZHOOK_HANDLE)
END SUBROUTINE GATHERCOSTO
