!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPSEND2DEW                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!

SUBROUTINE mpsend2dew(var,nx,ny,nz,ebc,wbc,stagdim,mptag,tem) 61,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send east/west boundary data between processors to update the fake
!  zones.  Fake zone update is completed with a call to MPRECV2DEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v);
!              =3, staggered in the z-direction (e.g. w).
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: ebc,wbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v);
                               !  =3, staggered in the z-direction (e.g. w).
  REAL :: var(nx,ny,nz)
  REAL :: tem((nx+ny)*nz)      ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k
  INTEGER :: si,sj,sk

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  sk = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1
  IF (stagdim == 3) sk = 1

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        tem(j+ny*(k-1)) = var(nx-2,j,k)
      END DO
    END DO

    CALL mpi_send(tem,ny*nz,mpi_real,                                   &
        proc(loc_x+1+nproc_x*(loc_y-1)),                                &
        mptag+tag_w, mpi_comm_world, imstat)
    !wdt forced buffering
    !CALL mpi_bsend(tem,ny*nz,mpi_real,                                   &
    !    proc(loc_x+1+nproc_x*(loc_y-1)),                                &
    !    mptag+tag_w, mpi_comm_world, imstat)

  ELSE IF(ebc == 2) THEN

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        tem(j+ny*(k-1)) = var(nx-2,j,k)
      END DO
    END DO

    CALL mpi_send(tem,ny*nz,mpi_real,proc(1+nproc_x*(loc_y-1)),         &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny*nz,mpi_real,proc(1+nproc_x*(loc_y-1)),         &
    !    mptag+tag_w, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        tem(j+ny*(k-1)) = var(2+si,j,k)
      END DO
    END DO

    CALL mpi_send(tem,ny*nz,mpi_real,                                   &
        proc(loc_x-1+nproc_x*(loc_y-1)),                                &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny*nz,mpi_real,                                   &
    !    proc(loc_x-1+nproc_x*(loc_y-1)),                                &
    !    mptag+tag_e, mpi_comm_world, imstat)

  ELSE IF(wbc == 2) THEN

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        tem(j+ny*(k-1)) = var(2+si,j,k)
      END DO
    END DO

    CALL mpi_send(tem,ny*nz,mpi_real,                                   &
        proc(nproc_x+nproc_x*(loc_y-1)),                                &
        mptag+tag_e, mpi_comm_world, imstat)
    !wdt forced buffering
    !CALL mpi_bsend(tem,ny*nz,mpi_real,                                   &
    !    proc(nproc_x+nproc_x*(loc_y-1)),                                &
    !    mptag+tag_e, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsend2dew
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPRECV2DEW                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecv2dew(var,nx,ny,nz,ebc,wbc,stagdim,mptag,tem) 61
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Receive east/west boundary data between processors to update the fake
!  zones.  Fake zone updates are initiated with a call to MPSEND2DEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v);
!              =3, staggered in the z-direction (e.g. w).
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: ebc,wbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v);
                               !  =3, staggered in the z-direction (e.g. w).
  REAL :: var(nx,ny,nz)
  REAL :: tem((nx+ny)*nz)      ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k
  INTEGER :: si,sj,sk

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  sk = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1
  IF (stagdim == 3) sk = 1

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    CALL mpi_recv(tem,ny*nz,mpi_real,                                   &
        proc(loc_x-1+nproc_x*(loc_y-1)),                                &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        var(1,j,k) = tem(j+ny*(k-1))
      END DO
    END DO

  ELSE IF(wbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,ny*nz,mpi_real,                                   &
        proc(nproc_x+nproc_x*(loc_y-1)),                                &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        var(1,j,k) = tem(j+ny*(k-1))
      END DO
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    CALL mpi_recv(tem,ny*nz,mpi_real,                                   &
        proc(loc_x+1+nproc_x*(loc_y-1)),                                &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        var(nx-1+si,j,k) = tem(j+ny*(k-1))
      END DO
    END DO

  ELSE IF(ebc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,ny*nz,mpi_real,proc(1+nproc_x*(loc_y-1)),         &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)

    DO k=1,nz-1+sk
      DO j=1,ny-1+sj
        var(nx-1+si,j,k) = tem(j+ny*(k-1))
      END DO
    END DO

  END IF

  RETURN
END SUBROUTINE mprecv2dew
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPSEND2DNS                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsend2dns(var,nx,ny,nz,nbc,sbc,stagdim,mptag,tem) 61,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send north/south boundary data between processors to update the
!  fake zones.  Fake zone update is completed with a call to MPRECV2DNS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v);
!              =3, staggered in the z-direction (e.g. w).
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: nbc,sbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v);
                               !  =3, staggered in the z-direction (e.g. w).
  REAL :: var(nx,ny,nz)
  REAL :: tem((nx+ny)*nz)      ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k
  INTEGER :: si,sj,sk

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  sk = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1
  IF (stagdim == 3) sk = 1

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        tem(i+nx*(k-1)) = var(i,2+sj,k)
      END DO
    END DO

    CALL mpi_send(tem,nx*nz,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),     &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx*nz,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),     &
    !    mptag+tag_n, mpi_comm_world, imstat)

  ELSE IF(sbc == 2) THEN

    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        tem(i+nx*(k-1)) = var(i,2+sj,k)
      END DO
    END DO

    CALL mpi_send(tem,nx*nz,mpi_real,                                   &
        proc(loc_x+nproc_x*(nproc_y-1)),                                &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx*nz,mpi_real,                                   &
    !    proc(loc_x+nproc_x*(nproc_y-1)),                                &
    !    mptag+tag_n, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        tem(i+nx*(k-1)) = var(i,ny-2,k)
      END DO
    END DO

    CALL mpi_send(tem,nx*nz,mpi_real,proc(loc_x+nproc_x*loc_y),         &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx*nz,mpi_real,proc(loc_x+nproc_x*loc_y),         &
    !    mptag+tag_s, mpi_comm_world, imstat)

  ELSE IF(nbc == 2) THEN

    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        tem(i+nx*(k-1)) = var(i,ny-2,k)
      END DO
    END DO

    CALL mpi_send(tem,nx*nz,mpi_real,proc(loc_x),                       &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx*nz,mpi_real,proc(loc_x),                       &
    !    mptag+tag_s, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsend2dns
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPRECV2DNS                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecv2dns(var,nx,ny,nz,nbc,sbc,stagdim,mptag,tem) 61
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Receive north/south boundary data between processors to update the
!  fake zones.  Fake zone updates are initiated with a call to MPSEND2DNS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v);
!              =3, staggered in the z-direction (e.g. w).
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: nbc,sbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v);
                               !  =3, staggered in the z-direction (e.g. w).
  REAL :: var(nx,ny,nz)
  REAL :: tem((nx+ny)*nz)      ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k
  INTEGER :: si,sj,sk

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  sk = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1
  IF (stagdim == 3) sk = 1

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    CALL mpi_recv(tem,nx*nz,mpi_real,proc(loc_x+nproc_x*loc_y),         &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)

    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        var(i,ny-1+sj,k) = tem(i+nx*(k-1))
      END DO
    END DO

  ELSE IF(nbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,nx*nz,mpi_real,proc(loc_x),                       &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)


    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        var(i,ny-1+sj,k) = tem(i+nx*(k-1))
      END DO
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    CALL mpi_recv(tem,nx*nz,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),     &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)

    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        var(i,1,k) = tem(i+nx*(k-1))
      END DO
    END DO

  ELSE IF(sbc == 2) THEN

    CALL mpi_recv(tem,nx*nz,mpi_real,                                   &
        proc(loc_x+nproc_x*(nproc_y-1)),                                &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)


    DO k=1,nz-1+sk
      DO i=1,nx-1+si
        var(i,1,k) = tem(i+nx*(k-1))
      END DO
    END DO

  END IF

  RETURN
