SUBROUTINE VMODEENERGY(KIOMASTER,KVMOD,KVMODPP,KCMAX,KUMCP,&
 & KUMVMO,PKENERGYL,PKENERGY)  

!**** *VMODEENERGY*  - Calculate global reproducible energy norms

!     Purpose.
!     --------
!           Calculate global reproducible kinetic energy

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

!        Explicit arguments :
!        --------------------
!        KIONODE                : PE doing the summing and printing
!        KVMOD                  : Global number of vertical modes
!        KVMODPP                : Number of vertical modes on this PE
!        KCMAX                  : Wave number truncation limit
!        KUMCP                  : Number of waves on this PE
!        PKENERGYL              : Local contributions
!        PKENERGY               : Global contributions

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

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

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

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

!     Author.
!     -------
!        Lars Isaksen *ECMWF*

!     Modifications.
!     --------------
!        Original  : 97-09-09
!        Modified  : 00-09-01 D.Dent: convert from MPE to MPL
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0   , ONLY : NPROC    ,NPRTRV
USE YOMMP    , ONLY : NPRCIDS  ,MYPROC   ,MYSETV   ,NUMPP    ,&
 & NPTRMS   ,NALLMS   ,NVMODIST  
USE YOMLAP   , ONLY : MYMS
USE YOMCT3   , ONLY : NSTEP
USE YOMNMIA  , ONLY : NITNMI
USE YOMTAG   , ONLY : MTAGKE
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KVMOD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KVMODPP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KUMCP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIOMASTER 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCMAX
INTEGER(KIND=JPIM),INTENT(IN)    :: KUMVMO(NPRTRV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKENERGYL(KUMCP,KVMODPP) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKENERGY(KVMOD) 
REAL(KIND=JPRB) :: ZGLOBAL(0:KCMAX,KVMOD)
REAL(KIND=JPRB) :: ZCOMBUF((KCMAX+1)*KVMOD)

INTEGER(KIND=JPIM) :: IA, IB, ICOMLEN, IEXPECTED, IM, IMODE,&
 & IMSGLEN, IOFF, IRECVID, IRECVNUMP, IRECVNVM, &
 & IRECVSETA, IRECVSETB, ISENDLEN, ITAG, &
 & JK, JMLOC, JROF  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "pe2set.intfb.h"

!       For message passing a gathering of data on KIOMASTER is done

IF (LHOOK) CALL DR_HOOK('VMODEENERGY',0,ZHOOK_HANDLE)
ITAG=MTAGKE+NITNMI+NSTEP
IF (MYPROC /= KIOMASTER) THEN
  ISENDLEN=SIZE(PKENERGYL)
  CALL MPL_SEND(PKENERGYL(1:ISENDLEN,1),KDEST=NPRCIDS(KIOMASTER),KTAG=ITAG, &
   & CDSTRING='VMODEENERGY:')  
ELSE

!         Local contribution put in the right place

  DO JK=1,KVMODPP
    IMODE=NVMODIST(JK,MYSETV)
    DO JMLOC=1,KUMCP
      IM=MYMS(JMLOC)
      ZGLOBAL(IM,IMODE)=PKENERGYL(JMLOC,JK)
    ENDDO
  ENDDO

!         Receive contributions from other PE's         

  ICOMLEN=SIZE(ZCOMBUF)
  DO JROF=1,NPROC-1
!      receive from anyone
    CALL MPL_RECV(ZCOMBUF(1:ICOMLEN),KTAG=ITAG, &
     & KOUNT=IMSGLEN,KFROM=IRECVID,CDSTRING='VMODEENERGY:')  
    
!           Determine what was received based on IRECVID

    CALL PE2SET(IRECVID,IA,IB,IRECVSETA,IRECVSETB)
    IRECVNVM=KUMVMO(IRECVSETB)
    IRECVNUMP=NUMPP(IRECVSETA)
    IEXPECTED=IRECVNVM*IRECVNUMP
    
    IF (IMSGLEN /= IEXPECTED) CALL ABOR1('VMODEENERGY : '//&
     & ' RECEIVED MESSAGE LENGTH OF WRONG SIZE')  

!           Received contribution put in the right place

    DO JK=1,IRECVNVM
      IMODE=NVMODIST(JK,IRECVSETB)
      IOFF=(JK-1)*IRECVNUMP
      DO JMLOC=1,IRECVNUMP
        IM=NALLMS(NPTRMS(IRECVSETA)-1+JMLOC)
        ZGLOBAL(IM,IMODE)=ZCOMBUF(JMLOC+IOFF)
      ENDDO
    ENDDO
  ENDDO

!         Calculate total kinetic energy in a reproducible manner

  PKENERGY(:)=SUM(ZGLOBAL(:,:),DIM=1)

ENDIF
IF (NPROC > 1) THEN
  CALL MPL_BARRIER(CDSTRING='VMODEENERGY:')
ENDIF
IF (LHOOK) CALL DR_HOOK('VMODEENERGY',1,ZHOOK_HANDLE)

END SUBROUTINE VMODEENERGY
