!
!##################################################################
!##################################################################
!###### ######
!###### 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) 68,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) 68
!
!-----------------------------------------------------------------------
!
! 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) 68,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) 68
!
!-----------------------------------------------------------------------
!
! 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) 22,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) 22
!
!-----------------------------------------------------------------------
!
! 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) 22,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) 22
!
!-----------------------------------------------------------------------
!
! 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) 611
!
!-----------------------------------------------------------------------
!
! 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) 1162
!
!-----------------------------------------------------------------------
!
! 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) 45
!
!-----------------------------------------------------------------------
!
! 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) 9
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 33
IMPLICIT NONE
INCLUDE 'mp.inc'
IF (gentag < 100 .OR. gentag > 60000) gentag = 100
gentag = gentag + 100
RETURN
END SUBROUTINE inctag
SUBROUTINE mpbarrier 48
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) 9
!
! 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 3
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 3
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
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE1dx ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge1dx(locvar,nx,globvar) 5,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar Variable to be written.
!
! nx Dimension of the array
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: nx
REAL, INTENT(IN) :: locvar(nx)
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
REAL, INTENT(OUT):: globvar((nx-3)*nproc_x+3)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(nx)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia, ic,jc, i0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:) = locvar(:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(jc == 1) THEN
IF(ic /= 1) THEN ! pass data to processor 0
mytag = mptag + 100 + ic + 1
IF( myproc == ic-1 )THEN
CALL mpi_send (tem,nx,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny*nz,MPI_REAL,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = ic - 1
CALL mpi_recv (tem,nx,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia) = tem(i)
END DO
END IF
END IF ! jc == 1
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge1dx
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE1dy ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge1dy(locvar,ny,globvar) 5,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar Variable to be written.
!
! ny Dimension of the array
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: ny
REAL, INTENT(IN) :: locvar(ny)
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
REAL, INTENT(OUT):: globvar((ny-3)*nproc_y+3)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(ny)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ja, ic,jc, j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: j
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:) = locvar(:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic == 1) THEN
IF(jc /= 1) THEN ! pass data to processor 0
mytag = mptag + 100 + jc + 1
IF(myproc == (jc-1)*nproc_x )THEN
CALL mpi_send (tem,ny,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny*nz,MPI_REAL,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = (jc-1)*nproc_x
CALL mpi_recv (tem,ny,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
globvar(ja) = tem(j)
END DO
END IF
END IF ! ic == 1
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge1dy
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE2D ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge2d(locvar,nx,ny,globvar) 46,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar 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)
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: nx,ny
! Number of grid points in x, y and z
REAL, INTENT(IN) :: locvar(nx,ny)
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
REAL, INTENT(OUT):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(nx,ny)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia,ja, ic,jc, i0,j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:) = locvar(:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! pass data to processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_send (tem,nx*ny,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny,MPI_REAL,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = ic+(jc-1)*nproc_x-1
CALL mpi_recv (tem,nx*ny,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia,ja) = tem(i,j)
END DO
END DO
END IF
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge2d
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE2di ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge2di(locvar,nx,ny,globvar) 4,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar 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)
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny
! Number of grid points in x, y and z
INTEGER, INTENT(IN) :: locvar(nx,ny)
INTEGER, INTENT(OUT):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER :: tem(nx,ny)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia,ja, ic,jc, i0,j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:) = locvar(:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! pass data to processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_send (tem,nx*ny,MPI_INTEGER,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny,MPI_INTEGER,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = ic+(jc-1)*nproc_x-1
CALL mpi_recv (tem,nx*ny,MPI_INTEGER,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia,ja) = tem(i,j)
END DO
END DO
END IF
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge2di
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE3d ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge3d(locvar,nx,ny,nz,globvar) 195,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar 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
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: nx,ny,nz
! Number of grid points in x, y and z
REAL, INTENT(IN) :: locvar(nx,ny,nz)
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
REAL, INTENT(OUT):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nz)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(nx,ny,nz)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia,ja, ic,jc, i0,j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j, k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:,:) = locvar(:,:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! pass data to processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_send (tem,nx*ny*nz,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny*nz,MPI_REAL,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = ic+(jc-1)*nproc_x-1
CALL mpi_recv (tem,nx*ny*nz,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO k=1,nz
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia,ja,k) = tem(i,j,k)
END DO
END DO
END DO
END IF
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge3d
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE3di ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge3di(locvar,nx,ny,nz,globvar) 8,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar 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
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny,nz
! Number of grid points in x, y and z
INTEGER, INTENT(IN) :: locvar(nx,ny,nz)
INTEGER, INTENT(OUT):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nz)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER :: tem(nx,ny,nz)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia,ja, ic,jc, i0,j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j, k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:,:) = locvar(:,:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! pass data to processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_send (tem,nx*ny*nz,MPI_INTEGER,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny*nz,MPI_INTEGER,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = ic+(jc-1)*nproc_x-1
CALL mpi_recv (tem,nx*ny*nz,MPI_INTEGER,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO k=1,nz
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia,ja,k) = tem(i,j,k)
END DO
END DO
END DO
END IF
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge3di
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE4d ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge4d(locvar,nx,ny,nzsoil,nstyps,globvar) 9,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/15
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar 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
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny,nzsoil, nstyps
! Number of grid points in x, y and z
REAL, INTENT(IN) :: locvar(nx,ny,nzsoil,nstyps)
REAL, INTENT(OUT):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nzsoil,nstyps)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(nx,ny,nzsoil,nstyps)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia,ja, ic,jc, i0,j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j, k, n
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:,:,:) = locvar(:,:,:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! pass data to processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_send (tem,nx*ny*nzsoil*nstyps,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
!CALL mpi_bsend (tem,nx*ny*nz,MPI_REAL,master, &
! mytag,MPI_COMM_WORLD,imstat)
!forced buffering
END IF
IF(myproc == 0)THEN ! receive data
source = ic+(jc-1)*nproc_x-1
CALL mpi_recv (tem,nx*ny*nzsoil*nstyps,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO n=1,nstyps
DO k=1,nzsoil
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia,ja,k,n) = tem(i,j,k,n)
END DO
END DO
END DO
END DO
END IF
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge4d
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT1DX ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit1dx(globvar,nx,var) 3,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Dimension of the array in subdomain.
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx
REAL, INTENT(IN):: globvar((nx-3)*nproc_x+3)
REAL, INTENT(OUT) :: var(nx)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into var
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i) = globvar(ia)
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /= 1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:) = globvar(1:nx)
RETURN
END SUBROUTINE mpisplit1dx
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT1DY ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit1dy(globvar,ny,var) 3,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! ny Number of grid points in the y-direction (north/south)
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: ny
REAL, INTENT(IN):: globvar((ny-3)*nproc_y+3)
REAL, INTENT(OUT) :: var(ny)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: j
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into tem
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
var(j) = globvar(ja)
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,ny,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,ny,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:) = globvar(1:ny)
RETURN
END SUBROUTINE mpisplit1dy
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT2d ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit2d(globvar,nx,ny,var) 16,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny
! Number of grid points in x and y
REAL, INTENT(IN):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3)
REAL, INTENT(OUT) :: var(nx,ny)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into var
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i,j) = globvar(ia,ja)
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx*ny,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx*ny,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:) = globvar(1:nx,1:ny)
RETURN
END SUBROUTINE mpisplit2d
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT2DI ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit2di(globvar,nx,ny,var) 2,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny
! Number of grid points in x and y
INTEGER, INTENT(IN):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3)
INTEGER, INTENT(OUT) :: var(nx,ny)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into tem
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i,j) = globvar(ia,ja)
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx*ny,MPI_INTEGER,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx*ny,MPI_INTEGER,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:) = globvar(1:nx,1:ny)
RETURN
END SUBROUTINE mpisplit2di
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT3d ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit3d(globvar,nx,ny,nz,var) 222,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz 3rd dimension of the subdomain array, possible value are
! vertical grid points (nz in other subroutines), nzsoil,
! nstyps+1, or 4 (prcrate) or 1 (for 2D arrays)
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny,nz
! Number of grid points in x, y and z
REAL, INTENT(IN):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nz)
REAL, INTENT(OUT) :: var(nx,ny,nz)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j, k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into tem
DO k=1,nz
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i,j,k) = globvar(ia,ja,k)
END DO
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx*ny*nz,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx*ny*nz,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:,:) = globvar(1:nx,1:ny,1:nz)
RETURN
END SUBROUTINE mpisplit3d
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT3DI ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit3di(globvar,nx,ny,nz,var) 14,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz 3rd dimension of the subdomain array, possible value are
! vertical grid points (nz in other subroutines), nzsoil,
! nstyps+1, or 4 (prcrate) or 1 (for 2D arrays)
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny,nz
! Number of grid points in x, y and z
INTEGER, INTENT(IN):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nz)
INTEGER, INTENT(OUT) :: var(nx,ny,nz)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j, k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into var
DO k=1,nz
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i,j,k) = globvar(ia,ja,k)
END DO
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx*ny*nz,MPI_INTEGER,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx*ny*nz,MPI_INTEGER,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:,:) = globvar(1:nx,1:ny,1:nz)
RETURN
END SUBROUTINE mpisplit3di
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT4d ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit4d(globvar,nx,ny,nzsoil,nstyps,var) 9,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nzsoil 3rd dimension of the subdomain array, possible value may be
! as nzsoil in other subroutines.
! nstyps 4rd dimentsion of the 4D array, possible value may be
! nstyps (in other subroutines) + 1.
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx,ny,nzsoil, nstyps
REAL, INTENT(IN):: globvar((nx-3)*nproc_x+3,(ny-3)*nproc_y+3,nzsoil,nstyps)
REAL, INTENT(OUT) :: var(nx,ny,nzsoil,nstyps)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i, j, k, l
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into tem
DO l=1,nstyps
DO k=1,nzsoil
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i,j,k,l) = globvar(ia,ja,k,l)
END DO
END DO
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx*ny*nzsoil*nstyps,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx*ny*nzsoil*nstyps,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:,:,:) = globvar(1:nx,1:ny,1:nzsoil,1:nstyps)
RETURN
END SUBROUTINE mpisplit4d
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE2dns ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge2dns(locvar,nx,nz,globvar) 4,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run.
! for North/South boundary 2D array.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2003/02/25
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar Variable to be written.
!
! nx Local dimension of the array
! nz This dimension will not change.
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: nx
INTEGER, INTENT(IN) :: nz
REAL, INTENT(IN) :: locvar(nx,nz)
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
REAL, INTENT(OUT):: globvar((nx-3)*nproc_x+3,nz)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(nx,nz)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ia, ic,jc, i0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i,k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:) = locvar(:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(jc == 1) THEN
IF(ic /= 1) THEN ! pass data to processor 0
mytag = mptag + 100 + ic + 1
IF( myproc == ic-1 )THEN
CALL mpi_send (tem,nx*nz,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
END IF
IF(myproc == 0)THEN ! receive data
source = ic - 1
CALL mpi_recv (tem,nx*nz,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (ic == 1) THEN
i0 = 1
ELSE
i0 = 2
END IF
DO k=1,nz
DO i=i0,nx
ia = i + (ic-1)*(nx-fzone)
globvar(ia,k) = tem(i,k)
END DO
END DO
END IF
END IF ! jc == 1
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge2dns
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPIMERGE2dew ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpimerge2dew(locvar,ny,nz,globvar) 4,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Generate global array from a multiprocessor run
! for East/West boundary 2D array.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2003/02/25
! Based on subroutine mpimerge
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! localvar Variable to be written.
!
! ny Dimension of the array
! nz
!
! OUTPUT:
!
! globvar global variable to be output
!
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
INTEGER, INTENT(IN) :: ny
INTEGER, INTENT(IN) :: nz
REAL, INTENT(IN) :: locvar(ny,nz)
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
REAL, INTENT(OUT):: globvar((ny-3)*nproc_y+3,nz)
! Output array in global domain.
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
REAL :: tem(ny,nz)
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER, PARAMETER :: master = 0
INTEGER :: source
INTEGER :: ja, ic,jc, j0, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: j,k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
tem(:,:) = locvar(:,:) ! each processor stores the locvar into tem
DO jc=1,nproc_y
DO ic=1,nproc_x
! message passing section...
IF(ic == 1) THEN
IF(jc /= 1) THEN ! pass data to processor 0
mytag = mptag + 100 + jc + 1
IF(myproc == (jc-1)*nproc_x )THEN
CALL mpi_send (tem,ny*nz,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,imstat)
END IF
IF(myproc == 0)THEN ! receive data
source = (jc-1)*nproc_x
CALL mpi_recv (tem,ny*nz,MPI_REAL,source, &
mytag, MPI_COMM_WORLD,stat,imstat)
END IF
END IF
! storage section
IF(myproc == 0)THEN ! store data into globvar
IF (jc == 1) THEN
j0 = 1
ELSE
j0 = 2
END IF
DO k=1,nz
DO j=j0,ny
ja = j + (jc-1)*(ny-fzone)
globvar(ja,k) = tem(j,k)
END DO
END DO
END IF
END IF ! ic == 1
CALL mpbarrier
END DO
END DO
RETURN
END SUBROUTINE mpimerge2dew
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT2DNS ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit2dns(globvar,nx,nz,var) 4,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
! for North/South boundary arrays.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2003/02/26
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! nx Dimension of the array in subdomain.
! nz
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: nx
INTEGER, INTENT(IN) :: nz
REAL, INTENT(IN):: globvar((nx-3)*nproc_x+3,nz)
REAL, INTENT(OUT) :: var(nx,nz)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ia,ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: i,k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into var
DO k=1,nz
DO i=1,nx
ia = i + (ic-1)*(nx-fzone)
var(i,k) = globvar(ia,k)
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /= 1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,nx*nz,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,nx*nz,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:) = globvar(1:nx,:)
RETURN
END SUBROUTINE mpisplit2dns
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MPISPLIT2DEW ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mpisplit2dew(globvar,ny,nz,var) 4,2
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Split the global array and scatter to each processor.
!
!-----------------------------------------------------------------------
!
!
! AUTHOR: Yunheng Wang
! 2002/08/20
!
! MODIFICATION HISTORY:
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! globvar Global array passed in from processor 0.
!
! ny Number of grid points in the y-direction (north/south)
! nz
!
! OUTPUT:
!
! var Subdomain variable in each process.
!
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
!
! Include files.
!
!-----------------------------------------------------------------------
INCLUDE 'mpif.h'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc'
!-----------------------------------------------------------------------
!
! Variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, INTENT(IN) :: ny
INTEGER, INTENT(IN) :: nz
REAL, INTENT(IN):: globvar((ny-3)*nproc_y+3,nz)
REAL, INTENT(OUT) :: var(ny,nz)
!-----------------------------------------------------------------------
!
! Local variable declarations.
!
!-----------------------------------------------------------------------
INTEGER, PARAMETER :: master = 0
INTEGER :: mptag ! Unique MPI id.
INTEGER :: mytag
INTEGER :: target
INTEGER :: ja, ic,jc, fzone
INTEGER :: stat(mpi_status_size)
INTEGER :: imstat
INTEGER :: j,k
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
CALL inctag
mptag = gentag
!-----------------------------------------------------------------------
!
! fill the globvar array
!
!-----------------------------------------------------------------------
fzone = 3 ! arps.
DO jc=1,nproc_y
DO ic=1,nproc_x
! storage section
IF(myproc == 0)THEN ! store data into tem
DO k = 1,nz
DO j=1,ny
ja = j + (jc-1)*(ny-fzone)
var(j,k) = globvar(ja,k)
END DO
END DO
END IF
! message passing section...
IF(ic /=1 .OR. jc /=1)THEN ! receive data from processor 0
mytag = mptag + 100 + ic + jc
IF(myproc == 0)THEN ! send data
target = ic+(jc-1)*nproc_x-1
CALL mpi_send (var,ny*nz,MPI_REAL,target, &
mytag, MPI_COMM_WORLD,imstat)
END IF
IF(myproc == (ic+(jc-1)*nproc_x-1))THEN
CALL mpi_recv (var,ny*nz,MPI_REAL,master, &
mytag,MPI_COMM_WORLD,stat,imstat)
END IF
END IF
CALL mpbarrier
END DO
END DO
!At the end, make sure processor 0 contains correct varlue (ic=1,jc=1)
IF(myproc == 0) var(:,:) = globvar(1:ny,:)
RETURN
END SUBROUTINE mpisplit2dew
!
!
!######################################################################
!
! Wrap subroutines added for ARPSPLT_mpi
!
! mpsendr -- CALL mpi_send, REAL array
! mprecvr -- CALL mpi_recv, REAL array
! mpsendi -- CALL mpi_send, INTEGER scalar
! mprecvi -- CALL mpi_recv, INTEGER scalar
!
!#####################################################################
SUBROUTINE mpsendr(a,size,dest,itag,ierror) 19
IMPLICIT NONE
INCLUDE 'mpif.h'
INTEGER :: size, dest, itag, ierror
REAL :: a(size)
CALL mpi_send(a,size,MPI_REAL,dest,itag,MPI_COMM_WORLD,ierror)
RETURN
END SUBROUTINE mpsendr
SUBROUTINE mpsendi(m,dest,itag,ierror) 8
IMPLICIT NONE
INCLUDE 'mpif.h'
INTEGER :: m
INTEGER :: dest, itag, ierror
CALL mpi_send(m,1,MPI_INTEGER,dest,itag,MPI_COMM_WORLD,ierror)
RETURN
END SUBROUTINE mpsendi
SUBROUTINE mprecvr(a,size,source,itag,ierror) 19
IMPLICIT NONE
INCLUDE 'mpif.h'
INTEGER :: size, source, itag, ierror
REAL :: a(size)
INTEGER :: stat(MPI_STATUS_SIZE)
CALL mpi_recv(a,size,MPI_REAL,source,itag,MPI_COMM_WORLD,stat,ierror)
RETURN
END SUBROUTINE mprecvr
SUBROUTINE mprecvi(m,source,itag,ierror) 8
IMPLICIT NONE
INCLUDE 'mpif.h'
INTEGER :: m
INTEGER :: size, source, itag, ierror
INTEGER :: stat(MPI_STATUS_SIZE)
CALL mpi_recv(m,1,MPI_INTEGER,source,itag,MPI_COMM_WORLD,stat,ierror)
RETURN
END SUBROUTINE mprecvi
SUBROUTINE mpmaxi(imax) 4
!
! Find the maximum integer of all processors
!
IMPLICIT NONE
REAL :: imax
INTEGER :: imstat
INCLUDE 'mpif.h'
REAL :: maxtm
!---------------------------------------------------------
!
! Start of executable code....
!
!---------------------------------------------------------
CALL MPI_REDUCE(imax,maxtm,1,MPI_INTEGER,MPI_MAX,0, &
MPI_COMM_WORLD,imstat)
CALL MPI_BCAST(maxtm,1,MPI_REAL,0,MPI_COMM_WORLD,imstat)
imax = maxtm
RETURN
END SUBROUTINE mpmaxi