END SUBROUTINE mprecv2dns
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPSEND1DEW                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsend1dew(var,nx,ny,ebc,wbc,stagdim,mptag,tem) 24,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send east/west boundary data between processors to update the fake
!  zones.  Fake zone update is completed with a call to MPRECV1DEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x and y
                               ! directions
  INTEGER :: ebc,wbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  REAL :: var(nx,ny)
  REAL :: tem(nx+ny)           ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    DO j=1,ny-1+sj
      tem(j) = var(nx-2,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(loc_x+1+nproc_x*(loc_y-1)),      &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(loc_x+1+nproc_x*(loc_y-1)),      &
    !    mptag+tag_w, mpi_comm_world, imstat)

  ELSE IF(ebc == 2) THEN

    DO j=1,ny-1+sj
      tem(j) = var(nx-2,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(1+nproc_x*(loc_y-1)),            &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(1+nproc_x*(loc_y-1)),            &
    !    mptag+tag_w, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    DO j=1,ny-1+sj
      tem(j) = var(2+si,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(loc_x-1+nproc_x*(loc_y-1)),      &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(loc_x-1+nproc_x*(loc_y-1)),      &
    !    mptag+tag_e, mpi_comm_world, imstat)

  ELSE IF(wbc == 2) THEN

    DO j=1,ny-1+sj
      tem(j) = var(2+si,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(nproc_x+nproc_x*(loc_y-1)),      &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(nproc_x+nproc_x*(loc_y-1)),      &
    !    mptag+tag_e, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsend1dew
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPRECV1DEW                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecv1dew(var,nx,ny,ebc,wbc,stagdim,mptag,tem) 24
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send east/west boundary data between processors to update the fake
!  zones.  Fake zone updates are initiated with a call to MPSEND1DEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x, and y
                               ! directions
  INTEGER :: ebc,wbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  REAL :: var(nx,ny)
  REAL :: tem(nx+ny)           ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    CALL mpi_recv(tem,ny,mpi_real,proc(loc_x-1+nproc_x*(loc_y-1)),      &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)

    DO j=1,ny-1+sj
      var(1,j) = tem(j)
    END DO

  ELSE IF(wbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,ny,mpi_real,proc(nproc_x+nproc_x*(loc_y-1)),      &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)


    DO j=1,ny-1+sj
      var(1,j) = tem(j)
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    CALL mpi_recv(tem,ny,mpi_real,proc(loc_x+1+nproc_x*(loc_y-1)),      &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)

    DO j=1,ny-1+sj
      var(nx-1+si,j) = tem(j)
    END DO

  ELSE IF(ebc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,ny,mpi_real,proc(1+nproc_x*(loc_y-1)),            &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)


    DO j=1,ny-1+sj
      var(nx-1+si,j) = tem(j)
    END DO

  END IF

  RETURN
END SUBROUTINE mprecv1dew
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPSEND1DNS                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsend1dns(var,nx,ny,nbc,sbc,stagdim,mptag,tem) 24,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send north/south boundary data between processors to update the
!  fake zones.  Fake zone update is completed with a call to MPRECV1DNS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x and y
                               ! directions
  INTEGER :: nbc,sbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  REAL :: var(nx,ny)
  REAL :: tem(nx+ny)           ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,2+sj)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),        &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),        &
    !    mptag+tag_n, mpi_comm_world, imstat)

  ELSE IF(sbc == 2) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,2+sj)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x+nproc_x*(nproc_y-1)),      &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x+nproc_x*(nproc_y-1)),      &
    !    mptag+tag_n, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,ny-2)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x+nproc_x*loc_y),            &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x+nproc_x*loc_y),            &
    !    mptag+tag_s, mpi_comm_world, imstat)

  ELSE IF(nbc == 2) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,ny-2)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x),                          &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x),                          &
    !    mptag+tag_s, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsend1dns
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPRECV1DNS                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecv1dns(var,nx,ny,nbc,sbc,stagdim,mptag,tem) 24
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send north/south boundary data between processors to update the
!  fake zones.  Fake zone updates are initiated with a call to MPSEND1DNS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/18
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x, and y
                               ! directions
  INTEGER :: nbc,sbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  REAL :: var(nx,ny)
  REAL :: tem(nx+ny)           ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x+nproc_x*loc_y),            &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)

    DO i=1,nx-1+si
      var(i,ny-1+sj) = tem(i)
    END DO

  ELSE IF(nbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x),                          &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)


    DO i=1,nx-1+si
      var(i,ny-1+sj) = tem(i)
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),        &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)

    DO i=1,nx-1+si
      var(i,1) = tem(i)
    END DO

  ELSE IF(sbc == 2) THEN

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x+nproc_x*(nproc_y-1)),      &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)


    DO i=1,nx-1+si
      var(i,1) = tem(i)
    END DO

  END IF

  RETURN
