added integrationTest directory, added tests with 4 processes

psblas3-caf
Ambra Abdullahi 8 years ago
parent 5e530d2b64
commit b0a79cbe07

@ -0,0 +1,39 @@
BASEDIR=../..
INCDIR=$(BASEDIR)/include
include $(INCDIR)/Make.inc.psblas
#
# Libraries used
PFUNIT = /opt/pfunit/pfunit-coarrays-last
FFLAGS += -I$(INCDIR) -I$(PFUNIT)/mod -ISuites
LIBDIR=$(BASEDIR)/lib
PSBLAS_LIB= -L/opencoarrays6.2 -L$(LIBDIR) -lcaf_mpi -lpsb_util -lpsb_base -llapack -lblas
LDLIBS=$(PSBLDLIBS)
#
# Compilers and such
#
CCOPT= -g
FINCLUDES=$(FMFLAG)$(INCDIR) $(FMFLAG).
all: test_psb_halo
%: %.x
mpirun -np 4 ./$^
%.x:%.o driver.o
$(FCFLAGS)$(F90LINK) -g $(LOPT) -o $@ $^ -L$(PFUNIT)/lib $(PSBLAS_LIB) $(LDLIBS) -DUSE_CAF -lpfunit -lmpi
#Create .F90 file
%.F90: %.pf
$(PFUNIT)/bin/pFUnitParser.py $< $@ -lmpi
#Create .o file
%.o: %.F90
$(FC) -g -DUSE_PFUNIT -DUSE_CAF -c $(FFLAGS) $(FPPFLAGS) $^ $(PFUNIT)/include/driver.F90 -L$(PFUNIT)/lib $(PSBLAS_LIB) $(LDLIBS) -lpfunit -lmpi
clean:
/bin/rm -f *.F90 *.o *.mod
verycleanlib:
(cd ../..; make veryclean)
lib:
(cd ../../; make library)

@ -0,0 +1 @@
ADD_TEST_SUITE(test_psb_halo_suite)

