Process exchange (fortran + MPI) - fortran

Question

During the realization of the course work I have to write MPI program to solve PDE continuum mechanics. (FORTRAN)
In parallel program a big computational 3D domain (grid MxNxL) is shared between processes. Every process has it's own subdomain for computation(grid NXxNYxNZ = (M/P1)x(N/P2)x(L/P3) , P1*P2*P3 = P - number of processes). After every computation step I have to exchange two border layers between neighbor processes or (it is not important) in case if I don't have a neighbor towards I have to process the border conditions. I have wrote the following implementation, but I dont know how to get rid of extra data shuffling. I want to accelerate my code as possible.
if (XB2 /= MPI_PROC_NULL) then ! If process has right-X neighbor process
call CopyToSb(NX-1,NX,1,NY,1,NZ,XPkgSize)
else
call CopyXLevel(NX,NX+1,-1) ! BORDER PROCESSING (NOT IMPORTANT)
end if
call MPI_SENDRECV_REPLACE(BPtmp, 7*XPkgSize, MPI_REAL4, XB2, 1, XB1, 1, COMM_CART, MPI_STATUS_IGNORE, ierr)
if (XB1 /= MPI_PROC_NULL) then ! If process has left-X neighbor process
call CopyFromSb(-1,0,1,NY,1,NZ,XPkg,XPkgSize)
call CopyToSb(1,2,1,NY,1,NZ,XPkgSize)
else
call CopyXLevel(1,0,1) ! BORDER PROCESSING (NOT IMPORTANT)
end if
call MPI_SENDRECV_REPLACE(BPtmp, 7*XPkgSize, MPI_REAL4, XB1, 2, XB2, 2, COMM_CART, MPI_STATUS_IGNORE, ierr)
if (XB2 /= MPI_PROC_NULL) call CopyFromSb(NX+1,NX+2,1,NY,1,NZ,XPkg,XPkgSize) ! If process has right-X neighbor process
if(iam /= YB1) then ! Because we have cyclic grid on Y direction
if (YB2 /= MPI_PROC_NULL) call CopyToSb(1,NX,NY-1,NY,1,NZ,YPkgSize) ! If process has right-Y neighbor process
call MPI_SENDRECV_REPLACE(BPtmp, 7*YPkgSize, MPI_REAL4, YB2, 3, YB1, 3, COMM_CART, MPI_STATUS_IGNORE, ierr)
if (YB1 /= MPI_PROC_NULL) then ! If process has left-Y neighbor process
call CopyFromSb(1,NX,-1,0,1,NZ,YPkg,YPkgSize)
call CopyToSb(1,NX,1,2,1,NZ,YPkgSize)
end if
call MPI_SENDRECV_REPLACE(BPtmp, 7*YPkgSize, MPI_REAL4, YB1, 4, YB2, 4, COMM_CART, MPI_STATUS_IGNORE, ierr)
if (YB2 /= MPI_PROC_NULL) call CopyFromSb(1,NX,NY+1,NY+2,1,NZ,YPkg,YPkgSize) ! If process has right-Y neighbor process
else
call CopyYLevel(1,NY+1,1) ! BORDER PROCESSING (NOT IMPORTANT)
call CopyYLevel(NY,0,1) ! BORDER PROCESSING (NOT IMPORTANT)
call CopyYLevel(2,NY+2,1) ! BORDER PROCESSING (NOT IMPORTANT)
call CopyYLevel(NY-1,-1,1) ! BORDER PROCESSING (NOT IMPORTANT)
end if
if (ZB2 /= MPI_PROC_NULL) then
call CopyToSb(1,NX,1,NY,NZ-1,NZ,ZPkgSize)
else
call CopyZLevel(NZ,NZ+1,-1) ! BORDER PROCESSING (NOT IMPORTANT)
end if
call MPI_SENDRECV_REPLACE(BPtmp, 7*ZPkgSize, MPI_REAL4, ZB2, 5, ZB1, 5, COMM_CART, MPI_STATUS_IGNORE, ierr)
if (ZB1 /= MPI_PROC_NULL) then
call CopyFromSb(1,NX,1,NY,-1,0,ZPkg,ZPkgSize)
call CopyToSb(1,NX,1,NY,1,2,ZPkgSize)
else
call CopyZLevel(1,0,-1) ! BORDER PROCESSING (NOT IMPORTANT)
end if
call MPI_SENDRECV_REPLACE(BPtmp, 7*ZPkgSize, MPI_REAL4, ZB1, 6, ZB2, 6, COMM_CART, MPI_STATUS_IGNORE, ierr)
if (ZB2 /= MPI_PROC_NULL) call CopyFromSb(1,NX,1,NY,NZ+1,NZ+2,ZPkg,ZPkgSize)
contains
! This is copyToSendBuffer and copyFromSendBuffer functions
! I think it is most problem part of my code.
subroutine CopyToSb(x1,x2,y1,y2,z1,z2,PkgSize)
integer :: x1,x2,y1,y2,z1,z2,PkgSize
BPtmp(1:PkgSize) = RESHAPE(R(x1:x2,y1:y2,z1:z2),[PkgSize])
BPtmp(PkgSize+1:2*PkgSize) = RESHAPE(U(x1:x2,y1:y2,z1:z2),[PkgSize])
BPtmp(2*PkgSize+1:3*PkgSize) = RESHAPE(V(x1:x2,y1:y2,z1:z2),[PkgSize])
BPtmp(3*PkgSize+1:4*PkgSize) = RESHAPE(W(x1:x2,y1:y2,z1:z2),[PkgSize])
BPtmp(4*PkgSize+1:5*PkgSize) = RESHAPE(P(x1:x2,y1:y2,z1:z2),[PkgSize])
BPtmp(5*PkgSize+1:6*PkgSize) = RESHAPE(H(x1:x2,y1:y2,z1:z2),[PkgSize])
BPtmp(6*PkgSize+1:7*PkgSize) = RESHAPE(S(x1:x2,y1:y2,z1:z2),[PkgSize])
end subroutine CopyToSb
subroutine CopyFromSb(x1,x2,y1,y2,z1,z2,Pkg,PkgSize)
integer, dimension(3) :: Pkg
integer :: x1,x2,y1,y2,z1,z2,PkgSize
R(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(1:PkgSize),Pkg)
U(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(PkgSize+1:2*PkgSize),Pkg)
V(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(2*PkgSize+1:3*PkgSize),Pkg)
W(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(3*PkgSize+1:4*PkgSize),Pkg)
P(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(4*PkgSize+1:5*PkgSize),Pkg)
H(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(5*PkgSize+1:6*PkgSize),Pkg)
S(x1:x2,y1:y2,z1:z2) = RESHAPE(BPtmp(6*PkgSize+1:7*PkgSize),Pkg)
end subroutine CopyFromSb
end
The problem is that I have to excahnge slices of array like 2*NY*NZ or NX*2*NZ or NX*NY*2 but in fact I have (-1:NX+2, -1:NY+2, -1:NZ+2) arrays. It is noncontiguous problem. I know what MPI derived datatypes is, but I need some advices(examples) on my way.