END SUBROUTINE mprecv1dns
!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MPSEND1DIEW                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsend1diew(var,nx,ny,ebc,wbc,stagdim,mptag,tem) 2,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send east/west boundary data between processors to update the fake zones.
!  Fake zone update is completed with a call to MPRECV1DIEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x and y
                               ! directions
  INTEGER :: ebc,wbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  INTEGER :: var(nx,ny)
  INTEGER :: tem(nx+ny)        ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    DO j=1,ny-1+sj
      tem(j) = var(nx-2,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(loc_x+1+nproc_x*(loc_y-1)),      &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(loc_x+1+nproc_x*(loc_y-1)),      &
    !    mptag+tag_w, mpi_comm_world, imstat)

  ELSE IF(ebc == 2) THEN

    DO j=1,ny-1+sj
      tem(j) = var(nx-2,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(1+nproc_x*(loc_y-1)),            &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(1+nproc_x*(loc_y-1)),            &
    !    mptag+tag_w, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    DO j=1,ny-1+sj
      tem(j) = var(2+si,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(loc_x-1+nproc_x*(loc_y-1)),      &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(loc_x-1+nproc_x*(loc_y-1)),      &
    !    mptag+tag_e, mpi_comm_world, imstat)

  ELSE IF(wbc == 2) THEN

    DO j=1,ny-1+sj
      tem(j) = var(2+si,j)
    END DO

    CALL mpi_send(tem,ny,mpi_real,proc(nproc_x+nproc_x*(loc_y-1)),      &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,ny,mpi_real,proc(nproc_x+nproc_x*(loc_y-1)),      &
    !    mptag+tag_e, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsend1diew
!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MPRECV1DIEW                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecv1diew(var,nx,ny,ebc,wbc,stagdim,mptag,tem) 2
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Receive east/west boundary data between processors to update the fake zones.
!  Fake zone updates are initiated with a call to MPSEND1DIEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x, and y
                               ! directions
  INTEGER :: ebc,wbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  INTEGER :: var(nx,ny)
  INTEGER :: tem(nx+ny)        ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    CALL mpi_recv(tem,ny,mpi_real,proc(loc_x-1+nproc_x*(loc_y-1)),      &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)

    DO j=1,ny-1+sj
      var(1,j) = tem(j)
    END DO

  ELSE IF(wbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,ny,mpi_real,proc(nproc_x+nproc_x*(loc_y-1)),      &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)


    DO j=1,ny-1+sj
      var(1,j) = tem(j)
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    CALL mpi_recv(tem,ny,mpi_real,proc(loc_x+1+nproc_x*(loc_y-1)),      &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)

    DO j=1,ny-1+sj
      var(nx-1+si,j) = tem(j)
    END DO

  ELSE IF(ebc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,ny,mpi_real,proc(1+nproc_x*(loc_y-1)),            &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)


    DO j=1,ny-1+sj
      var(nx-1+si,j) = tem(j)
    END DO

  END IF

  RETURN
END SUBROUTINE mprecv1diew
!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MPSEND1DINS                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsend1dins(var,nx,ny,nbc,sbc,stagdim,mptag,tem) 2,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send north/south boundary data between processors to update the fake zones.
!  Fake zone update is completed with a call to MPRECV1DINS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x and y
                               ! directions
  INTEGER :: nbc,sbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  INTEGER :: var(nx,ny)
  INTEGER :: tem(nx+ny)        ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,2+sj)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),        &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),        &
    !    mptag+tag_n, mpi_comm_world, imstat)

  ELSE IF(sbc == 2) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,2+sj)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x+nproc_x*(nproc_y-1)),      &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x+nproc_x*(nproc_y-1)),      &
    !    mptag+tag_n, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,ny-2)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x+nproc_x*loc_y),            &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x+nproc_x*loc_y),            &
    !    mptag+tag_s, mpi_comm_world, imstat)

  ELSE IF(nbc == 2) THEN

    DO i=1,nx-1+si
      tem(i) = var(i,ny-2)
    END DO

    CALL mpi_send(tem,nx,mpi_real,proc(loc_x),                          &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,nx,mpi_real,proc(loc_x),                          &
    !    mptag+tag_s, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsend1dins
!
!##################################################################
!##################################################################
!######                                                      ######
!######               SUBROUTINE MPRECV1DINS                 ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecv1dins(var,nx,ny,nbc,sbc,stagdim,mptag,tem) 2
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Receive north/south boundary data between processors to update the 
!  fake zones.  Fake zone updates are initiated with a call to MPSEND1DINS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    stagdim  Dimension of grid staggering:
!              =0, no staggering;
!              =1, staggered in the x-direction (e.g. u);
!              =2, staggered in the y-direction (e.g. v).
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny             ! Number of grid points in x, and y
                               ! directions
  INTEGER :: nbc,sbc
  INTEGER :: stagdim           ! Dimension of grid staggering:
                               !  =0, no staggering;
                               !  =1, staggered in the x-direction (e.g. u);
                               !  =2, staggered in the y-direction (e.g. v).
  INTEGER :: var(nx,ny)
  INTEGER :: tem(nx+ny)        ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j
  INTEGER :: si,sj

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  si = 0
  sj = 0
  IF (stagdim == 1) si = 1
  IF (stagdim == 2) sj = 1

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x+nproc_x*loc_y),            &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)

    DO i=1,nx-1+si
      var(i,ny-1+sj) = tem(i)
    END DO

  ELSE IF(nbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x),                          &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)


    DO i=1,nx-1+si
      var(i,ny-1+sj) = tem(i)
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x+nproc_x*(loc_y-2)),        &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)

    DO i=1,nx-1+si
      var(i,1) = tem(i)
    END DO

  ELSE IF(sbc == 2) THEN

    CALL mpi_recv(tem,nx,mpi_real,proc(loc_x+nproc_x*(nproc_y-1)),      &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)


    DO i=1,nx-1+si
      var(i,1) = tem(i)
    END DO

  END IF

  RETURN
