excjs Subroutine

public subroutine excjs(a, sx, ex, sy, ey, sz, ez, ih, jh)

Arguments

Type IntentOptional Attributes Name
real :: a(sx-ih:ex+ih,sy-jh:ey+jh,sz:ez)
integer :: sx
integer :: ex
integer :: sy
integer :: ey
integer :: sz
integer :: ez
integer :: ih
integer :: jh

Calls

proc~~excjs~~CallsGraph proc~excjs excjs mpi_isend mpi_isend proc~excjs->mpi_isend mpi_recv mpi_recv proc~excjs->mpi_recv mpi_wait mpi_wait proc~excjs->mpi_wait

Called by

proc~~excjs~~CalledByGraph proc~excjs excjs proc~readinletfile readinletfile proc~readinletfile->proc~excjs proc~inletgen inletgen proc~inletgen->proc~readinletfile proc~inletgennotemp inletgennotemp proc~inletgennotemp->proc~readinletfile proc~readinitfiles readinitfiles proc~readinitfiles->proc~readinletfile program~dalesurban DALESURBAN program~dalesurban->proc~readinitfiles

Source Code

subroutine excjs(a,sx,ex,sy,ey,sz,ez,ih,jh)
  implicit none
  integer sx, ex, sy, ey, sz, ez, ih, jh
  real a(sx-ih:ex+ih, sy-jh:ey+jh, sz:ez)
  integer status(MPI_STATUS_SIZE)
  integer ii, i, j, k
  integer reqn, reqs
  integer nssize
  real,allocatable, dimension(:) :: sendn,recvn
  real,allocatable, dimension(:) :: sends,recvs

!   Calculate buffer size
  nssize = jh*(ex - sx + 1 + 2*ih)*(ez - sz + 1)

!   Allocate send / receive buffers
  allocate(sendn(nssize),sends(nssize))
  allocate(recvn(nssize),recvs(nssize))

  if(nprocy .gt. 1)then
    !   Send north/south
    ii = 0
    do j=1,jh
    do k=sz,ez
    do i=sx-ih,ex+ih
      ii = ii + 1
      sendn(ii) = a(i,ey-j+1,k)
      sends(ii) = a(i,sy+j-1,k)
    enddo
    enddo
    enddo

    call MPI_ISEND(sendn, nssize, MY_REAL, nbrnorth, 4, comm3d, reqn, mpierr)
    call MPI_ISEND(sends, nssize, MY_REAL, nbrsouth, 5, comm3d, reqs, mpierr)

    !   Receive south/north
    call MPI_RECV(recvs, nssize, MY_REAL, nbrsouth, 4, comm3d, status, mpierr)
    call MPI_RECV(recvn, nssize, MY_REAL, nbrnorth, 5, comm3d, status, mpierr)

    ii = 0
    do j=1,jh
    do k=sz,ez
    do i=sx-ih,ex+ih
      ii = ii + 1
      a(i,sy-j,k) = recvs(ii)
      a(i,ey+j,k) = recvn(ii)
    enddo
    enddo
    enddo
  else
    ! Single processor, make sure the field is periodic
    do j=1,jh
    do k=sz,ez
    do i=sx-ih,ex+ih
      a(i,sy-j,k) = a(i,ey-j+1,k)
      a(i,ey+j,k) = a(i,sy+j-1,k)
    enddo
    enddo
    enddo
  endif

  if(nprocy.gt.1)then
    call MPI_WAIT(reqn, status, mpierr)
    call MPI_WAIT(reqs, status, mpierr)
  endif

  deallocate (sendn, sends)
  deallocate (recvn, recvs)

  return
  end subroutine excjs