    MODULE EXCHM
!--------------------------------------------------------------------------------------------------
    CONTAINS
!
    SUBROUTINE EXCH0(ARR1, LL1, IHALO, JHALO)
!>--------------------------------------------------------------------------------------------------
!> SUBROUTINE EXCH0
!>
!> SUBPROGRAM: EXCH0 - FUNDAMENTAL EXCHANGE ROUTINES
!> PROGRAMMER: BLACK
!> ORG: W/NP2
!> DATE: 97-06-25
!>
!> ABSTRACT:
!> SUBROUTINE EXCH0 IS USED TO EXCHANGE HALOS BETWEEN PROCESSORS
!>
!>  CURRENTLY SUPPORTED INTERFACES
!>
!> 0, 00, 01, 011, 0001111, 1, 11, 111, 1111, 11111, 111111
!>
!> WHERE 0 REFERS TO A 2-D ARRAY AND 1 REFERS TO A 3-D ARRAY
!>
!> PROGRAM HISTORY LOG:
!> 97-05-??  MEYS       - ORIGINATOR
!> 97-06-25  BLACK      - CONVERTED FROM SHMEM TO MPI
!> 98-??-??  TUCCILLO   - REMOVED EXPLICIT EXCHANGES OF CORNERS
!> 98-??-??  TUCCILLO   - REWROTE TO USE NON_BLOCKING MPI ROUTINES
!> 99-??-??  BLACK      - ADDED VARIABLE HALO SIZES
!> 00-03-10  TUCCILLO   - CHANGED TO USE MODULE PROCDURES FOR INCREASED MESSAGE SIZES AND A UNIFORM
!>                        INTERFACE FOR ALL CALLS
!> 01-02-25  TUCCILLO   - SOME PERFORMANCE IMPROVEMENTS
!> 18-01-15  LUCCI      - MODERNIZATION OF THE CODE, INCLUDING:
!>                        * F77 TO F90/F95
!>                        * INDENTATION & UNIFORMIZATION CODE
!>                        * REPLACEMENT OF COMMONS BLOCK FOR MODULES
!>                        * DOCUMENTATION WITH DOXYGEN
!>                        * OPENMP FUNCTIONALITY
!>
!> INPUT ARGUMENT LIST:
!> LL1  - THE VERTICAL DIMENSION OF ARR
!> IHALO - THE NUMBER OF POINTS IN THE X DIRECTION TO EXCHANGE IN THE HALO
!> JHALO - THE NUMBER OF POINTS IN THE Y DIRECTION TO EXCHANGE IN THE HALO
!>
!> OUTPUT ARGUMENT LIST:
!> NONE
!>
!> INPUT/OUTPUT ARGUMENT LIST:
!> ARR1 - THE ARRAY TO BE EXCHANGED
!>
!> USE MODULES: EXCH_BUF_REAL
!>              F77KINDS
!>              GLB_TABLE
!>              MAPPINGS
!>              MPPCOM
!>              PARMETA
!>              TEMPCOM
!>              TOPO
!>
!> DRIVER     : EBU
!>              NEWFLT
!>
!> CALLS      : MPI_IRECV
!>              MPI_ISEND
!>              MPI_WAIT
!>--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    SAVE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , ISEND   , IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR1
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 

    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!-------------------
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!--------------  
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,MYJE-J)
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,MYJS+J)
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1),ISTAT,IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!--------- 
!EAST/WEST
!--------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 

    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,J)
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,J)
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF0(IC)
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE+1
        IEND = MYIE+IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF1(IC)
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH1(ARR1, LL1, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR1
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 

    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!--------------
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 

    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 

    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH01(ARR1, LL1, ARR2, LL2, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,MYJE-J)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,MYJS+J)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!----------  
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------  
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,J)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO -1 
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,J)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS-IHALO
        IEND = MYIS-1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1),ISTAT,IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF0(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF1(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH00(ARR1, LL1, ARR2, LL2, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
! 
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR2
!
    ITYPE = MPI_REAL
!------------  
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,MYJE-J)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR2(I,MYJE-J)
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,MYJS+J)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR2(I,MYJS+J)
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
    END IF

!-----------------
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!----------  
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,J)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR2(I,J)
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   =  0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,J)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR2(I,J)
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS-1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF0(IC)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,J) = BUF0(IC)
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF1(IC)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,J) = BUF1(IC)
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH11(ARR1, LL1, ARR2, LL2, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------
!
!-------------------
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF

    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!----------
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!--------------------------------------------------------------------
! RECEIVE FROM EAST
!--------------------------------------------------------------------
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!----------------
! STORE FROM EAST
!----------------
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH111(ARR1, LL1, ARR2, LL2, ARR3, LL3, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , LL3     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & NEBPE
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR3
!
    ITYPE = MPI_REAL
!------------ ARR1
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJS-J-1,K) = BUF1(IC)
                END DO 
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF

    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        NEBPE = MY_NEB(4)
        IBEG  = MYIS
        IEND  = MYIS + IHALO - 1
        IC    = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,J,K)
                END DO 
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS-1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH1111(ARR1, LL1, ARR2, LL2, ARR3, LL3, ARR4, LL4, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
! 
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , LL3     , LL4     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & NEBPE
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR3
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR4
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO 
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!-------------------------
! STORE RESULTS FROM SOUTH
!-------------------------
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        NEBPE = MY_NEB(2)
        IBEG  = MYIE - IHALO + 1
        IEND  = MYIE
        IC    = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH11111(ARR1, LL1, ARR2, LL2, ARR3, LL3, ARR4, LL4, ARR5, LL5, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , LL3     , LL4     , LL5     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR3
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR4
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR5
!
    ITYPE = MPI_REAL
!------------  
! NORTH/SOUTH
!------------
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!-------------------
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR5(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR5(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2),ISTAT,IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR5(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE,MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR5(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH111111(ARR1, LL1, ARR2, LL2, ARR3, LL3,                                        &
    &                     ARR4, LL4, ARR5, LL5, ARR6, LL6, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , LL3     , LL4     , LL5     , LL6     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR3
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR4
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR5
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR6
!
    ITYPE = MPI_REAL
!------------
! NORTH/SOUTH
!------------
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR5(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR6(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR5(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR6(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR5(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR6(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1 
        IC   = 0
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR1(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR5(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR6(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE ,MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO K=1,LL1
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR1(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH011(ARR1, LL1, ARR2, LL2, ARR3, LL3, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , LL3     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR3
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,MYJE-J)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE,MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,MYJS+J)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------
! SEND TO EAST
!-------------
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,J)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,J)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR2(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR3(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF0(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2),ISTAT,IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF1(IC)
            END DO
        END DO
        DO K=1,LL2
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR2(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL3
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR3(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE IEXCH(ARR1, LL1, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_INTEGER
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       , I       , ISEND   , IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    INTEGER(KIND=I4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR1
!
    ITYPE = MPI_INTEGER
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------- 
! RECEIVE FROM SOUTH
!-------------------
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!--------------
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC)=ARR1(I,MYJE-J)
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC)=ARR1(I,MYJS+J)
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE,MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!----------
!
!------------------ 
! RECEIVE FROM WEST
!------------------
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,J)
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!-------------
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC)=ARR1(I,J)
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 

    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1),ISTAT,IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF0(IC)
            END DO
        END DO
    END IF
!----------------  
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF1(IC)
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
!
    SUBROUTINE EXCH0001111(ARR1, LL1, ARR2, LL2, ARR3, LL3,                                       &
    &                      ARR4, LL4, ARR5, LL5, ARR6, LL6, ARR7, LL7, IHALO, JHALO)
!--------------------------------------------------------------------------------------------------
    USE EXCH_BUF_REAL
    USE F77KINDS
    USE GLB_TABLE
    USE MAPPINGS
    USE MPPCOM
    USE PARMETA
    USE TEMPCOM
    USE TOPO
!
    IMPLICIT NONE
!
    INCLUDE "mpif.h"
!---------------------------------------
! LOCAL VARIABLE CAUSED BY IMPLICIT NONE
!---------------------------------------
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & LL1     , LL2     , LL3     , LL4     , LL5     , LL6     , LL7
!
    INTEGER(KIND=I4KIND)                                                  , INTENT(IN)          ::&
    & IHALO   , JHALO
!
    INTEGER(KIND=I4KIND)                                                                        ::&
    & ITYPE   , IRECV   , IBEG    , IEND    , IC      , J       ,  I      , K       , ISEND   ,   &
    & IERR
!------------------------
! STANDARD LOCAL VARIABLE 
!------------------------
    INTEGER(KIND=I4KIND), DIMENSION(MPI_STATUS_SIZE)                                            ::&
    & ISTAT
!
    INTEGER(KIND=I4KIND), DIMENSION(4)                                                          ::&
    & IHANDLE
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR1
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR2
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2)             , INTENT(INOUT)       ::&
    & ARR3
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR4
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR5
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR6
!
    REAL   (KIND=R4KIND), DIMENSION(IDIM1:IDIM2, JDIM1:JDIM2, *)          , INTENT(INOUT)       ::&
    & ARR7
!
    ITYPE = MPI_REAL
!------------ 
! NORTH/SOUTH
!------------ 
!
!------------------- 
! RECEIVE FROM NORTH
!------------------- 

    IF(MY_NEB(1) >= 0)THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(1),                                          &
    &                                         MY_NEB(1), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM SOUTH
!------------------- 
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(3),                                          &
    &                                         MY_NEB(3), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!-------------- 
! SEND TO NORTH
!-------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,MYJE-J)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR2(I,MYJE-J)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR3(I,MYJE-J)
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR5(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR6(I,MYJE-J,K)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR7(I,MYJE-J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(1), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!-------------- 
! SEND TO SOUTH
!-------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,MYJS+J)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR2(I,MYJS+J)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR3(I,MYJS+J)
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR5(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR6(I,MYJS+J,K)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR7(I,MYJS+J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(3), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!------------------------- 
! STORE RESULTS FROM SOUTH
!------------------------- 
    IF (MY_NEB(3) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR3(I,MYJS-J-1) = BUF1(IC)
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR7(I,MYJS-J-1,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!----------------- 
! STORE FROM NORTH
!----------------- 
    IF (MY_NEB(1) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,MYJE+J+1) = BUF0(IC)
            END DO
        ENDDO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
        DO J=0,JHALO-1
            DO I=IBEG,IEND
                IC = IC + 1
                ARR3(I,MYJE+J+1) = BUF0(IC)
            END DO
        END DO
        DO K=1,LL4
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=0,JHALO-1
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR7(I,MYJE+J+1,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(1) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(3) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!---------- 
! EAST/WEST
!---------- 
!
!------------------ 
! RECEIVE FROM WEST
!------------------ 

    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_IRECV(BUF0, IBUFEXCH, ITYPE, MY_NEB(4),                                          &
    &                                         MY_NEB(4), MPI_COMM_COMP, IHANDLE(1), IRECV)
    END IF
!------------------ 
! RECEIVE FROM EAST
!------------------ 
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_IRECV(BUF1, IBUFEXCH, ITYPE, MY_NEB(2),                                          &
    &                                         MY_NEB(2), MPI_COMM_COMP, IHANDLE(2), IRECV)
    END IF
!------------- 
! SEND TO EAST
!------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE - IHALO + 1
        IEND = MYIE
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR1(I,J)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR2(I,J)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF2(IC) = ARR3(I,J)
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR5(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR6(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF2(IC) = ARR7(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF2, IC, ITYPE, MY_NEB(2), MYPE, MPI_COMM_COMP, IHANDLE(3), ISEND)
    END IF
!------------- 
! SEND TO WEST
!------------- 

    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS
        IEND = MYIS + IHALO - 1
        IC   = 0
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR1(I,J)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR2(I,J)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                BUF3(IC) = ARR3(I,J)
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR4(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR5(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR6(I,J,K)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    BUF3(IC) = ARR7(I,J,K)
                END DO
            END DO
        END DO
        CALL MPI_ISEND(BUF3, IC, ITYPE, MY_NEB(4), MYPE, MPI_COMM_COMP, IHANDLE(4), ISEND)
    END IF
!---------------- 
! STORE FROM WEST
!---------------- 
    IF (MY_NEB(4) >= 0) THEN
        IBEG = MYIS - IHALO
        IEND = MYIS - 1
        IC   = 0
        CALL MPI_WAIT(IHANDLE(1), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF0(IC)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,J) = BUF0(IC)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR3(I,J) = BUF0(IC)
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR7(I,J,K) = BUF0(IC)
                END DO
            END DO
        END DO
    END IF
!---------------- 
! STORE FROM EAST
!---------------- 
    IF (MY_NEB(2) >= 0) THEN
        IBEG = MYIE + 1
        IEND = MYIE + IHALO
        IC   = 0
        CALL MPI_WAIT(IHANDLE(2), ISTAT, IERR)
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR1(I,J) = BUF1(IC)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR2(I,J) = BUF1(IC)
            END DO
        END DO
        DO J=MYJS-JHALO,MYJE+JHALO
            DO I=IBEG,IEND
                IC = IC + 1
                ARR3(I,J) = BUF1(IC)
            END DO
        END DO
        DO K=1,LL4
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR4(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL5
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR5(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL6
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR6(I,J,K)=BUF1(IC)
                END DO
            END DO
        END DO
        DO K=1,LL7
            DO J=MYJS-JHALO,MYJE+JHALO
                DO I=IBEG,IEND
                    IC = IC + 1
                    ARR7(I,J,K) = BUF1(IC)
                END DO
            END DO
        END DO
    END IF
!
    IF (MY_NEB(4) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(4), ISTAT, IERR)
    END IF
!
    IF (MY_NEB(2) >= 0) THEN
        CALL MPI_WAIT(IHANDLE(3), ISTAT, IERR)
    END IF
!
    END SUBROUTINE
!
    END MODULE