END SUBROUTINE mprecv1dins
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPSENDEXTEW                ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsendextew(var,nx,ny,nz,ebc,wbc,mptag,tem) 1,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send east/west boundary data between processors to update the fake zones
!  for and extended array which has two instead of one fake zones
!  on each boundary (arrays run from 0:nx,0:ny,0:nz).
!  Fake zone update is completed with a call to MPRECVEXTEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: ebc,wbc
  REAL :: var(0:nx,0:ny,0:nz)
  REAL :: tem((nx+ny+1)*(nz+1)) ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    DO k=0,nz
      DO j=0,ny
        tem(j+1+(ny+1)*k) = var(nx-3,j,k)
      END DO
    END DO

    CALL mpi_send(tem,(ny+1)*(nz+1),mpi_real,  &
        proc(loc_x+1+nproc_x*(loc_y-1)),                                &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(ny+1)*(nz+1),mpi_real,  &
    !    proc(loc_x+1+nproc_x*(loc_y-1)),                                &
    !    mptag+tag_w, mpi_comm_world, imstat)

  ELSE IF(ebc == 2) THEN

    DO k=0,nz
      DO j=0,ny
        tem(j+1+(ny+1)*k) = var(nx-3,j,k)
      END DO
    END DO

    CALL mpi_send(tem,(ny+1)*(nz+1),mpi_real,proc(1+nproc_x*(loc_y-1)),  &
        mptag+tag_w, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(ny+1)*(nz+1),mpi_real,proc(1+nproc_x*(loc_y-1)),  &
    !    mptag+tag_w, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    DO k=0,nz
      DO j=0,ny
        tem(j+1+(ny+1)*k) = var(3,j,k)
      END DO
    END DO

    CALL mpi_send(tem,(ny+1)*(nz+1),mpi_real,  &
        proc(loc_x-1+nproc_x*(loc_y-1)),                                &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(ny+1)*(nz+1),mpi_real,  &
    !    proc(loc_x-1+nproc_x*(loc_y-1)),                                &
    !    mptag+tag_e, mpi_comm_world, imstat)

  ELSE IF(wbc == 2) THEN

    DO k=0,nz
      DO j=0,ny
        tem(j+1+(ny+1)*k) = var(3,j,k)
      END DO
    END DO

    CALL mpi_send(tem,(ny+1)*(nz+1),mpi_real,  &
        proc(nproc_x+nproc_x*(loc_y-1)),                                &
        mptag+tag_e, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(ny+1)*(nz+1),mpi_real,  &
    !    proc(nproc_x+nproc_x*(loc_y-1)),                                &
    !    mptag+tag_e, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsendextew
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPRECVEXTEW                ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecvextew(var,nx,ny,nz,ebc,wbc,mptag,tem) 1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Receive east/west boundary data between processors to update the fake zones
!  for and extended array which has two instead of one fake zones
!  on each boundary (arrays run from 0:nx,0:ny,0:nz).
!  Fake zone updates are initiated with a call to MPSENDEXTEW.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    ebc      East boundary condition
!    wbc      West boundary condition
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: ebc,wbc
  REAL :: var(0:nx,0:ny,0:nz)
  REAL :: tem((nx+ny+1)*(nz+1)) ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

!-----------------------------------------------------------------------
!
!  Set the west boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= 1) THEN

    CALL mpi_recv(tem,(ny+1)*(nz+1),mpi_real,  &
        proc(loc_x-1+nproc_x*(loc_y-1)),                                &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)

    DO k=0,nz
      DO j=0,ny
        var(0,j,k) = tem(j+1+(ny+1)*k)
      END DO
    END DO

  ELSE IF(wbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,(ny+1)*(nz+1),mpi_real,  &
        proc(nproc_x+nproc_x*(loc_y-1)),                                &
        mptag+tag_w, mpi_comm_world, mpi_status, imstat)


    DO k=0,nz
      DO j=0,ny
        var(0,j,k) = tem(j+1+(ny+1)*k)
      END DO
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the east boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_x /= nproc_x) THEN

    CALL mpi_recv(tem,(ny+1)*(nz+1),mpi_real,  &
        proc(loc_x+1+nproc_x*(loc_y-1)),                                &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)

    DO k=0,nz
      DO j=0,ny
        var(nx,j,k) = tem(j+1+(ny+1)*k)
      END DO
    END DO

  ELSE IF(ebc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,(ny+1)*(nz+1),mpi_real,proc(1+nproc_x*(loc_y-1)),  &
        mptag+tag_e, mpi_comm_world, mpi_status, imstat)

    DO k=0,nz
      DO j=0,ny
        var(nx,j,k) = tem(j+1+(ny+1)*k)
      END DO
    END DO

  END IF

  RETURN
