SUBROUTINE LOC2GLB(ARRL,ARRG)
!     ******************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .                               .
! SUBPROGRAM:    LOC2GLB     REATE GLOBAL ARRAYS
!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 97-10-28

! ABSTRACT:
!     LOC2GLB CREATES A SINGLE GLOBAL ARRAY FROM MANY LOCAL ONES

! PROGRAM HISTORY LOG:
!   97-10-28  BLACK      - ORIGINATOR

! USAGE: CALL LOC2GLB FROM SUBROUTINE CHKOUT

!   INPUT ARGUMENT LIST:
!       ARRL   - THE LOCAL ARRAY

!   OUTPUT ARGUMENT LIST:
!       ARRG   - THE GLOBAL ARRAYS

!   INPUT FILES:
!     NONE

!   OUTPUT FILES:
!     NONE

!   SUBPROGRAMS CALLED:

!     UNIQUE: NONE

!     LIBRARY: NONE

!   COMMON BLOCKS: NONE

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP
!$$$
!************************************************************
!------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpp.h"
    INCLUDE "mpif.h"
#include "sp.h"
!------------------------------------------------------------
    REAL :: ARRL(IDIM1:IDIM2,JDIM1:JDIM2),ARRG(IM,JM)
    REAL :: ARRX(IDIM1:IDIM2,JDIM1:JDIM2)
!------------------------------------------------------------
    INTEGER :: ISTAT(MPI_STATUS_SIZE)
!------------------------------------------------------------
    NUMVAL=(IDIM2-IDIM1+1)*(JDIM2-JDIM1+1)

    IF(MYPE /= 0)THEN
        CALL MPI_SEND(ARRL,NUMVAL,MPI_REAL,0,MYPE &
        ,               MPI_COMM_COMP,ISEND)
    
    ELSE
        DO J=MYJS,MYJE
            DO I=MYIS,MYIE
                ARRG(I+MY_IS_GLB-1,J+MY_JS_GLB-1)=ARRL(I,J)
            ENDDO
        ENDDO
    
        DO IPE=1,NPES-1
            CALL MPI_RECV(ARRX,NUMVAL,MPI_REAL,IPE,IPE &
            ,                 MPI_COMM_COMP,ISTAT,IRECV)
        
            JKNT=0
            DO J=JS_LOC_TABLE(IPE),JE_LOC_TABLE(IPE)
                JGLB=JS_GLB_TABLE(IPE)+JKNT
            
                IKNT=0
                DO I=IS_LOC_TABLE(IPE),IE_LOC_TABLE(IPE)
                    IGLB=IS_GLB_TABLE(IPE)+IKNT
                    ARRG(IGLB,JGLB)=ARRX(I,J)
                    IKNT=IKNT+1
                ENDDO
                JKNT=JKNT+1
            ENDDO
        
        ENDDO
    
    ENDIF

    RETURN
    END SUBROUTINE LOC2GLB