@ -0,0 +1,379 @@
module test_psb_halo
use pfunit_mod
use psb_base_mod
implicit none
include 'mpif.h'
contains
@test(nimgs=[std])
subroutine test_psb_halo_2imgs(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: msg, me, i=0, np, j, info
integer, parameter :: nrows=6
integer :: icontxt, mid, true
integer, allocatable :: vg(:), ia(:)
real(psb_dpk_), allocatable :: val(:)
real(psb_dpk_), allocatable :: v(:), check(:)
integer(psb_ipk_) :: iictxt, icomm, flag
type(psb_desc_type):: desc_a
type(psb_d_vect_type) :: x
np = this%getNumImages()
if (np < 2) then
print*,'You need at least 2 processes to run this test.'
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
!call psb_info(icontxt, me, np)
me = this_image()
!Allocate vectors
allocate(vg(nrows))
allocate(ia(nrows))
allocate(val(nrows))
allocate(v(nrows))
i = 0
do j=1,size(vg,1)
vg(j)= i
i = i+1
if (i==np) then
i=0
endif
enddo
!Use only 2 processes
!Assuming nrows is a multiple of 2 so mid is an integer
!Distribute equally to the two processes
mid=nrows/2
do i=1, mid
vg(i)=0
enddo
do i=mid+1, nrows
vg(i)=1
enddo
do i=1,size(ia,1)
ia(i)=i
enddo
do i=1,mid
val(i)=1.
enddo
do i=mid + 1,nrows
val(i)=2.
enddo
call psb_cdall(icontxt,desc_a,info, vg=vg)
if ( me == 1) call psb_cdins(nz=1,ia=(/mid/),ja=(/mid+1/), desc_a=desc_a, info=info)
if ( me == 2) call psb_cdins(nz=1,ia=(/mid+1/),ja=(/mid/), desc_a=desc_a, info=info)
call psb_cdasb(desc_a, info)
call psb_geall(x,desc_a,info)
call psb_geins(m=nrows, irw=ia, val=val,x=x, desc_a=desc_a, info=info)
call psb_geasb(x,desc_a,info)
call psb_barrier(icontxt)
v = x%get_vect()
!Let's modify x, so we need to update halo indices
if ((me == 1).or.(me == 2)) then
x%v%v(mid +1)=x%v%v(mid+1) + 2.0d0
endif
call psb_barrier(icontxt)
! END OF SETUP
call psb_halo(x, desc_a, info)
!GETTING BACK X
call psb_barrier(icontxt)
v = x%get_vect()
!Let's build the expected solution
if ((me == 1).or.(me==2)) then
allocate(check(mid+1))
else
allocate(check(1))
endif
if (me == 1 ) then
check(1:mid)=1.0d0
check(mid + 1)=2.0d0
else if (me == 2) then
check(1:mid)=2.0d0
check(mid + 1)=1.0d0
else
check(1)=0.0d0
endif
!call psb_barrier(icontxt)
if ((me==1).or.(me==2)) then
true = 1
else
true=0
endif
@assertEqual(real(true*check),real(true*v))
deallocate(vg,ia,val,v,check)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_halo_2imgs
@test(nimgs=[std])
subroutine test_psb_d_halo(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: msg, me, i=0, np, j, info, nz
integer, parameter :: nrows = 8
integer :: icontxt, mid, true
integer, allocatable :: vg(:), ia(:), ja(:), irw(:)
real(psb_dpk_), allocatable :: val(:)
real(psb_dpk_), allocatable :: v(:), check(:)
integer(psb_ipk_) :: iictxt, icomm, flag
type(psb_desc_type):: desc_a
type(psb_d_vect_type) :: x
np = this%getNumImages()
if (np < 4) then
print*,'You need at least 4 processes to run this test.'
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
me = this_image()
!Allocate vectors
allocate(vg(nrows))
allocate(val(nrows))
allocate(v(nrows))
!Use only 4 processes
!Assuming nrows is a multiple of 4 so mid is an integer
!Distribute equally to the two processes
mid=nrows/4
do i=1, mid
vg(i)=0
enddo
do i=mid+1, 2*mid
vg(i)=1
enddo
do i=2*mid + 1, 3*mid
vg(i)=2
enddo
do i=3*mid+1, nrows
vg(i)=3
enddo
if (me == 1) nz = 5
if (me == 2) nz = 7
if (me == 3) nz = 7
if (me == 4) nz = 5
allocate(ia(nz),ja(nz))
if (me == 1) then
ia(1)=2
ja(1)=1
ia(2)=1
ja(2)=2
ia(3)=2
ja(3)=3
ia(4)=1
ja(4)=4
ia(5)=2
ja(5)=5
endif
if (me == 2) then
ia(1)=4
ja(1)=1
ia(2)=3
ja(2)=2
ia(3)=4
ja(3)=3
ia(4)=3
ja(4)=4
ia(5)=4
ja(5)=5
ia(6)=3
ja(6)=6
ia(7)=4
ja(7)=6
endif
if (me == 3) then
ia(1)=5
ja(1)=2
ia(2)=6
ja(2)=3
ia(3)=5
ja(3)=4
ia(4)=6
ja(4)=5
ia(5)=5
ja(5)=6
ia(6)=6
ja(6)=7
ia(7)=5
ja(7)=8
endif
if (me == 4) then
ia(1)=7
ja(1)=4
ia(2)=8
ja(2)=5
ia(3)=7
ja(3)=6
ia(4)=8
ja(4)=7
ia(5)=7
ja(5)=8
endif
do i=1,mid
val(i)=1.
enddo
do i= mid + 1, 2*mid
val(i)=2.
enddo
do i=2*mid + 1, 3*mid
val(i)=3.
enddo
do i=3*mid + 1, nrows
val(i)=4.
enddo
if (me==1) nz = 5
if (me==2) nz = 6
if (me==3) nz = 7
if (me==4) nz = 5
if (me > 4) nz = 1
allocate (check(nz))
if (me == 1) then
check(1)=2
check(2)=2
check(3)=8
check(4)=8
check(5)=18
endif
if (me == 2) then
check(1)=8
check(2)=8
check(3)=2
check(4)=2
check(5)=18
check(6)=18
endif
if (me == 3) then
check(1)=18
check(2)=18
check(3)=1
check(4)=8
check(5)=8
check(6)=32
check(7)=32
endif
if (me == 4) then
check(1)=32
check(2)=32
check(3)=8
check(4)=18
check(5)=18
endif
call psb_cdall(icontxt,desc_a,info, vg=vg)
call psb_cdins(nz=nz,ia=ia,ja=ja, desc_a=desc_a, info=info)
call psb_cdasb(desc_a, info)
allocate(irw(nrows))
do i=1,nrows
irw(i)=i
enddo
call psb_geall(x,desc_a,info)
call psb_geins(m=nrows, irw=irw, val=val,x=x, desc_a=desc_a, info=info)
call psb_geasb(x,desc_a,info)
! END OF SETUP
!We can do something better here
x%v%v = x%v%v*2*me
call psb_barrier(icontxt)
call psb_halo(x, desc_a, info)
call psb_barrier(icontxt)
v = x%get_vect()
call psb_barrier(icontxt)
if ((me==1).or.(me==2)) then
true = 1
else
true=0
endif
@assertEqual(real(true*check),real(true*v))
deallocate(vg,ia,val,v,check)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_d_halo
end module test_psb_halo

@ -18,9 +18,9 @@ FINCLUDES=$(FMFLAG)$(INCDIR) $(FMFLAG).
all: test_psb_swapdata
%: %.x
mpirun -np 2 ./$^
mpirun -np 4 ./$^
%.x:%.o driver.o
$(FCFLAGS)$(F90LINK) $(LOPT) -o $@ $^ -L$(PFUNIT)/lib $(PSBLAS_LIB) $(LDLIBS) -DUSE_CAF -lpfunit -lmpi
$(FCFLAGS)$(F90LINK) -g $(LOPT) -o $@ $^ -L$(PFUNIT)/lib $(PSBLAS_LIB) $(LDLIBS) -DUSE_CAF -lpfunit -lmpi
#Create .F90 file
%.F90: %.pf
$(PFUNIT)/bin/pFUnitParser.py $< $@ -lmpi
@ -31,7 +31,7 @@ all: test_psb_swapdata
clean:
/bin/rm -f test_psb_swapdata.F90 driver.o test_psb_swapdata.mod wraptest_psb_swapdata.mod
/bin/rm -f *.F90 *.o *.mod
verycleanlib:
(cd ../..; make veryclean)
lib:

@ -1,36 +1,39 @@
module test_psb_swapdata
use pfunit_mod
use psb_base_mod
use psi_mod
implicit none
include 'mpif.h'
contains
contains
@test(nimgs=[std])
subroutine test_psi_dswap_xchg_vect(this)
subroutine test_psb_swapdata_2imgs(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: msg, me, i=0, np, nrows=6, j, info
integer :: msg, me, i=0, np, j, info
integer, parameter :: nrows=6
integer :: icontxt, mid, true
integer, allocatable :: vg(:), ia(:)
real(psb_dpk_), allocatable :: val(:)
real(psb_dpk_), allocatable :: v(:), check(:)
integer(psb_ipk_) :: iictxt, icomm, flag
class(psb_xch_idx_type), pointer :: xchg
integer(psb_ipk_) :: iictxt, icomm, flag
type(psb_desc_type):: desc_a
type(psb_d_vect_type) :: x
np = this%getNumImages()
if (np < 2) then
print*,'You need at least 2 processes to run this test.'
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
call psb_info(icontxt, me, np)
!call psb_info(icontxt, me, np)
me = this_image()
!Allocate vectors
allocate(vg(nrows))
allocate(ia(nrows))
allocate(val(nrows))
allocate(v(nrows))
i = 0
do j=1,size(vg,1)
vg(j)= i
@ -54,16 +57,10 @@ subroutine test_psi_dswap_xchg_vect(this)
enddo
call psb_cdall(icontxt,desc_a,info, vg=vg)
do i=1,size(ia,1)
ia(i)=i
enddo
call psb_cdins(nz=1,ia=(/mid/),ja=(/mid+1/), desc_a=desc_a, info=info)
call psb_cdins(nz=1,ia=(/mid+1/),ja=(/mid/), desc_a=desc_a, info=info)
call psb_cdasb(desc_a, info)
do i=1,mid
val(i)=1.
enddo
@ -72,32 +69,46 @@ subroutine test_psi_dswap_xchg_vect(this)
val(i)=2.
enddo
call psb_cdall(icontxt,desc_a,info, vg=vg)
if ( me == 1) call psb_cdins(nz=1,ia=(/mid/),ja=(/mid+1/), desc_a=desc_a, info=info)
if ( me == 2) call psb_cdins(nz=1,ia=(/mid+1/),ja=(/mid/), desc_a=desc_a, info=info)
call psb_cdasb(desc_a, info)
call psb_geall(x,desc_a,info)
call psb_geins(m=nrows, irw=ia, val=val,x=x, desc_a=desc_a, info=info)
call psb_geasb(x,desc_a,info)
call psb_barrier(icontxt)
v = x%get_vect()
!Let's modify x, so we need to update halo indices
x%v%v(mid +1)=x%v%v(mid+1) + 2.0d0
if ((me == 1).or.(me == 2)) then
x%v%v(mid +1)=x%v%v(mid+1) + 2.0d0
endif
call psb_barrier(icontxt)
! END OF SETUP
iictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call desc_a%get_list(psb_comm_halo_,xchg,info)
flag = IOR(psb_swap_send_, psb_swap_recv_)
call psi_dswap_xchg_vect(iictxt,icomm,flag,0.0d0,x%v,xchg,info)
!GETTING BACK X
call psb_barrier(icontxt)
v = x%get_vect()
!Let's build the expected solution
allocate(check(mid+1))
if ((me == 1).or.(me==2)) then
allocate(check(mid+1))
else
allocate(check(1))
endif
if (me == 1 ) then
check(1:mid)=1.0d0
check(mid + 1)=2.0d0
@ -105,24 +116,277 @@ subroutine test_psi_dswap_xchg_vect(this)
check(1:mid)=2.0d0
check(mid + 1)=1.0d0
else
check(1:mid+1)=0.0d0
endif
check(1)=0.0d0
endif
!call psb_barrier(icontxt)
if ((me==1).or.(me==2)) then
true = 1
else
true=0
endif
@assertEqual(real(true*v(1:mid+1)),real(true*check(1:mid+1)))
@assertEqual(real(true*check),real(true*v))
deallocate(vg,ia,val,v,check)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psi_dswap_xchg_vect
end subroutine test_psb_swapdata_2imgs
@test(nimgs=[std])
subroutine test_psb_swapdata_4imgs(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: msg, me, i=0, np, j, info, nz
integer, parameter :: nrows = 8
integer :: icontxt, mid, true
integer, allocatable :: vg(:), ia(:), ja(:), irw(:)
real(psb_dpk_), allocatable :: val(:)
real(psb_dpk_), allocatable :: v(:), check(:)
integer(psb_ipk_) :: iictxt, icomm, flag
class(psb_xch_idx_type), pointer :: xchg
type(psb_desc_type):: desc_a
type(psb_d_vect_type) :: x
np = this%getNumImages()
if (np < 4) then
print*,'You need at least 4 processes to run this test.'
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
me = this_image()
!Allocate vectors
allocate(vg(nrows))
allocate(val(nrows))
allocate(v(nrows))
!Use only 4 processes
!Assuming nrows is a multiple of 4 so mid is an integer
!Distribute equally to the two processes
mid=nrows/4
do i=1, mid
vg(i)=0
enddo
do i=mid+1, 2*mid
vg(i)=1
enddo
do i=2*mid + 1, 3*mid
vg(i)=2
enddo
do i=3*mid+1, nrows
vg(i)=3
enddo
if (me == 1) nz = 5
if (me == 2) nz = 7
if (me == 3) nz = 7
if (me == 4) nz = 5
allocate(ia(nz),ja(nz))
if (me == 1) then
ia(1)=2
ja(1)=1
ia(2)=1
ja(2)=2
ia(3)=2
ja(3)=3
ia(4)=1
ja(4)=4
ia(5)=2
ja(5)=5
endif
if (me == 2) then
ia(1)=4
ja(1)=1
ia(2)=3
ja(2)=2
ia(3)=4
ja(3)=3
ia(4)=3
ja(4)=4
ia(5)=4
ja(5)=5
ia(6)=3
ja(6)=6
ia(7)=4
ja(7)=6
endif
if (me == 3) then
ia(1)=5
ja(1)=2
ia(2)=6
ja(2)=3
ia(3)=5
ja(3)=4
ia(4)=6
ja(4)=5
ia(5)=5
ja(5)=6
ia(6)=6
ja(6)=7
ia(7)=5
ja(7)=8
endif
if (me == 4) then
ia(1)=7
ja(1)=4
ia(2)=8
ja(2)=5
ia(3)=7
ja(3)=6
ia(4)=8
ja(4)=7
ia(5)=7
ja(5)=8
endif
do i=1,mid
val(i)=1.
enddo
do i= mid + 1, 2*mid
val(i)=2.
enddo
do i=2*mid + 1, 3*mid
val(i)=3.
enddo
do i=3*mid + 1, nrows
val(i)=4.
enddo
if (me==1) nz = 5
if (me==2) nz = 6
if (me==3) nz = 7
if (me==4) nz = 5
if (me > 4) nz = 1
allocate (check(nz))
if (me == 1) then
check(1)=2
check(2)=2
check(3)=8
check(4)=8
check(5)=18
endif
if (me == 2) then
check(1)=8
check(2)=8
check(3)=2
check(4)=2
check(5)=18
check(6)=18
endif
if (me == 3) then
check(1)=18
check(2)=18
check(3)=1
check(4)=8
check(5)=8
check(6)=32
check(7)=32
endif
if (me == 4) then
check(1)=32
check(2)=32
check(3)=8
check(4)=18
check(5)=18
endif
call psb_cdall(icontxt,desc_a,info, vg=vg)
call psb_cdins(nz=nz,ia=ia,ja=ja, desc_a=desc_a, info=info)
call psb_cdasb(desc_a, info)
allocate(irw(nrows))
do i=1,nrows
irw(i)=i
enddo
call psb_geall(x,desc_a,info)
call psb_geins(m=nrows, irw=irw, val=val,x=x, desc_a=desc_a, info=info)
call psb_geasb(x,desc_a,info)
! END OF SETUP
call psb_barrier(icontxt)
!We can do something better here
x%v%v = x%v%v*2*me
call psb_barrier(icontxt)
iictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call desc_a%get_list(psb_comm_halo_,xchg,info)
flag = IOR(psb_swap_send_, psb_swap_recv_)
call psi_dswap_xchg_vect(iictxt,icomm,flag,0.0d0,x%v,xchg,info)
call psb_barrier(icontxt)
v = x%get_vect()
!call psb_barrier(icontxt)
if ((me==1).or.(me==2)) then
true = 1
else
true=0
endif
@assertEqual(real(true*check),real(true*v))
deallocate(vg,ia,val,v,check)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_swapdata_4imgs
end module test_psb_swapdata

Loading…
Cancel
Save