END SUBROUTINE mprecvextew
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPSENDEXTNS                ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpsendextns(var,nx,ny,nz,nbc,sbc,mptag,tem) 1,1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Send north/south boundary data between processors to update the fake zones
!  for and extended array which has two instead of one fake zones
!  on each boundary (arrays run from 0:nx,0:ny,0:nz).
!  Fake zone update is completed with a call to MPRECVEXTNS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    tem      Work array.
!
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: nbc,sbc
  REAL :: var(0:nx,0:ny,0:nz)
  REAL :: tem((nx+ny+1)*(nz+1)) ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    DO k=0,nz
      DO i=0,nx
        tem(i+1+(nx+1)*k) = var(i,3,k)
      END DO
    END DO

    CALL mpi_send(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x+nproc_x*(loc_y-2)),  &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x+nproc_x*(loc_y-2)),  &
    !    mptag+tag_n, mpi_comm_world, imstat)

  ELSE IF(sbc == 2) THEN

    DO k=0,nz
      DO i=0,nx
        tem(i+1+(nx+1)*k) = var(i,3,k)
      END DO
    END DO

    CALL mpi_send(tem,(nx+1)*(nz+1),mpi_real,  &
        proc(loc_x+nproc_x*(nproc_y-1)),                                &
        mptag+tag_n, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(nx+1)*(nz+1),mpi_real,  &
    !    proc(loc_x+nproc_x*(nproc_y-1)),                                &
    !    mptag+tag_n, mpi_comm_world, imstat)

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    DO k=0,nz
      DO i=0,nx
        tem(i+1+(nx+1)*k) = var(i,ny-3,k)
      END DO
    END DO

    CALL mpi_send(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x+nproc_x*loc_y),  &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x+nproc_x*loc_y),  &
    !    mptag+tag_s, mpi_comm_world, imstat)

  ELSE IF(nbc == 2) THEN

    DO k=0,nz
      DO i=0,nx
        tem(i+1+(nx+1)*k) = var(i,ny-3,k)
      END DO
    END DO

    CALL mpi_send(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x),  &
        mptag+tag_s, mpi_comm_world, imstat)

    !wdt forced buffering
    !CALL mpi_bsend(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x),  &
    !    mptag+tag_s, mpi_comm_world, imstat)

  END IF

  RETURN
END SUBROUTINE mpsendextns
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPRECVEXTNS                ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mprecvextns(var,nx,ny,nz,nbc,sbc,mptag,tem) 1
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Receive north/south boundary data between processors to update the fake
!  zones for and extended array which has two instead of one fake zones
!  on each boundary (arrays run from 0:nx,0:ny,0:nz).
!  Fake zone updates are initiated with a call to MPSENDEXTNS.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/09/20
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable for which boundaries need updating.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    nbc      North boundary condition
!    sbc      South boundary condition
!
!    mptag     Unique MPI id used for this BC update.
!
!    tem      Work array.
!
!  OUTPUT:
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: nbc,sbc
  REAL :: var(0:nx,0:ny,0:nz)
  REAL :: tem((nx+ny+1)*(nz+1)) ! Work array.

  INTEGER :: mptag             ! Unique MPI id used for this BC update.

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

!-----------------------------------------------------------------------
!
!  Set the north boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= nproc_y) THEN

    CALL mpi_recv(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x+nproc_x*loc_y),  &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)

    DO k=0,nz
      DO i=0,nx
        var(i,ny,k) = tem(i+1+(nx+1)*k)
      END DO
    END DO

  ELSE IF(nbc == 2) THEN         ! Periodic boundary condition.

    CALL mpi_recv(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x),  &
        mptag+tag_n, mpi_comm_world, mpi_status, imstat)


    DO k=0,nz
      DO i=0,nx
        var(i,ny,k) = tem(i+1+(nx+1)*k)
      END DO
    END DO

  END IF

!-----------------------------------------------------------------------
!
!  Set the south boundary conditions
!
!-----------------------------------------------------------------------

  IF(loc_y /= 1) THEN

    CALL mpi_recv(tem,(nx+1)*(nz+1),mpi_real,proc(loc_x+nproc_x*(loc_y-2)),  &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)

    DO k=0,nz
      DO i=0,nx
        var(i,0,k) = tem(i+1+(nx+1)*k)
      END DO
    END DO

  ELSE IF(sbc == 2) THEN

    CALL mpi_recv(tem,(nx+1)*(nz+1),mpi_real,  &
        proc(loc_x+nproc_x*(nproc_y-1)),                                &
        mptag+tag_s, mpi_comm_world, mpi_status, imstat)


    DO k=0,nz
      DO i=0,nx
        var(i,0,k) = tem(i+1+(nx+1)*k)
      END DO
    END DO

  END IF

  RETURN
