SUBROUTINE COMMSPNORM1(KFIELDSL,KFIELDSG,PMLOCAL,PMGLOBAL,KSMAX,KIOMASTER,&
 & KSETV,KLOC)  

!**** *COMMSPNORM1* Communicates spectral norm data for fullpos

!     Purpose.
!     --------

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

!        Explicit arguments : KFIELDSL  - local number of fields (input)
!        -------------------- KFIELDSG  - global number of fields (input)
!                             PMLOCAL   - local m wave data   (input)
!                             PMGLOBAL  - global m wave data  (output)
!                             KSMAX     - truncation
!                             KIOMASTER - processor receiving data
!                             KSETV     - V-set each global field belongs to 
!                             KLOC      - local adress for each global field

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

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

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

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

!     Author.
!     -------
!        L. Isaksen  *ECMWF*

!     Modifications.
!     --------------
!        Original: 97-08-08 
!        R. El Khatib 99-02-03 KSMAX and KIOMASTER as arguments 
!        D.Dent       00-01-10 corrections to partitioning in wave space
!        D.Dent       00-09-01 MPE to MPL conversion
!    R. El Khatib : 02-21-20 Fullpos B-level distribution
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMCT0   , ONLY :    NPROC
USE YOMDIM   , ONLY : NUMP
USE YOMMP    , ONLY :      MYPROC   ,NPTRMS   ,NALLMS, NUMPP
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDSL 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELDSG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSMAX 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMLOCAL(KFIELDSL,NUMP) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PMGLOBAL(KFIELDSG,0:KSMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIOMASTER 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSETV(KFIELDSG) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLOC(KFIELDSG) 
REAL(KIND=JPRB), ALLOCATABLE :: ZSENDBUF(:),ZRECVBUF(:)

INTEGER(KIND=JPIM) :: IM, ILEN, JFLD, JMLOC, IFLDL
INTEGER(KIND=JPIM) :: IRECVSETA,IRECVSETB,IOFF,ILENR,IA,IB,JROC
INTEGER(KIND=JPIM) :: IRECVCOUNTS(NPROC)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "pe2set.intfb.h"

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

!     1.    SEND LOCAL DATA TO I/O MASTER PROC.
!           ----------------------------------

IF (LHOOK) CALL DR_HOOK('COMMSPNORM1',0,ZHOOK_HANDLE)
ILEN=SIZE(PMLOCAL)
IF(NPROC > 1) THEN
  ALLOCATE(ZSENDBUF(ILEN))
  IF( SIZE(PMLOCAL) > 0 )THEN
    ZSENDBUF(:) = RESHAPE(PMLOCAL,SHAPE(ZSENDBUF))
  ENDIF
  ILENR=0
  DO JROC=1,NPROC
    CALL PE2SET(JROC,IA,IB,IRECVSETA,IRECVSETB)
    IFLDL=COUNT(KSETV==IRECVSETB)
    ILEN=IFLDL*NUMPP(IRECVSETA)
    IRECVCOUNTS(JROC)=ILEN
    ILENR=ILENR+ILEN
  ENDDO
  ALLOCATE(ZRECVBUF(ILENR))
  CALL GSTATS(608,0)
  CALL MPL_GATHERV(ZSENDBUF,KROOT=KIOMASTER,&
   & PRECVBUF=ZRECVBUF,KRECVCOUNTS=IRECVCOUNTS, &
   & CDSTRING='COMMSPNORM1:')  
  CALL GSTATS(608,1)

  IF (SIZE(PMGLOBAL) > 0 .AND. MYPROC == KIOMASTER) THEN
    IOFF=0
    DO JROC=1,NPROC
      CALL PE2SET(JROC,IA,IB,IRECVSETA,IRECVSETB)
      IFLDL=COUNT(KSETV==IRECVSETB)
      DO JFLD=1,KFIELDSG
        IF (KSETV(JFLD) == IRECVSETB) THEN
          DO JMLOC=1,NUMPP(IRECVSETA)
            IM=NALLMS(NPTRMS(IRECVSETA)-1+JMLOC)
            PMGLOBAL(JFLD,IM)=ZRECVBUF(IOFF+(JMLOC-1)*IFLDL+KLOC(JFLD))
          ENDDO
        ENDIF
      ENDDO
      IOFF=IOFF+IRECVCOUNTS(JROC)
    ENDDO
  ENDIF
  DEALLOCATE(ZSENDBUF)
  DEALLOCATE(ZRECVBUF)
ELSE
  PMGLOBAL(:,:)=PMLOCAL(:,:)
ENDIF

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

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