Apply inter-block interface boundary condition
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real, | intent(inout), | dimension(0:imx,0:jmx,0:kmx,1:n_var) | :: | qp | ||
| integer, | intent(in) | :: | layers |
subroutine apply_interface(qp, layers)
!< Apply inter-block interface boundary condition
implicit none
integer, intent(in):: layers
real, dimension(0:imx,0:jmx,0:kmx,1:n_var), intent(inout):: qp
integer:: i,j,k,n,l
integer:: status(MPI_STATUS_SIZE)
integer:: ierr
integer:: tag=1
integer:: count=0
!--- IMIN ---!
call dmsg(1, 'interface', 'apply_interface')
if(imin_id>=0)then
!collect data
count=0
do n=1,n_var
do l=1,layers
do k=1,kmx-1
do j=1,jmx-1
count=count+1
imin_send_buf(count) = qp(l,j,k,n)
end do
end do
end do
end do
call MPI_SENDRECV(imin_send_buf,ibuf_size, MPI_DOUBLE_PRECISION, imin_id,tag,&
imin_recv_buf,ibuf_size, MPI_DOUBLE_PRECISION, imin_id,tag,&
MPI_COMM_WORLD,status,ierr)
! redistribute data
if(dir_switch(1)==0)then
count=0
do n=1,n_var
do l=1,layers
do k=Pklo(1),Pkhi(1),PkDir(1)
do j=Pjlo(1),Pjhi(1),PjDir(1)
count=count+1
qp(1-l,j,k,n) = imin_recv_buf(count)
end do
end do
end do
end do
else
count=0
do n=1,n_var
do l=1,layers
do j=Pjlo(1),Pjhi(1),PjDir(1)
do k=Pklo(1),Pkhi(1),PkDir(1)
count=count+1
qp(1-l,j,k,n) = imin_recv_buf(count)
end do
end do
end do
end do
end if
end if
!--- IMAX ---!
if(imax_id>=0)then
!collect data
count=0
do n=1,n_var
do l=1,layers
do k=1,kmx-1
do j=1,jmx-1
count=count+1
imax_send_buf(count) = qp(imx-l,j,k,n)
end do
end do
end do
end do
call MPI_SENDRECV(imax_send_buf,ibuf_size, MPI_DOUBLE_PRECISION, imax_id,tag,&
imax_recv_buf,ibuf_size, MPI_DOUBLE_PRECISION, imax_id,tag,&
MPI_COMM_WORLD,status,ierr)
! redistribute data
if(dir_switch(2)==0)then
count=0
do n=1,n_var
do l=1,layers
do k=Pklo(2),Pkhi(2),PkDir(2)
do j=Pjlo(2),Pjhi(2),PjDir(2)
count=count+1
qp(imx+l-1,j,k,n) = imax_recv_buf(count)
end do
end do
end do
end do
else
count=0
do n=1,n_var
do l=1,layers
do j=Pjlo(2),Pjhi(2),Pjdir(2)
do k=Pklo(2),Pkhi(2),PkDir(2)
count=count+1
qp(imx+l-1,j,k,n) = imax_recv_buf(count)
end do
end do
end do
end do
end if
end if
!--- JMIN ---!
if(jmin_id>=0)then
!collect data
count=0
do n=1,n_var
do l=1,layers
do k=1,kmx-1
do i=1,imx-1
count=count+1
jmin_send_buf(count) = qp(i,l,k,n)
end do
end do
end do
end do
call MPI_SENDRECV(jmin_send_buf,jbuf_size, MPI_DOUBLE_PRECISION, jmin_id,tag,&
jmin_recv_buf,jbuf_size, MPI_DOUBLE_PRECISION, jmin_id,tag,&
MPI_COMM_WORLD,status,ierr)
! redistribute data
if(dir_switch(3)==0)then
count=0
do n=1,n_var
do l=1,layers
do k=Pklo(3),Pkhi(3),PkDir(3)
do i=Pilo(3),Pihi(3),PiDir(3)
count=count+1
qp(i,1-l,k,n) = jmin_recv_buf(count)
end do
end do
end do
end do
else
count=0
do n=1,n_var
do l=1,layers
do i=Pilo(3),Pihi(3),PiDir(3)
do k=Pklo(3),Pkhi(3),PkDir(3)
count=count+1
qp(i,1-l,k,n) = jmin_recv_buf(count)
end do
end do
end do
end do
end if
end if
!--- JMAX ---!
if(jmax_id>=0)then
!collect data
count=0
do n=1,n_var
do l=1,layers
do k=1,kmx-1
do i=1,imx-1
count=count+1
jmax_send_buf(count) = qp(i,jmx-l,k,n)
end do
end do
end do
end do
call MPI_SENDRECV(jmax_send_buf,jbuf_size, MPI_DOUBLE_PRECISION, jmax_id,tag,&
jmax_recv_buf,jbuf_size, MPI_DOUBLE_PRECISION, jmax_id,tag,&
MPI_COMM_WORLD,status,ierr)
! redistribute data
if(dir_switch(4)==0)then
count=0
do n=1,n_var
do l=1,layers
do k=Pklo(4),Pkhi(4),PkDir(4)
do i=Pilo(4),Pihi(4),PiDir(4)
count=count+1
qp(i,jmx+l-1,k,n) = jmax_recv_buf(count)
end do
end do
end do
end do
else
count=0
do n=1,n_var
do l=1,layers
do i=Pilo(4),Pihi(4),PiDir(4)
do k=Pklo(4),Pkhi(4),PkDir(4)
count=count+1
qp(i,jmx+l-1,k,n) = jmax_recv_buf(count)
end do
end do
end do
end do
end if
end if
!--- KMIN ---!
if(kmin_id>=0)then
!collect data
count=0
do n=1,n_var
do l=1,layers
do j=1,jmx-1
do i=1,imx-1
count=count+1
kmin_send_buf(count) = qp(i,j,l,n)
end do
end do
end do
end do
call MPI_SENDRECV(kmin_send_buf,kbuf_size, MPI_DOUBLE_PRECISION, kmin_id,tag,&
kmin_recv_buf,kbuf_size, MPI_DOUBLE_PRECISION, kmin_id,tag,&
MPI_COMM_WORLD,status,ierr)
! redistribute data
if(dir_switch(5)==0)then
count=0
do n=1,n_var
do l=1,layers
do j=Pjlo(5),Pjhi(5),PjDir(5)
do i=Pilo(5),Pihi(5),PiDir(5)
count=count+1
qp(i,j,1-l,n) = kmin_recv_buf(count)
end do
end do
end do
end do
else
count=0
do n=1,n_var
do l=1,layers
do i=Pilo(5),Pihi(5),PiDir(5)
do j=Pjlo(5),Pjhi(5),PjDir(5)
count=count+1
qp(i,j,1-l,n) = kmin_recv_buf(count)
end do
end do
end do
end do
end if
end if
!--- KMAX ---!
if(kmax_id>=0)then
!collect data
count=0
do n=1,n_var
do l=1,layers
do j=1,jmx-1
do i=1,imx-1
count=count+1
kmax_send_buf(count) = qp(i,j,kmx-l,n)
end do
end do
end do
end do
call MPI_SENDRECV(kmax_send_buf,kbuf_size, MPI_DOUBLE_PRECISION, kmax_id,tag,&
kmax_recv_buf,kbuf_size, MPI_DOUBLE_PRECISION, kmax_id,tag,&
MPI_COMM_WORLD,status,ierr)
! redistribute data
if(dir_switch(6)==0)then
count=0
do n=1,n_var
do l=1,layers
do j=Pjlo(6),Pjhi(6),PjDir(6)
do i=Pilo(6),Pihi(6),PiDir(6)
count=count+1
qp(i,j,kmx+l-1,n) = kmax_recv_buf(count)
end do
end do
end do
end do
else
count=0
do n=1,n_var
do l=1,layers
do i=Pilo(6),Pihi(6),PiDir(6)
do j=Pjlo(6),Pjhi(6),PjDir(6)
count=count+1
qp(i,j,kmx+l-1,n) = kmax_recv_buf(count)
end do
end do
end do
end do
end if
end if
call apply_periodic_bc(delQstar, 1)
end subroutine apply_interface