END SUBROUTINE mprecvextns
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPUPDATER                  ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpupdater(var,num) 105
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Broadcast the value of var from process 0 to all other processes.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/24
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT/OUTPUT :
!
!    var      Array to update (INPUT on proc 0, OUTPUT for rest).
!    num      Number of elements in the array.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: num
  REAL :: var(num)

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: imstat

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  CALL mpi_bcast(var,num,mpi_real,0,mpi_comm_world,imstat)
  IF (imstat /= 0) THEN
    WRITE (6,*) "MPUPDATER: error on processor",myproc
  END IF

  RETURN
END SUBROUTINE mpupdater
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPUPDATEI                  ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpupdatei(var,num) 142
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Broadcast the value of var from process 0 to all other processes.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/24
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT/OUTPUT :
!
!    var      Variable to update (INPUT on proc 0, OUTPUT for rest).
!    num      Number of elements in the array.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: num
  INTEGER :: var(num)

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: imstat

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  CALL mpi_bcast(var,num,mpi_integer,0,mpi_comm_world,imstat)
  IF (imstat /= 0) THEN
    WRITE (6,*) "MPUPDATEI: error on processor",myproc
  END IF

  RETURN
END SUBROUTINE mpupdatei
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPUPDATEC                  ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!


SUBROUTINE mpupdatec(str,lenstr) 14
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Broadcast the string str from process 0 to all other processes.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Gene Bassett
!  2000/04/24
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT/OUTPUT :
!
!    str      String to update (INPUT on proc 0, OUTPUT for rest).
!    lenstr   Length of str.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: lenstr
  CHARACTER (LEN=lenstr) :: str

!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  INTEGER :: imstat

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  CALL mpi_bcast(str,lenstr,mpi_character,0,mpi_comm_world,imstat)
  IF (imstat /= 0) THEN
    WRITE (6,*) "MPUPDATEC: error on processor",myproc
  END IF

  RETURN
END SUBROUTINE mpupdatec

 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     Miscellaneous MPI subroutines (not in ARPS standard format)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!


SUBROUTINE mpexit(errcode) 2

  IMPLICIT NONE

  INCLUDE 'mpif.h'
  INTEGER :: errcode
  INTEGER :: imstat

  IF (errcode == 0) THEN
    CALL mpi_finalize (imstat)
  ELSE
    CALL mpi_abort (mpi_comm_world, errcode, imstat)
  ENDIF

  RETURN
END SUBROUTINE mpexit



SUBROUTINE inctag 10

  IMPLICIT NONE

  INCLUDE 'mp.inc'

  IF (gentag < 100 .OR. gentag > 60000) gentag = 100
  gentag = gentag + 100

  RETURN
END SUBROUTINE inctag



SUBROUTINE mpbarrier 26

  INCLUDE 'mpif.h'
  INTEGER :: imstat

  CALL mpi_barrier (mpi_comm_world, imstat)

  RETURN
END SUBROUTINE mpbarrier




SUBROUTINE mptotal(var) 14

  IMPLICIT NONE

  INCLUDE 'mpif.h'

  REAL :: var, vartm
  INTEGER :: i,j,imstat

  CALL mpi_allreduce (var, vartm, 1, mpi_real, mpi_sum,                 &
       mpi_comm_world, imstat)

  var = vartm

  RETURN
END SUBROUTINE mptotal

!  subroutine mpmax0(amax,amin)

!  implicit none

!  include 'mpif.h'
!  include 'par.inc'

!  real amin, amax
!  real amintm, amaxtm

!  call mpi_allreduce (amax, amaxtm, 1, MPI_REAL, MPI_MAX,
!    :     MPI_COMM_WORLD, imstat)

!  amax = amaxtm

!  call mpi_allreduce (amin, amintm, 1, MPI_REAL, MPI_MIN,
!    :     MPI_COMM_WORLD, imstat)

!  amin = amintm

!  return
!  end



SUBROUTINE mpmax0(amax,amin) 3

!
!  Modified by Dan Weber, May 4, 1998
!  Replaces code above for use on t3d/t3e system.
!  mpi_allreduce is not working properly...
!
  IMPLICIT NONE

  INTEGER :: itema,itemb
  REAL :: amax,amin
  INTEGER :: imstat

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'

  REAL :: maxtm, mintm
!
!    start of executable code....
!

!  CALL mpi_allreduce (amax, maxtm, 1, MPI_REAL, MPI_MAX,
!    :     MPI_COMM_WORLD, imstat)  ! commented out because the T3E
                                 ! has trouble with mpi_allreduce
  CALL mpi_reduce(amax,maxtm,1,mpi_real,mpi_max,0,                      &
                  mpi_comm_world,imstat)
  CALL mpi_bcast(maxtm,1,mpi_real,0,mpi_comm_world,imstat)

  amax = maxtm

!  CALL mpi_allreduce (amin, mintm, 1, MPI_REAL, MPI_MIN,
!    :     MPI_COMM_WORLD, imstat)  ! commented out because the T3E
                                 ! has trouble with mpi_allreduce
  CALL mpi_reduce(amin,mintm,1,mpi_real,mpi_min,0,                      &
                  mpi_comm_world,imstat)
  CALL mpi_bcast(mintm,1,mpi_real,0,mpi_comm_world,imstat)

  amin = mintm

  RETURN
END SUBROUTINE mpmax0


SUBROUTINE mpmax(amax,amin,nx,ny,nz,imax,jmax,kmax,imin,jmin,kmin) 1,1

!
!  Modified by Dan Weber, October 23, 1997
!

  IMPLICIT NONE

  INTEGER :: nx,ny,nz,imax,jmax,kmax,imin,jmin,kmin,itema,itemb
  REAL :: amax,amin
  INTEGER :: imstat

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

  INTEGER :: mpi_status(mpi_status_size)
  REAL :: maxarr (2), minarr(2)
  REAL :: maxtm  (2), mintm(2)
  INTEGER :: maxpack (3), maxunpack(3)
  INTEGER :: minpack (3), minunpack(3)

