Commit 24e25bb7 authored by kbk's avatar kbk
Browse files

merged from stabe branch v1_2_1

parent 0b483ca0
......@@ -49,7 +49,13 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: advection_3d.F90,v $
! Revision 1.6 2004-01-06 15:04:00 kbk
! Revision 1.7 2005-05-25 10:32:13 kbk
! merged from stabe branch v1_2_1
!
! Revision 1.6.2.1 2005/05/25 08:39:14 kbk
! update HALO's after each fractional step
!
! Revision 1.6 2004/01/06 15:04:00 kbk
! FCT advection + split of advection_3d.F90 + extra adv. input checks
!
! Revision 1.5 2003/12/16 16:50:40 kbk
......@@ -244,13 +250,16 @@
case (0)
call u_split_adv(dt,f,uu,hun,delxu,delyu,area_inv,au,a2,&
hor_adv,az,AH)
call update_3d_halo(f,f,az,&
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
call v_split_adv(dt,f,vv,hvn,delxv,delyv,area_inv,av,a2,&
hor_adv,az,AH)
call update_3d_halo(f,f,az,&
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
if (kmax.gt.1) then
#ifdef ITERATE_VERT_ADV
call w_split_it_adv(dt,f,ww,az,a2,ver_adv)
......@@ -261,14 +270,12 @@
case (1)
call u_split_adv(dt,f,uu,hun,delxu,delyu,area_inv,au,a1,&
hor_adv,az,AH)
call update_3d_halo(f,f,az, &
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
call v_split_adv(dt,f,vv,hvn,delxv,delyv,area_inv,av,a1,&
hor_adv,az,AH)
call update_3d_halo(f,f,az, &
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
......@@ -279,16 +286,22 @@
#else
call w_split_adv(dt,f,ww,az,a2,ver_adv)
#endif
call update_3d_halo(f,f,az, &
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
end if
call v_split_adv(dt,f,vv,hvn,delxv,delyv,area_inv,av,a1,&
hor_adv,az,AH)
call update_3d_halo(f,f,az, &
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
call u_split_adv(dt,f,uu,hun,delxu,delyu,area_inv,au,a1,&
hor_adv,az,AH)
call update_3d_halo(f,f,az, &
iimin,jjmin,iimax,jjmax,kmax,D_TAG)
call wait_halo(D_TAG)
case (2)
select case (hor_adv)
......
!$Id: uv_advect_3d.F90,v 1.7 2003-08-28 15:20:37 kbk Exp $
!$Id: uv_advect_3d.F90,v 1.8 2005-05-25 10:32:13 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -6,7 +6,7 @@
! !ROUTINE: uv_advect_3d() - mumentum advection - horizontal.
!
! !INTERFACE:
subroutine uv_advect_3d(hor_adv,ver_adv,strang)
subroutine uv_advect_3d(hor_adv,ver_adv,adv_split)
!
! !DESCRIPTION:
!
......@@ -22,10 +22,12 @@
use variables_3d, only: uadv,vadv,wadv,huadv,hvadv,hoadv,hnadv
#endif
use advection_3d, only: do_advection_3d
use halo_zones, only: update_3d_halo,wait_halo,U_TAG,V_TAG
IMPLICIT NONE
!
! !INPUT PARAMETERS:
integer, intent(in) :: hor_adv,ver_adv,strang
integer, intent(in) :: hor_adv,ver_adv,adv_split
!
! !INPUT/OUTPUT PARAMETERS:
!
......@@ -35,7 +37,13 @@
! Original author(s): Hans Burchard & Karsten Bolding
!
! $Log: uv_advect_3d.F90,v $
! Revision 1.7 2003-08-28 15:20:37 kbk
! Revision 1.8 2005-05-25 10:32:13 kbk
! merged from stabe branch v1_2_1
!
! Revision 1.7.2.1 2005/05/25 08:41:38 kbk
! fixed loop boundaries + update HALO's when -DUV_TVD
!
! Revision 1.7 2003/08/28 15:20:37 kbk
! use ax mask, always set PP
!
! Revision 1.6 2003/08/14 13:00:40 kbk
......@@ -102,10 +110,11 @@
#endif
#ifdef UV_TVD
! Here begins dimensional split advection for u-velocity
do k=1,kmax
do j=jjmin,jjmax
do i=iimin,iimax
do j=jjmin-HALO,jjmax+HALO
do i=iimin-HALO,iimax+HALO-1
uadv(i,j,k)=0.5*(uu(i+1,j,k)+uu(i,j,k))
vadv(i,j,k)=0.5*(vv(i+1,j,k)+vv(i,j,k))
wadv(i,j,k)=0.5*(ww(i+1,j,k)+ww(i,j,k))
......@@ -116,8 +125,9 @@
end do
end do
end do
do j=jjmin,jjmax
do i=iimin,iimax
do j=jjmin-HALO,jjmax+HALO
do i=iimin-HALO,iimax+HALO
azadv(i,j)=au(i,j)
auadv(i,j)=az(i,j)
avadv(i,j)=ax(i,j)
......@@ -144,15 +154,20 @@
end do
end do
end do
call update_3d_halo(uuEx,uuEx,au,iimin,jjmin,iimax,jjmax,kmax,U_TAG)
call wait_halo(U_TAG)
call do_advection_3d(dt,uuEx,uadv,vadv,wadv,huadv,hvadv,hoadv,hnadv,&
dxuadv,dxvadv,dyuadv,dyvadv,area_inv, &
azadv,auadv,avadv,hor_adv,ver_adv,strang,AH)
azadv,auadv,avadv,hor_adv,ver_adv,adv_split,AH)
uuEx=-(uuEx*hun-uu)/dt ! Here, uuEx is the advection term.
! Here begins dimensional split advection for v-velocity
do k=1,kmax
do j=jjmin,jjmax
do i=iimin,iimax
do j=jjmin-HALO,jjmax+HALO-1
do i=iimin-HALO,iimax+HALO
uadv(i,j,k)=0.5*(uu(i,j+1,k)+uu(i,j,k))
vadv(i,j,k)=0.5*(vv(i,j+1,k)+vv(i,j,k))
wadv(i,j,k)=0.5*(ww(i,j+1,k)+ww(i,j,k))
......@@ -163,8 +178,9 @@
end do
end do
end do
do j=jjmin,jjmax
do i=iimin,iimax
do j=jjmin-HALO,jjmax+HALO
do i=iimin-HALO,iimax+HALO
azadv(i,j)=av(i,j)
auadv(i,j)=ax(i,j)
avadv(i,j)=az(i,j)
......@@ -191,9 +207,14 @@
end do
end do
end do
call update_3d_halo(vvEx,vvEx,av,iimin,jjmin,iimax,jjmax,kmax,V_TAG)
call wait_halo(V_TAG)
call do_advection_3d(dt,vvEx,uadv,vadv,wadv,huadv,hvadv,hoadv,hnadv,&
dxuadv,dxvadv,dyuadv,dyvadv,area_inv, &
azadv,auadv,avadv,hor_adv,ver_adv,strang,AH)
azadv,auadv,avadv,hor_adv,ver_adv,adv_split,AH)
vvEx=-(vvEx*hvn-vv)/dt ! Here, vvEx is the advection term.
#else ! First-order upstream, one three-dimensional step
......
!$Id: domain.F90,v 1.17 2005-04-25 09:32:34 kbk Exp $
!$Id: domain.F90,v 1.18 2005-05-25 10:32:12 kbk Exp $
#include "cppdefs.h"
!-----------------------------------------------------------------------
!BOP
......@@ -79,7 +79,10 @@
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: domain.F90,v $
! Revision 1.17 2005-04-25 09:32:34 kbk
! Revision 1.18 2005-05-25 10:32:12 kbk
! merged from stabe branch v1_2_1
!
! Revision 1.17 2005/04/25 09:32:34 kbk
! added NetCDF IO rewrite + de-stag of velocities - Umlauf
!
! Revision 1.16 2004/11/04 11:07:00 kbk
......@@ -241,6 +244,7 @@
character(len=PATH_MAX) :: bathymetry_adjust_file = 'bathymetry.adjust'
character(len=PATH_MAX) :: mask_adjust_file = 'mask.adjust'
integer :: il=-1,ih=-1,jl=-1,jh=-1
REALTYPE :: mask(E2DFIELD)
namelist /domain/ &
vert_cord,maxdepth,bathy_format,bathymetry, &
f_plane,latitude,openbdy,bdyinfofile, &
......@@ -359,42 +363,50 @@
! Do we want to further adjust the mask
call adjust_mask(trim(input_dir) // mask_adjust_file)
mask = _ONE_*az
! mask for U-points
au=0
mask=0
do j=jmin-HALO,jmax+HALO
do i=imin-HALO,imax+HALO-1
if (az(i,j) .eq. 1 .and. az(i+1,j) .eq. 1) then
au(i,j)=1
mask(i,j)=1
end if
if ((az(i,j) .eq. 1 .and. az(i+1,j) .eq. 2).or. &
(az(i,j) .eq. 2 .and. az(i+1,j) .eq. 1)) then
au(i,j)=2
mask(i,j)=2
end if
if (az(i,j) .eq. 2 .and. az(i+1,j) .eq. 2) then
au(i,j)=3
mask(i,j)=3
end if
end do
end do
call update_2d_halo(mask,mask,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
au = mask
! mask for V-points
av=0
mask=_ZERO_
do j=jmin-HALO,jmax+HALO-1
do i=imin-HALO,imax+HALO
if (az(i,j) .eq. 1 .and. az(i,j+1) .eq. 1) then
av(i,j)=1
mask(i,j)=1
end if
if ((az(i,j) .eq. 1 .and. az(i,j+1) .eq. 2).or. &
(az(i,j) .eq. 2 .and. az(i,j+1) .eq. 1)) then
av(i,j)=2
mask(i,j)=2
end if
if (az(i,j) .eq. 2 .and. az(i,j+1) .eq. 2) then
av(i,j)=3
mask(i,j)=3
end if
end do
end do
call update_2d_halo(mask,mask,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
av = mask
! mask for X-points
ax=0
mask=0
do j=jmin-HALO,jmax+HALO-1
do i=imin-HALO,imax+HALO-1
if (az(i ,j) .ge. 1 .and. az(i ,j+1) .ge. 1 .and. &
......@@ -403,6 +415,9 @@
end if
end do
end do
call update_2d_halo(mask,mask,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
ax = mask
! Compute grid points and metric coefficients for different grid types
......@@ -821,7 +836,6 @@
call getm_error("metric()","A non valid grid type has been chosen.")
end select
call update_2d_halo(dxc,dxc,az,imin,jmin,imax,jmax,H_TAG)
call wait_halo(H_TAG)
call update_2d_halo(dyc,dyc,az,imin,jmin,imax,jmax,H_TAG)
......
!$Id: halo_mpi.F90,v 1.6 2004-01-02 09:46:43 kbk Exp $
!$Id: halo_mpi.F90,v 1.7 2005-05-25 10:32:12 kbk Exp $
#include "cppdefs.h"
#ifndef HALO
#define HALO 0
#endif
!kbk#define STATIC
!-----------------------------------------------------------------------
!BOP
!
......@@ -67,7 +64,13 @@ include "mpif.h"
! Original author(s): Karsten Bolding & Hans Burchard
!
! $Log: halo_mpi.F90,v $
! Revision 1.6 2004-01-02 09:46:43 kbk
! Revision 1.7 2005-05-25 10:32:12 kbk
! merged from stabe branch v1_2_1
!
! Revision 1.6.2.1 2005/05/25 08:05:35 kbk
! fixed ONED_NONBLOCKING + cleaning
!
! Revision 1.6 2004/01/02 09:46:43 kbk
! fixed a bug for user defined data types - Peneva
!
! Revision 1.5 2003/08/14 14:49:51 kbk
......@@ -736,7 +739,7 @@ include "mpif.h"
case(ONED_SENDRECV)
if(com_direction .eq. RIGHT_LEFT) then
#ifdef DEBUG
STDERR 'ONED_SENDRECV - y_line'
STDERR 'ONED_SENDRECV - y_lines'
#endif
call MPI_SENDRECV(f1(il,jl), 1, y_line, left , tag, &
f2(ih+1,jl), 1, y_line, right, tag, &
......@@ -747,7 +750,7 @@ STDERR 'ONED_SENDRECV - y_line'
active_comm, status, ierr)
else
#ifdef DEBUG
STDERR 'ONED_SENDRECV - x_line'
STDERR 'ONED_SENDRECV - x_lines'
#endif
call MPI_SENDRECV(f1(il,jh), 1, x_line, up, tag, &
f2(il,jl-1), 1, x_line, down, tag, &
......@@ -759,27 +762,27 @@ STDERR 'ONED_SENDRECV - x_line'
case(ONED_NONBLOCKING)
if(com_direction .eq. RIGHT_LEFT) then
#ifdef DEBUG
STDERR 'ONED_NONBLOCKING - y_line'
STDERR 'ONED_NONBLOCKING - y_lines'
#endif
call MPI_IRECV(f2(ih+1,jl), 1, y_line, right, tag, &
call MPI_IRECV(f2(il-HALO,jl), 1, y_lines, left, tag, &
active_comm, req(1), ierr)
call MPI_IRECV(f2(il-1,jl), 1, y_line, left, tag, &
call MPI_IRECV(f2(ih+1,jl), 1, y_lines, right, tag, &
active_comm, req(2), ierr)
call MPI_ISEND(f1(il,jl), 1, y_line, left, tag, &
call MPI_ISEND(f1(il,jl), 1, y_lines, left, tag, &
active_comm, req(3), ierr)
call MPI_ISEND(f1(ih,jl), 1, y_line, right, tag, &
call MPI_ISEND(f1(ih-(HALO-1),jl), 1, y_lines, right, tag, &
active_comm, req(4), ierr)
else
#ifdef DEBUG
STDERR 'ONED_NONBLOCKING - x_line'
STDERR 'ONED_NONBLOCKING - x_lines'
#endif
call MPI_IRECV(f2(il,jl-1), 1, x_line, down, tag, &
call MPI_IRECV(f2(il,jl-HALO), 1, x_lines, down, tag, &
active_comm, req(1), ierr)
call MPI_IRECV(f2(il,jh+1), 1, x_line, up, tag, &
call MPI_IRECV(f2(il,jh+1), 1, x_lines, up, tag, &
active_comm, req(2), ierr)
call MPI_ISEND(f1(il,jl), 1, x_line, down, tag, &
call MPI_ISEND(f1(il,jl), 1, x_lines, down, tag, &
active_comm, req(3), ierr)
call MPI_ISEND(f1(il,jh), 1, x_line, up, tag, &
call MPI_ISEND(f1(il,jh-(HALO-1)), 1, x_lines, up, tag, &
active_comm, req(4), ierr)
end if
case(TWOD_SENDRECV)
......@@ -815,13 +818,13 @@ STDERR 'TWOD_SENDRECV'
! Recieving x_lines
call MPI_IRECV(f2(il,jl-HALO), 1, x_lines, down, tag, &
active_comm, req(1), ierr)
call MPI_IRECV(f2(il,jh+1), 1, x_lines, up, tag, &
call MPI_IRECV(f2(il,jh+1), 1, x_lines, up, tag, &
active_comm, req(2), ierr)
! Recieving y_lines
call MPI_IRECV(f2(il-HALO,jl), 1, y_lines, left, tag, &
active_comm, req(3), ierr)
call MPI_IRECV(f2(ih+1,jl), 1, y_lines, right, tag, &
call MPI_IRECV(f2(ih+1,jl), 1, y_lines, right, tag, &
active_comm, req(4), ierr)
! Recieving corner points
......@@ -835,15 +838,15 @@ STDERR 'TWOD_SENDRECV'
active_comm, req(8), ierr)
! Sending x_lines
call MPI_ISEND(f1(il,jl), 1, x_lines, down, tag, &
call MPI_ISEND(f1(il,jl), 1, x_lines, down, tag, &
active_comm, req(9), ierr)
call MPI_ISEND(f1(il,jh-(HALO-1)), 1, x_lines, up, tag, &
call MPI_ISEND(f1(il,jh-(HALO-1)), 1, x_lines, up, tag, &
active_comm, req(10), ierr)
! Sending y_lines
call MPI_ISEND(f1(il,jl), 1, y_lines, left, tag, &
call MPI_ISEND(f1(il,jl), 1, y_lines, left, tag, &
active_comm, req(11), ierr)
call MPI_ISEND(f1(ih-(HALO-1),jl), 1, y_lines, right, tag, &
call MPI_ISEND(f1(ih-(HALO-1),jl), 1, y_lines, right, tag, &
active_comm, req(12), ierr)
! Sending corner points
......@@ -865,14 +868,14 @@ STDERR 'TWOD_SENDRECV'
if (do_mirror) then
if ( comm_method .ne. ONE_PROCESS ) then
if(left .eq. MPI_PROC_NULL) f1(il-1, : ) = f1(il, : )
if(right .eq. MPI_PROC_NULL) f1(ih+1, : ) = f1(ih, : )
if(down .eq. MPI_PROC_NULL) f1( :, jl-1) = f1( :, jl)
if(up .eq. MPI_PROC_NULL) f1( :, jh+1) = f1( :, jh)
if(ul .eq. MPI_PROC_NULL) f1(il-1,jh+1) = f1(il,jh)
if(ur .eq. MPI_PROC_NULL) f1(ih+1,jh+1) = f1(ih,jh)
if(lr .eq. MPI_PROC_NULL) f1(ih+1,jl-1) = f1(ih,jl)
if(ll .eq. MPI_PROC_NULL) f1(il-1,jl-1) = f1(il,jl)
if(left .eq. MPI_PROC_NULL) f1(il-1, : ) = f1(il, : )
if(right .eq. MPI_PROC_NULL) f1(ih+1, : ) = f1(ih, : )
if(down .eq. MPI_PROC_NULL) f1( :, jl-1) = f1( :, jl)
if(up .eq. MPI_PROC_NULL) f1( :, jh+1) = f1( :, jh)
if(ul .eq. MPI_PROC_NULL) f1(il-1,jh+1) = f1(il,jh)
if(ur .eq. MPI_PROC_NULL) f1(ih+1,jh+1) = f1(ih,jh)
if(lr .eq. MPI_PROC_NULL) f1(ih+1,jl-1) = f1(ih,jl)
if(ll .eq. MPI_PROC_NULL) f1(il-1,jl-1) = f1(il,jl)
end if
end if
......@@ -926,7 +929,7 @@ STDERR 'TWOD_SENDRECV'
case(ONED_SENDRECV)
if(com_direction .eq. RIGHT_LEFT) then
#ifdef DEBUG
STDERR 'ONED_SENDRECV - yz_slice'
STDERR 'ONED_SENDRECV - yz_slices'
#endif
call MPI_SENDRECV(f1(il,jl,0), 1, yz_slice, left , tag, &
f2(ih+1,jl,0), 1, yz_slice, right, tag, &
......@@ -936,7 +939,7 @@ STDERR 'ONED_SENDRECV - yz_slice'
active_comm, status, ierr)
else
#ifdef DEBUG
STDERR 'ONED_SENDRECV - xz_slice'
STDERR 'ONED_SENDRECV - xz_slices'
#endif
call MPI_SENDRECV(f1(il,jl,0), 1, xz_slice, down, tag, &
f2(il,jh+1,0), 1, xz_slice, up , tag, &
......@@ -948,27 +951,28 @@ STDERR 'ONED_SENDRECV - xz_slice'
case(ONED_NONBLOCKING)
if(com_direction .eq. RIGHT_LEFT) then
#ifdef DEBUG
STDERR 'ONED_NONBLOCKING - yz_slice'
STDERR 'ONED_NONBLOCKING - yz_slices'
#endif
call MPI_IRECV(f2(ih+1,jl,0), 1, yz_slice, right, tag, &
active_comm, req(2), ierr)
call MPI_IRECV(f2(il-1,jl,0), 1, yz_slice, left, tag, &
STDERR 'yz_slices'
call MPI_IRECV(f2(il-HALO,jl,0), 1, yz_slices, left, tag, &
active_comm, req(1), ierr)
call MPI_ISEND(f1(il,jl,0), 1, yz_slice, left, tag, &
active_comm, req(4), ierr)
call MPI_ISEND(f1(ih,jl,0), 1, yz_slice, right, tag, &
call MPI_IRECV(f2(ih+1,jl,0), 1, yz_slices, right, tag, &
active_comm, req(2), ierr)
call MPI_ISEND(f1(il,jl,0), 1, yz_slices, left, tag, &
active_comm, req(3), ierr)
call MPI_ISEND(f1(ih-(HALO-1),jl,0), 1, yz_slices, right, tag, &
active_comm, req(4), ierr)
else
#ifdef DEBUG
STDERR 'ONED_NONBLOCKING - xz_slice'
STDERR 'ONED_NONBLOCKING - xz_slices'
#endif
call MPI_IRECV(f2(il,jl-1,0), 1, xz_slice, down, tag, &
call MPI_IRECV(f2(il,jl-HALO,0), 1, xz_slices, down, tag, &
active_comm, req(1), ierr)
call MPI_IRECV(f2(il,jh+1,0), 1, xz_slice, up, tag, &
call MPI_IRECV(f2(il,jh+1,0), 1, xz_slices, up, tag, &
active_comm, req(2), ierr)
call MPI_ISEND(f1(il,jl,0), 1, xz_slice, down, tag, &
call MPI_ISEND(f1(il,jl,0), 1, xz_slices, down, tag, &
active_comm, req(3), ierr)
call MPI_ISEND(f1(il,jh,0), 1, xz_slice, up, tag, &
call MPI_ISEND(f1(il,jh-(HALO-1),0), 1, xz_slices, up, tag, &
active_comm, req(4), ierr)
end if
case(TWOD_SENDRECV)
......@@ -989,31 +993,31 @@ STDERR 'TWOD_SENDRECV'
active_comm, status, ierr)
! Corner points
call MPI_SENDRECV(f1(il,jl,0), 1, z_column, ll, tag, &
f2(ih+1,jh+1,0),1, z_column, ur,tag, &
f2(ih+1,jh+1,0),1, z_column, ur, tag, &
active_comm, status, ierr)
call MPI_SENDRECV(f1(ih,jl,0), 1, z_column, lr,tag, &
call MPI_SENDRECV(f1(ih,jl,0), 1, z_column, lr, tag, &
f2(il-1,jh+1,0),1, z_column, ul, tag, &
active_comm, status, ierr)
call MPI_SENDRECV(f1(ih,jh,0), 1, z_column, ur,tag, &
call MPI_SENDRECV(f1(ih,jh,0), 1, z_column, ur, tag, &
f2(il-1,jl-1,0),1, z_column, ll, tag, &
active_comm, status, ierr)
call MPI_SENDRECV(f1(il,jh,0), 1, z_column, ul,tag, &
f2(ih+1,jl-1,0),1, z_column, lr,tag, &
call MPI_SENDRECV(f1(il,jh,0), 1, z_column, ul, tag, &
f2(ih+1,jl-1,0),1, z_column, lr, tag, &
active_comm, status, ierr)
case(TWOD_NONBLOCKING)
#ifdef DEBUG
STDERR 'TWOD_NONBLOCKING'
#endif
! Recieving xz_slices
call MPI_IRECV(f2(il,jl-HALO,0), 1, xz_slices, down, tag, &
call MPI_IRECV(f2(il,jl-HALO,0), 1, xz_slices, down, tag, &
active_comm, req(1), ierr)
call MPI_IRECV(f2(il,jh+1,0), 1, xz_slices, up, tag, &
call MPI_IRECV(f2(il,jh+1,0), 1, xz_slices, up, tag, &
active_comm, req(2), ierr)
! Recieving yz_slices
call MPI_IRECV(f2(il-HALO,jl,0), 1, yz_slices, left, tag, &
active_comm, req(3), ierr)
call MPI_IRECV(f2(ih+1,jl,0), 1, yz_slices, right, tag, &
call MPI_IRECV(f2(ih+1,jl,0), 1, yz_slices, right, tag, &
active_comm, req(4), ierr)
! Recieving corner columns
......@@ -1027,28 +1031,28 @@ STDERR 'TWOD_NONBLOCKING'
active_comm, req(8), ierr)
! Sending xz_slices
call MPI_ISEND(f1(il,jl,0), 1, xz_slices, down, tag, &
active_comm, req(9), ierr)
call MPI_ISEND(f1(il,jh-(HALO-1),0), 1, xz_slices, up, tag, &
call MPI_ISEND(f1(il,jl,0), 1, xz_slices, down, tag, &
active_comm, req(9), ierr)
call MPI_ISEND(f1(il,jh-(HALO-1),0), 1, xz_slices, up, tag, &
active_comm, req(10), ierr)
! Sending yz_slices
call MPI_ISEND(f1(il,jl,0), 1, yz_slices, left, tag, &
call MPI_ISEND(f1(il,jl,0), 1, yz_slices, left, tag, &
active_comm, req(11), ierr)
call MPI_ISEND(f1(ih-(HALO-1),jl,0), 1, yz_slices, right, tag, &
call MPI_ISEND(f1(ih-(HALO-1),jl,0), 1, yz_slices, right, tag, &
active_comm, req(12), ierr)
! Sending corner columns
call MPI_ISEND(f1(ih,jh,0), 1, z_column, ur,tag, &
call MPI_ISEND(f1(ih,jh,0), 1, z_column, ur, tag, &
active_comm, req(13), ierr)
call MPI_ISEND(f1(il,jh,0), 1, z_column, ul,tag, &
call MPI_ISEND(f1(il,jh,0), 1, z_column, ul, tag, &
active_comm, req(14), ierr)
call MPI_ISEND(f1(il,jl,0), 1, z_column, ll,tag, &
call MPI_ISEND(f1(il,jl,0), 1, z_column, ll, tag, &
active_comm, req(15), ierr)
call MPI_ISEND(f1(ih,jl,0), 1, z_column, lr,tag, &
call MPI_ISEND(f1(ih,jl,0), 1, z_column, lr, tag, &
active_comm, req(16), ierr)
case default
FATAL 'A non valid communication method has been chosen'
......@@ -1056,14 +1060,14 @@ STDERR 'TWOD_NONBLOCKING'
end select
if ( comm_method .ne. ONE_PROCESS ) then
if(left .eq. MPI_PROC_NULL) f1(il-1, :, : )