!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    SUBROUTINE IDSTRB(ARRG,ARRL)
!     ******************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    IDSTRB      DISTRIBUTE INTEGER GLOBAL ARRAY TO LOCAL ONES
!   PRGRMMR: BLACK           ORG: W/NP2      DATE: 97-08-29

! ABSTRACT:
!     IDSTRB DISTRIBUTES THE ELEMENTS OF INTEGER GLOBAL ARRAY ARRG TO
!     THE INTEGER LOCAL ARRAYS ARRL.  LG IS THE VERTICAL DIMENSION OF THE
!     GLOBAL ARRAY.  LL IS THE VERTICAL DIMENSION OF THE LOCAL ARRAY.
!     L1 IS THE SPECIFIC LEVEL OF ARRL THAT IS BEING FILLED DURING
!     THIS CALL (PERTINENT WHEN LG=1 AND LL>1).

! PROGRAM HISTORY LOG:
!   97-08-29  BLACK      - ORIGINATOR

! USAGE: CALL READ_NFCST FROM SUBROUTINE INIT
!   INPUT ARGUMENT LIST:
!     ARRG - GLOBAL ARRAY

!   OUTPUT ARGUMENT LIST:
!     ARRL - LOCAL ARRAY

!   OUTPUT FILES:
!     NONE

!   SUBPROGRAMS CALLED:
!     UNIQUE: NONE

!     LIBRARY: NONE

!   COMMON BLOCKS: NONE

!   ATTRIBUTES:
!     LANGUAGE: FORTRAN 90
!     MACHINE : IBM SP
!$$$
!---------------------------------------------------------------------------
!***  DISTRIBUTE ARRAYS FROM GLOBAL TO LOCAL
!---------------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpp.h"
    INCLUDE "mpif.h"
#include "sp.h"
!---------------------------------------------------------------------------
    INTEGER :: ARRG(IM,JM),ARRX(IM,JM) &
    ,       ARRL(IDIM1:IDIM2,JDIM1:JDIM2)
    INTEGER :: ISTAT(MPI_STATUS_SIZE)
!---------------------------------------------------------------------------
!***
!***  PE0 FILLS ITS OWN LOCAL DOMAIN THEN PARCELS OUT ALL THE OTHER PIECES
!***  TO THE OTHER PEs.
!***
    IF(MYPE == 0)THEN
    
        DO JGLB=JS_GLB_TABLE(0),JE_GLB_TABLE(0)
            LOCJ=G2LJ(JGLB)
            DO IGLB=IS_GLB_TABLE(0),IE_GLB_TABLE(0)
                LOCI=G2LI(IGLB)
                ARRL(LOCI,LOCJ)=ARRG(IGLB,JGLB)
            ENDDO
        ENDDO
    
        DO IPE=1,NPES-1
            KNT=0
        
            DO JGLB=JS_GLB_TABLE(IPE),JE_GLB_TABLE(IPE)
                DO IGLB=IS_GLB_TABLE(IPE),IE_GLB_TABLE(IPE)
                    KNT=KNT+1
                    ARRX(KNT,1)=ARRG(IGLB,JGLB)
                ENDDO
            ENDDO
        
            CALL MPI_SEND(ARRX,KNT,MPI_INTEGER,IPE,IPE &
            ,                 MPI_COMM_COMP,ISEND)
        ENDDO
    !--------------------------------------------------------------------
    !***
    !***  ALL OTHER PEs RECEIVE THEIR PIECE FROM PE0 AND THEN FILL
    !***  THEIR LOCAL ARRAY.
    !***
    ELSE
        NUMVALS=(IE_GLB_TABLE(MYPE)-IS_GLB_TABLE(MYPE)+1) &
        *(JE_GLB_TABLE(MYPE)-JS_GLB_TABLE(MYPE)+1)
        CALL MPI_RECV(ARRX,NUMVALS,MPI_INTEGER,0,MYPE &
        ,               MPI_COMM_COMP,ISTAT,IRECV)
    
        KNT=0
        DO J=MY_JS_LOC,MY_JE_LOC
            DO I=MY_IS_LOC,MY_IE_LOC
                KNT=KNT+1
                ARRL(I,J)=ARRX(KNT,1)
            ENDDO
        ENDDO
    
    ENDIF

    CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)

    RETURN
    END SUBROUTINE IDSTRB