!
!    start of executable code....
!

  CALL inctag
  maxtm(1) = 0.0
  maxtm(2) = 0.0
  maxarr(1) = amax
  maxarr(2) = FLOAT(myproc)
!  CALL mpi_allreduce (maxarr, maxtm, 1, MPI_2REAL, MPI_MAXLOC,
!    :     MPI_COMM_WORLD, imstat)  ! commented out because the T3E
                                 ! has trouble with mpi_allreduce
  CALL mpi_reduce(maxarr,maxtm,1,mpi_2real,mpi_maxloc,0,                &
                  mpi_comm_world,imstat)
  CALL mpi_bcast(maxtm,1,mpi_2real,0,                                   &
                 mpi_comm_world,imstat)

  itema = nint(maxtm(2))
  IF(myproc == itema.AND.itema /= 0)THEN    ! send only if
    maxpack(1) = imax + (nx-3)*(loc_x-1)  ! itema .ne. myproc=0!!!
    maxpack(2) = jmax + (ny-3)*(loc_y-1)
    maxpack(3) = kmax
    CALL mpi_send (maxpack,3,mpi_integer,0,                             &
                   gentag,mpi_comm_world,imstat)
    !wdt forced buffering
    !CALL mpi_bsend (maxpack,3,mpi_integer,0,                             &
    !               gentag,mpi_comm_world,imstat)

  END IF

  IF(myproc == 0.AND.myproc /= itema)THEN ! receive only if
                                          ! itema .ne. myproc=0
    CALL mpi_recv (maxunpack,3,mpi_integer,itema,                       &
                   gentag,mpi_comm_world,mpi_status,imstat)
    imax = maxunpack(1)
    jmax = maxunpack(2)
    kmax = maxunpack(3)
    amax = maxtm(1)
  END IF


  mintm(1) = 0.0
  mintm(2) = 0.0
  minarr(1) = amin
  minarr(2) = FLOAT(myproc)

!  CALL mpi_allreduce (minarr, mintm, 1, MPI_2REAL, MPI_MINLOC,
!    :     MPI_COMM_WORLD, imstat)  ! commented out because the T3E
                                 ! has trouble with mpi_allreduce
  CALL mpi_reduce(minarr,mintm,1,mpi_2real,mpi_minloc,0,                &
                  mpi_comm_world,imstat)
  CALL mpi_bcast(mintm,1,mpi_2real,0,                                   &
                 mpi_comm_world,imstat)

  itemb = nint(mintm(2))
  IF(myproc == itemb.AND.itemb /= 0)THEN    ! send only if
    minpack(1) = imin + (nx-3)*(loc_x-1)  ! itema .ne. myproc=0!!!
    minpack(2) = jmin + (ny-3)*(loc_y-1)
    minpack(3) = kmin
    CALL mpi_send (minpack,3,mpi_integer,0,                             &
                     gentag+1,mpi_comm_world,imstat)
    !wdt forced buffering
    !CALL mpi_bsend (minpack,3,mpi_integer,0,                             &
    !                 gentag+1,mpi_comm_world,imstat)
  END IF

  IF(myproc == 0.AND.myproc /= itemb)THEN ! receive only if
                                          ! itemb .ne. myproc=0
    CALL mpi_recv (minunpack,3,mpi_integer,itemb,                       &
                     gentag+1,mpi_comm_world,mpi_status,imstat)
    imin = minunpack(1)
    jmin = minunpack(2)
    kmin = minunpack(3)
    amin = mintm(1)
  END IF

  RETURN
END SUBROUTINE mpmax


SUBROUTINE mpinit_proc 2

  IMPLICIT NONE

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'

  INTEGER :: imstat

  mp_opt = 1

  CALL mpi_init( imstat )

  CALL mpi_comm_rank( mpi_comm_world, myproc, imstat )

  RETURN
END SUBROUTINE mpinit_proc


