!
!##################################################################
!##################################################################
!###### ######
!###### 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