MODULE SPNORMC_MOD
CONTAINS
SUBROUTINE SPNORMC(PSM,KFLD_G,KVSET,KMASTER,PGM)


USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE MPL_MODULE

USE TPM_DIM
USE TPM_DISTR

USE PE2SET_MOD


IMPLICIT NONE

REAL(KIND=JPRB)    ,INTENT(IN)  :: PSM(:,:)
INTEGER(KIND=JPIM) ,INTENT(IN)  :: KFLD_G
INTEGER(KIND=JPIM) ,INTENT(IN)  :: KVSET(:)
INTEGER(KIND=JPIM) ,INTENT(IN)  :: KMASTER
REAL(KIND=JPRB)    ,INTENT(OUT) :: PGM(:,0:)

REAL(KIND=JPRB) :: ZRECVBUF(KFLD_G*(R%NSMAX+1))
INTEGER(KIND=JPIM) :: IFLDR(NPRTRV)

INTEGER(KIND=JPIM) :: ISTOTAL,JFLD,ITAG,JROC,IMSGLEN,IRECVID
INTEGER(KIND=JPIM) :: IRECVNUMP,IRECVFLD,IFLD,JMLOC,IM,IBUFLENR,IA,IB
INTEGER(KIND=JPIM) :: IRECVSETA,IRECVSETB
!     ------------------------------------------------------------------

ISTOTAL  = SIZE(PSM)
IBUFLENR = SIZE(ZRECVBUF)

IFLDR(:) = 0
DO JFLD=1,KFLD_G
  IFLDR(KVSET(JFLD)) = IFLDR(KVSET(JFLD))+1
ENDDO
ITAG = 100  

IF (NPROC > 1.AND.MYPROC /= KMASTER) THEN
  CALL MPL_SEND(PSM(:,:),KDEST=NPRCIDS(KMASTER),KTAG=ITAG,&
   &CDSTRING='SPNORMC:')
ENDIF

IF (MYPROC == KMASTER) THEN
  DO JROC=1,NPROC
    IF (JROC == KMASTER) THEN
      ZRECVBUF(1:ISTOTAL) = RESHAPE(PSM,SHAPE(ZRECVBUF(1:ISTOTAL)))
      IRECVID = MYPROC
      IMSGLEN = ISTOTAL
    ELSE
      CALL MPL_RECV(ZRECVBUF(1:IBUFLENR),KTAG=ITAG,&
       &KFROM=IRECVID,CDSTRING='SPNORMC :')
    ENDIF
    CALL PE2SET(IRECVID,IA,IB,IRECVSETA,IRECVSETB)
    IRECVNUMP = D%NUMPP(IRECVSETA)
    IRECVFLD  = IFLDR(IRECVSETB)
    IFLD = 0
    DO JFLD=1,KFLD_G
      IF(KVSET(JFLD) == IRECVSETB) THEN
        IFLD=IFLD+1
        DO JMLOC=1,IRECVNUMP
          IM = D%NALLMS(D%NPTRMS(IRECVSETA)-1+JMLOC)
          PGM(JFLD,IM) = ZRECVBUF((JMLOC-1)*IRECVFLD+IFLD)
        ENDDO
      ENDIF
    ENDDO
  ENDDO
ENDIF

! Perform barrier synchronisation to guarantee all processors have
! completed communication

IF( NPROC > 1 )THEN
  CALL MPL_BARRIER(CDSTRING='SPNORMC')
ENDIF
!     ------------------------------------------------------------------

END SUBROUTINE SPNORMC
END MODULE SPNORMC_MOD