SUBROUTINE mpinit_var 2

  IMPLICIT NONE

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'bndry.inc'
  INCLUDE 'mp.inc'

  INTEGER :: i,j,k,l,numg,parent
  INTEGER :: mytid,nprocs0
  INTEGER :: imstat

  CALL mpi_comm_size( mpi_comm_world, nprocs0, imstat )

  nprocs = nproc_x * nproc_y

  IF(nprocs > max_proc) THEN

    WRITE (6,*) "ERROR: number of processors exceeds maximum ",     &
                "specified in mp.inc:"
    WRITE (6,*) "nprocs =",nprocs
    WRITE (6,*) "max_proc (in mp.inc) =",max_proc
    CALL arpsstop ("arpsstop called from mpinit_var mismatch in   &
                   & number of processors-too many",1)

  END IF

!
!  This subroutine defines the proc(nproc_x+nproc_x*(nproc_y-1)) array
!  and the myproc variable for each process.
!
  IF(nprocs /= nprocs0)THEN  ! test to see if the input file
                             ! number of processors = nprocs
                             ! and set on the command line.
    IF(myproc == 0)THEN
      PRINT *,'Number of processors chosen on the command line '
      PRINT *,'is different from that given in arps.input, EXITING'
      PRINT *,'requested: ', nprocs0
      PRINT *,'in arps.input: ', nprocs, ' = ',nproc_x,' * ',nproc_y
    END IF
    CALL arpsstop ("arpsstop called from mpinit_var mismatch in   &
                   & number of processors",1)

  END IF

  l = 0
  DO j = 1, nproc_y
    DO i = 1, nproc_x
      proc(i+nproc_x*(j-1)) = l
      l = l + 1
    END DO
  END DO

  loc_x = MOD(myproc, nproc_x) + 1
  loc_y = myproc / nproc_x + 1

  gentag = 0

  RETURN
END SUBROUTINE mpinit_var
!
!##################################################################
!##################################################################
!######                                                      ######
!######                SUBROUTINE MPIMERGE                   ######
!######                                                      ######
!######                     Developed by                     ######
!######     Center for Analysis and Prediction of Storms     ######
!######                University of Oklahoma                ######
!######                                                      ######
!##################################################################
!##################################################################
!

SUBROUTINE mpimerge(locvar,nx,ny,nz,nt,char1,length,tem1),2
!
!-----------------------------------------------------------------------
!
!  PURPOSE:
!
!  Generate global data files from a multiprocessor run to be compared 
!  with a single processor file.
!
!-----------------------------------------------------------------------
!
!
!  AUTHOR: Dan Weber
!  2001/04/11
!
!  MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
!  INPUT :
!
!    var      Variable to be written.
!
!    nx       Number of grid points in the x-direction (east/west)
!    ny       Number of grid points in the y-direction (north/south)
!    nz       Number of grid points in the vertical
!
!    tem      Work array.
!
!    char1    filename.
!  OUTPUT:
!
!    mptag     Unique MPI id used for this BC update.
!
!-----------------------------------------------------------------------
!
!  Variable declarations.
!
!-----------------------------------------------------------------------

  IMPLICIT NONE

  INTEGER :: nx,ny,nz          ! Number of grid points in x, y and z
                               ! directions
  INTEGER :: nt
  INTEGER :: length            ! Character string length
  REAL :: locvar(nx,ny,nz,nt)
  REAL :: tem1(nx,ny,nz)

  INTEGER :: mptag             ! Unique MPI id used for this BC update.
  INTEGER :: ia,ja, ic,jc,itemc,itemb,itema,fzone
  CHARACTER*80 :: char1
!-----------------------------------------------------------------------
!
!  Include files.
!
!-----------------------------------------------------------------------

  INCLUDE 'mpif.h'
  INCLUDE 'globcst.inc'
  INCLUDE 'mp.inc'
  INTEGER :: stat(mpi_status_size)

!-----------------------------------------------------------------------
!
!  Local variable declarations.
!
!-----------------------------------------------------------------------

  REAL :: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nz)   ! Work array.
  INTEGER :: mpi_status(mpi_status_size)
  INTEGER :: imstat
  INTEGER :: i, j, k
  INTEGER :: si,sj,sk

!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!  Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

  CALL inctag
  mptag = gentag

!-----------------------------------------------------------------------
!
!  fill the globvar array
!
!-----------------------------------------------------------------------

  fzone = 3 !  arps.

  DO k=1,nz        ! each processor stores the locvar into tem1
    DO j=1,ny
      DO i=1,nx
        tem1(i,j,k) = locvar(i,j,k,nt)
      END DO
    END DO
  END DO
 
  DO jc=1,nproc_y
  DO ic=1,nproc_x

!   message passing section...

    itemb = mptag + 100 + ic + jc
    IF(ic /=1 .or. jc /=1)THEN     !  pass data to processor 0
      IF(myproc.eq.(ic+(jc-1)*nproc_x-1))THEN
      itema = 0 
!     print *,'sending data',itema,itemb,myproc
      call mpi_send (tem1,nx*ny*nz,MPI_REAL,itema,  &
                       itemb,MPI_COMM_WORLD,imstat) 
      !wdt forced buffering
      !call mpi_bsend (tem1,nx*ny*nz,MPI_REAL,itema,  &
      !                 itemb,MPI_COMM_WORLD,imstat) 
      END IF

      itemc = ic+(jc-1)*nproc_x-1
      IF(myproc == 0)THEN            ! receive data
!     print *,'receiving data',itemc,itemb,myproc
        call mpi_recv (tem1,nx*ny*nz,MPI_REAL,itemc,  &
                       itemb,MPI_COMM_WORLD,stat,imstat)
      END IF

    END IF

!  storage section

    IF(myproc == 0)THEN  ! store data into globvar

      DO k=1,nz
        DO j=1,ny
          ja = j + (jc-1)*(ny-fzone)
          DO i=1,nx
            ia = i + (ic-1)*(nx-fzone)
!           print *,ic,jc,ia,ja,i,j,k
            globvar(ia,ja,k) = tem1(i,j,k)
          END DO          
        END DO      
      END DO      

    END IF

    call mpbarrier

  END DO      
  END DO      

  IF(myproc ==0 ) THEN   !  write the file.....

     write(char1(length+1:length+5),'(a5)')  '.form'
!    itemc = 80
!    CALL strlnth(char1,itemc)
!    CALL comlnth(char1,itemc)
!    print *,'inside mpimerge', length,char1(1:length+5)
     open(10,file=char1(1:length+5),form= 'formatted',status='unknown')
     DO k=1,nz
     DO j=1,(ny-3)*nproc_y+3
     DO i=1,(nx-3)*nproc_x+3
     write(10,'(3(i5),2x,g17.11)') i,j,k,globvar(i,j,k)
     END DO
     END DO
     END DO
     close (10)

     write(char1(length+1:length+7),'(a7)')  '.unform'
!    itemc = 80
!    CALL comlnth(char1,itemc)
!    CALL strlnth(char1,itemc)
!    print *,'inside mpimerge', itemc,length,char1(1:itemc)
!    print *,'inside mpimerge', length,char1(1:length+7)
     open(11,file=char1(1:length+7),form= 'unformatted',status='unknown')
     write (11) globvar
     close (11)

  END IF

   RETURN
END SUBROUTINE mpimerge