added tests for halo exchange, dmat_dist, some of the collective subroutines

psblas3-caf
Ambra Abdullahi 8 years ago
parent af9ee44d73
commit fc8e6c6895

@ -15,10 +15,12 @@ CCOPT= -g
FINCLUDES=$(FMFLAG)$(INCDIR) $(FMFLAG).
all: test_psb_halo
all: prova
prova.x: test_psb_dmatdist.o test_psb_dhalo.o test_psb_shalo.o test_psb_chalo.o test_psb_zhalo.o test_psb_reduce_nrm2.o test_psb_sum.o test_psb_max.o test_psb_amx.o test_psb_min.o test_psb_amn.o test_psb_broadcast.o driver.o
$(FCFLAGS)$(F90LINK) -g $(LOPT) -o $@ $^ -L$(PFUNIT)/lib $(PSBLAS_LIB) $(LDLIBS) -DUSE_CAF -lpfunit -lmpi
%: %.x
mpirun -np 4 ./$^
mpirun -np 8 ./$^
%.x:%.o driver.o
$(FCFLAGS)$(F90LINK) -g $(LOPT) -o $@ $^ -L$(PFUNIT)/lib $(PSBLAS_LIB) $(LDLIBS) -DUSE_CAF -lpfunit -lmpi
#Create .F90 file

@ -1 +1,12 @@
ADD_TEST_SUITE(test_psb_halo_suite)
ADD_TEST_SUITE(test_psb_reduce_nrm2_suite)
ADD_TEST_SUITE(test_psb_max_suite)
ADD_TEST_SUITE(test_psb_amx_suite)
ADD_TEST_SUITE(test_psb_min_suite)
ADD_TEST_SUITE(test_psb_amn_suite)
ADD_TEST_SUITE(test_psb_sum_suite)
ADD_TEST_SUITE(test_psb_broadcast_suite)
ADD_TEST_SUITE(test_psb_dhalo_suite)
ADD_TEST_SUITE(test_psb_shalo_suite)
ADD_TEST_SUITE(test_psb_chalo_suite)
ADD_TEST_SUITE(test_psb_zhalo_suite)
ADD_TEST_SUITE(test_psb_dmatdist_suite)

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

@ -0,0 +1,514 @@
module test_psb_broadcast
use pfunit_mod
use psb_base_mod
implicit none
include 'mpif.h'
interface prepare_test
module procedure prepare_itest_s
module procedure prepare_stest_s
module procedure prepare_dtest_s
module procedure prepare_ctest_s
module procedure prepare_ztest_s
module procedure prepare_itest_v
module procedure prepare_stest_v
module procedure prepare_dtest_v
module procedure prepare_ctest_v
module procedure prepare_ztest_v
module procedure prepare_itest_m
module procedure prepare_stest_m
module procedure prepare_dtest_m
module procedure prepare_ctest_m
module procedure prepare_ztest_m
end interface prepare_test
contains
subroutine prepare_itest_s(dat,check,root,info, np, icontxt)
integer, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check=root + 1
end subroutine prepare_itest_s
subroutine prepare_stest_s(dat,check,root,info, np, icontxt)
real, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())
check=real(root + 1)
end subroutine prepare_stest_s
subroutine prepare_dtest_s(dat,check,root,info, np, icontxt)
double precision, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())
check=dble(root + 1)
end subroutine prepare_dtest_s
subroutine prepare_ctest_s(dat,check,root,info, np, icontxt)
complex, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = complex(this_image(),this_image())
check=complex(root + 1, root + 1)
end subroutine prepare_ctest_s
subroutine prepare_ztest_s(dat,check,root,info, np, icontxt)
double complex, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = complex(this_image(),this_image())
check=complex(root + 1, root + 1)
end subroutine prepare_ztest_s
subroutine prepare_itest_v(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check=root + 1
end subroutine prepare_itest_v
subroutine prepare_stest_v(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())
check=real(root + 1)
end subroutine prepare_stest_v
subroutine prepare_dtest_v(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())
check=dble(root + 1)
end subroutine prepare_dtest_v
subroutine prepare_ctest_v(dat,check,root,info, np, icontxt)
complex, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = complex(this_image(),this_image())
check=complex(root + 1, root + 1)
end subroutine prepare_ctest_v
subroutine prepare_ztest_v(dat,check,root,info, np, icontxt)
double complex, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = complex(this_image(),this_image())
check=complex(root + 1, root + 1)
end subroutine prepare_ztest_v
subroutine prepare_itest_m(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check=root + 1
end subroutine prepare_itest_m
subroutine prepare_stest_m(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())
check=real(root + 1)
end subroutine prepare_stest_m
subroutine prepare_dtest_m(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())
check=dble(root + 1)
end subroutine prepare_dtest_m
subroutine prepare_ctest_m(dat,check,root,info, np, icontxt)
complex, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = complex(this_image(),this_image())
check=complex(root + 1,root + 1)
end subroutine prepare_ctest_m
subroutine prepare_ztest_m(dat,check,root,info, np, icontxt)
double complex, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer, parameter :: size_=23
integer :: me
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = complex(this_image(),this_image())
check=complex(root + 1,root + 1)
end subroutine prepare_ztest_m
!--------- REAL TESTS
@test(nimgs=[std])
subroutine test_psb_ibroadcast_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: dat, check, root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_ibroadcast_s
@test(nimgs=[std])
subroutine test_psb_sbroadcast_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_sbroadcast_s
@test(nimgs=[std])
subroutine test_psb_dbroadcast_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
print*,'from test:', this_image(), dat
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_dbroadcast_s
@test(nimgs=[std])
subroutine test_psb_cbroadcast_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
complex :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_cbroadcast_s
@test(nimgs=[std])
subroutine test_psb_zbroadcast_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double complex :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_zbroadcast_s
@test(nimgs=[std])
subroutine test_psb_ibroadcast_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_ibroadcast_v
@test(nimgs=[std])
subroutine test_psb_sbroadcast_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_sbroadcast_v
@test(nimgs=[std])
subroutine test_psb_dbroadcast_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_dbroadcast_v
@test(nimgs=[std])
subroutine test_psb_cbroadcast_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
complex, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_cbroadcast_v
@test(nimgs=[std])
subroutine test_psb_zbroadcast_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double complex, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_zbroadcast_v
@test(nimgs=[std])
subroutine test_psb_ibroadcast_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_ibroadcast_m
@test(nimgs=[std])
subroutine test_psb_sbroadcast_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_sbroadcast_m
@test(nimgs=[std])
subroutine test_psb_dbroadcast_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_dbroadcast_m
@test(nimgs=[std])
subroutine test_psb_cbroadcast_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
complex, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_cbroadcast_m
@test(nimgs=[std])
subroutine test_psb_zbroadcast_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double complex, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_bcast(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
deallocate(dat, check)
end subroutine test_psb_zbroadcast_m
end module test_psb_broadcast

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

@ -0,0 +1,80 @@
module test_psb_dmatdist
use pfunit_mod
use psb_base_mod
use psb_util_mod
implicit none
include 'mpif.h'
contains
@test(nimgs=[std])
subroutine test_psb_dmatdist1(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: me, np, info
integer :: icontxt
type(psb_desc_type):: desc_a
type(psb_dspmat_type) :: a, a_out
integer :: iunit=12, m_problem = 10, nv, i, nz, last, j, irow
integer, allocatable :: ipv(:), ivg(:), ia(:), ja(:)
integer, allocatable :: ia_exp(:), ja_exp(:)
real(psb_dpk_), allocatable :: val(:), val_exp(:), a_exp(:,:), a_aux(:,:)
me = this_image()
np = num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
call mm_mat_read(a,info,iunit=iunit,filename="matrix1.mtx")
allocate(ivg(m_problem),ipv(np))
do i=1,m_problem
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
!Getting the expected solution
call a%csgetrow(1,10,nz,ia,ja,val,info)
allocate(ia_exp(nz),ja_exp(nz), val_exp(nz))
last = 0
do i=1, m_problem
if (me == ivg(i) + 1) then
irow=i
do j=1, nz
if (ia(j) == irow) then
last = last + 1
ia_exp(last)=ia(j)
ja_exp(last)=ja(j)
val_exp(last)=val(j)
endif
enddo
endif
enddo
if (allocated(a_exp)) deallocate(a_exp)
allocate(a_exp(m_problem,m_problem))
a_exp = 0.0d0
do i=1,last
a_exp(ia_exp(i),ja_exp(i))=val_exp(i)
enddo
!Test subroutine
call psb_matdist(a, a_out, icontxt, &
& desc_a,info, v=ivg)
call a_out%csgetrow(1,10,nz,ia,ja,val,info)
!Convert to global indices
call psb_loc_to_glob(ia, desc_a, info)
call psb_loc_to_glob(ja, desc_a, info)
if (allocated(a_aux)) deallocate(a_aux)
allocate(a_aux(m_problem,m_problem))
a_aux = 0.0d0
do i=1,last
a_aux(ia(i),ja(i))=val(i)
enddo
@assertEqual(a_aux,a_exp)
!Free
deallocate(a_aux, a_exp, ia, ja, val)
deallocate(ipv, ivg, ia_exp, ja_exp, val_exp)
call psb_spfree(a, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_dmatdist1
end module test_psb_dmatdist

File diff suppressed because it is too large Load Diff

@ -0,0 +1,651 @@
module test_psb_max
use pfunit_mod
use psb_base_mod
implicit none
include 'mpif.h'
interface prepare_test
module procedure prepare_itest_s
module procedure prepare_stest_s
module procedure prepare_dtest_s
module procedure prepare_itest_v
module procedure prepare_stest_v
module procedure prepare_dtest_v
module procedure prepare_itest_m
module procedure prepare_stest_m
module procedure prepare_dtest_m
end interface prepare_test
interface prepare_test2
module procedure prepare_itest2_s
module procedure prepare_stest2_s
module procedure prepare_dtest2_s
module procedure prepare_itest2_v
module procedure prepare_stest2_v
module procedure prepare_dtest2_v
module procedure prepare_itest2_m
module procedure prepare_stest2_m
module procedure prepare_dtest2_m
end interface prepare_test2
contains
subroutine prepare_itest_s(dat,check,root,info, np, icontxt)
integer, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check = dat
if (me == root + 1) then
check= np
endif
end subroutine prepare_itest_s
subroutine prepare_stest_s(dat,check,root,info, np, icontxt)
real, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np + 1)
check = dat
if (me == root + 1) then
check= real(np)/real(np + 1)
endif
end subroutine prepare_stest_s
subroutine prepare_dtest_s(dat,check,root,info, np, icontxt)
double precision, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np + 1)
check = dat
if (me == root + 1) then
check= dble(np)/dble(np + 1)
endif
end subroutine prepare_dtest_s
subroutine prepare_itest_v(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check = dat
if (me == root + 1) then
check= np
endif
end subroutine prepare_itest_v
subroutine prepare_stest_v(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np + 1)
check = dat
if (me == root + 1) then
check= real(np)/real(np + 1)
endif
end subroutine prepare_stest_v
subroutine prepare_dtest_v(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np + 1)
check = dat
if (me == root + 1) then
check= dble(np)/dble(np + 1)
endif
end subroutine prepare_dtest_v
subroutine prepare_itest_m(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check = dat
if (me == root + 1) then
check= np
endif
end subroutine prepare_itest_m
subroutine prepare_stest_m(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np + 1)
check = dat
if (me == root + 1) then
check= real(np)/real(np + 1)
endif
end subroutine prepare_stest_m
subroutine prepare_dtest_m(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np + 1)
check = dat
if (me == root + 1) then
check= dble(np)/dble(np + 1)
endif
end subroutine prepare_dtest_m
subroutine prepare_itest2_s(dat,check,root,info, np, icontxt)
integer, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=-1
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check= np
end subroutine prepare_itest2_s
subroutine prepare_stest2_s(dat,check,root,info, np, icontxt)
real, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=-1
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np + 1)
check= real(np)/real(np + 1)
end subroutine prepare_stest2_s
subroutine prepare_dtest2_s(dat,check,root,info, np, icontxt)
double precision, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=-1
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np + 1)
check= dble(np)/dble(np + 1)
end subroutine prepare_dtest2_s
subroutine prepare_itest2_v(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check= np
end subroutine prepare_itest2_v
subroutine prepare_stest2_v(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np + 1)
check= real(np)/real(np + 1)
end subroutine prepare_stest2_v
subroutine prepare_dtest2_v(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np + 1)
check= dble(np)/dble(np + 1)
end subroutine prepare_dtest2_v
subroutine prepare_itest2_m(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check= np
end subroutine prepare_itest2_m
subroutine prepare_stest2_m(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np + 1)
check= real(np)/real(np + 1)
end subroutine prepare_stest2_m
subroutine prepare_dtest2_m(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np + 1)
check= dble(np)/dble(np + 1)
end subroutine prepare_dtest2_m
!--------- REAL TESTS
@test(nimgs=[std])
subroutine test_psb_imax_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: dat, check, root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
print*,'dat, check before', dat, check, this_image()
call psb_max(icontxt, dat, root)
print*,'dat after', dat, this_image()
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_imax_s
@test(nimgs=[std])
subroutine test_psb_smax_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_smax_s
@test(nimgs=[std])
subroutine test_psb_dmax_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
print*,'dat, check before', dat, check, this_image()
call psb_max(icontxt, dat, root)
print*,'dat after', dat, this_image()
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_dmax_s
@test(nimgs=[std])
subroutine test_psb_imax_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_imax_v
@test(nimgs=[std])
subroutine test_psb_smax_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_smax_v
@test(nimgs=[std])
subroutine test_psb_dmax_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_dmax_v
@test(nimgs=[std])
subroutine test_psb_imax_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_imax_m
@test(nimgs=[std])
subroutine test_psb_smax_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_smax_m
@test(nimgs=[std])
subroutine test_psb_dmax_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_dmax_m
@test(nimgs=[std])
subroutine test2_psb_imax_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: dat, check, root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
print*,'dat, check before', dat, check, this_image()
call psb_max(icontxt, dat, root)
print*,'dat after', dat, this_image()
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test2_psb_imax_s
@test(nimgs=[std])
subroutine test2_psb_smax_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real :: dat, check
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test2_psb_smax_s
@test(nimgs=[std])
subroutine test2_psb_dmax_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision :: dat, check
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
print*,'dat, check before', dat, check, this_image()
call psb_max(icontxt, dat, root)
print*,'dat after', dat, this_image()
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test2_psb_dmax_s
@test(nimgs=[std])
subroutine test2_psb_imax_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_imax_v
@test(nimgs=[std])
subroutine test2_psb_smax_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_smax_v
@test(nimgs=[std])
subroutine test2_psb_dmax_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_dmax_v
@test(nimgs=[std])
subroutine test2_psb_imax_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_imax_m
@test(nimgs=[std])
subroutine test2_psb_smax_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_smax_m
@test(nimgs=[std])
subroutine test2_psb_dmax_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_max(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_dmax_m
end module test_psb_max

@ -0,0 +1,645 @@
module test_psb_min
use pfunit_mod
use psb_base_mod
implicit none
include 'mpif.h'
interface prepare_test
module procedure prepare_itest_s
module procedure prepare_stest_s
module procedure prepare_dtest_s
module procedure prepare_itest_v
module procedure prepare_stest_v
module procedure prepare_dtest_v
module procedure prepare_itest_m
module procedure prepare_stest_m
module procedure prepare_dtest_m
end interface prepare_test
interface prepare_test2
module procedure prepare_itest2_s
module procedure prepare_stest2_s
module procedure prepare_dtest2_s
module procedure prepare_itest2_v
module procedure prepare_stest2_v
module procedure prepare_dtest2_v
module procedure prepare_itest2_m
module procedure prepare_stest2_m
module procedure prepare_dtest2_m
end interface prepare_test2
contains
subroutine prepare_itest_s(dat,check,root,info, np, icontxt)
integer, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check = dat
if (me == root + 1) then
check= 1
endif
end subroutine prepare_itest_s
subroutine prepare_stest_s(dat,check,root,info, np, icontxt)
real, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np)
check = dat
if (me == root + 1) then
check= real(1)/real(np)
endif
end subroutine prepare_stest_s
subroutine prepare_dtest_s(dat,check,root,info, np, icontxt)
double precision, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=0
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np)
check = dat
if (me == root + 1) then
check= dble(1)/dble(np)
endif
end subroutine prepare_dtest_s
subroutine prepare_itest_v(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check = dat
if (me == root + 1) then
check= 1
endif
end subroutine prepare_itest_v
subroutine prepare_stest_v(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np)
check = dat
if (me == root + 1) then
check= real(1)/real(np)
endif
end subroutine prepare_stest_v
subroutine prepare_dtest_v(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np)
check = dat
if (me == root + 1) then
check= dble(1)/dble(np)
endif
end subroutine prepare_dtest_v
subroutine prepare_itest_m(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check = dat
if (me == root + 1) then
check= 1
endif
end subroutine prepare_itest_m
subroutine prepare_stest_m(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np)
check = dat
if (me == root + 1) then
check= real(1)/real(np)
endif
end subroutine prepare_stest_m
subroutine prepare_dtest_m(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=0
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np)
check = dat
if (me == root + 1) then
check= dble(1)/dble(np)
endif
end subroutine prepare_dtest_m
subroutine prepare_itest2_s(dat,check,root,info, np, icontxt)
integer, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=-1
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check= 1
end subroutine prepare_itest2_s
subroutine prepare_stest2_s(dat,check,root,info, np, icontxt)
real, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=-1
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np)
check= real(1)/real(np)
end subroutine prepare_stest2_s
subroutine prepare_dtest2_s(dat,check,root,info, np, icontxt)
double precision, intent(out) :: dat, check
integer, intent(out) :: root, info, np, icontxt
integer :: me
info = 0
root=-1
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np)
check= dble(1)/dble(np)
end subroutine prepare_dtest2_s
subroutine prepare_itest2_v(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check= 1
end subroutine prepare_itest2_v
subroutine prepare_stest2_v(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np)
check= real(1)/real(np)
end subroutine prepare_stest2_v
subroutine prepare_dtest2_v(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:), check(:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_),check(size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np)
check= dble(1)/dble(np)
end subroutine prepare_dtest2_v
subroutine prepare_itest2_m(dat,check,root,info, np, icontxt)
integer, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = this_image()
check= 1
end subroutine prepare_itest2_m
subroutine prepare_stest2_m(dat,check,root,info, np, icontxt)
real, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = real(this_image())/real(np)
check= real(1)/real(np)
end subroutine prepare_stest2_m
subroutine prepare_dtest2_m(dat,check,root,info, np, icontxt)
double precision, allocatable, intent(out) :: dat(:,:), check(:,:)
integer, intent(out) :: root, info, np, icontxt
integer :: me
integer, parameter :: size_=23
info = 0
root=-1
if (allocated(dat)) deallocate(dat)
if (allocated(dat)) deallocate(check)
allocate(dat(size_,size_),check(size_,size_), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
me=this_image()
np= num_images()
call psb_init(icontxt,np,MPI_COMM_WORLD)
dat = dble(this_image())/dble(np)
check= dble(1)/dble(np)
end subroutine prepare_dtest2_m
!--------- REAL TESTS
@test(nimgs=[std])
subroutine test_psb_imin_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: dat, check, root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_imin_s
@test(nimgs=[std])
subroutine test_psb_smin_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_smin_s
@test(nimgs=[std])
subroutine test_psb_dmin_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision :: dat, check
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test_psb_dmin_s
@test(nimgs=[std])
subroutine test_psb_imin_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_imin_v
@test(nimgs=[std])
subroutine test_psb_smin_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_smin_v
@test(nimgs=[std])
subroutine test_psb_dmin_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_dmin_v
@test(nimgs=[std])
subroutine test_psb_imin_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_imin_m
@test(nimgs=[std])
subroutine test_psb_smin_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_smin_m
@test(nimgs=[std])
subroutine test_psb_dmin_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test_psb_dmin_m
@test(nimgs=[std])
subroutine test2_psb_imin_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer :: dat, check, root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test2_psb_imin_s
@test(nimgs=[std])
subroutine test2_psb_smin_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real :: dat, check
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test2_psb_smin_s
@test(nimgs=[std])
subroutine test2_psb_dmin_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision :: dat, check
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
call psb_exit(icontxt)
end subroutine test2_psb_dmin_s
@test(nimgs=[std])
subroutine test2_psb_imin_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_imin_v
@test(nimgs=[std])
subroutine test2_psb_smin_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_smin_v
@test(nimgs=[std])
subroutine test2_psb_dmin_v(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:), check(:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_dmin_v
@test(nimgs=[std])
subroutine test2_psb_imin_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
integer, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_imin_m
@test(nimgs=[std])
subroutine test2_psb_smin_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
real, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_smin_m
@test(nimgs=[std])
subroutine test2_psb_dmin_m(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
double precision, allocatable :: dat(:,:), check(:,:)
integer :: root, info, np, icontxt
call prepare_test2(dat,check,root,info, np, icontxt)
call psb_min(icontxt, dat, root)
@assertEqual(dat,check)
deallocate(dat, check)
call psb_exit(icontxt)
end subroutine test2_psb_dmin_m
end module test_psb_min

@ -0,0 +1,369 @@
module test_psb_reduce_nrm2
use pfunit_mod
use psb_base_mod
use psi_reduce_mod
implicit none
include 'mpif.h'
interface prepare_test
module procedure prepare_ctest2imgs
module procedure prepare_stest2imgs
module procedure prepare_dtest2imgs
end interface prepare_test
contains
subroutine prepare_ctest2imgs(desc_a,x,result, np, icontxt, info)
use psb_base_mod
IMPLICIT NONE
type(psb_desc_type), intent(out):: desc_a
type(psb_c_vect_type), intent(out) :: x
real(psb_spk_), intent(out) :: result
integer, intent(out) :: icontxt, info
integer, intent(in) :: np
integer :: me, i=0, j
integer, parameter :: nrows=6
integer :: mid, true
integer, allocatable :: vg(:), ia(:)
complex(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: iictxt, icomm, flag
me = this_image()
info = 0
if (np < 2) then
print*,'You need at least 2 processes to run this test.'
info = 1
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
!Allocate vectors
if (allocated(vg)) deallocate(vg)
if (allocated(ia)) deallocate(ia)
if (allocated(val)) deallocate(val)
allocate(vg(nrows), STAT=info)
if (info == 0) allocate(ia(nrows), STAT=info)
if (info == 0) allocate(val(nrows), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
!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.,1.)
enddo
do i=mid + 1,nrows
val(i)=(2.,2.)
enddo
call psb_cdall(icontxt,desc_a,info, vg=vg)
if (info /=0) then
print*,'ERROR in desc allocation', info
stop
endif
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)
if (info /=0) then
print*,'ERROR in psb_cdins', info
stop
endif
call psb_cdasb(desc_a, info)
if (info /=0) then
print*,'an error in psb_cdasb', info
stop
endif
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)
sync all
!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.0,2.0)
endif
!Let's build the expected solution
result = 5.47722578E0
if (allocated(vg)) deallocate(vg)
if (allocated(ia)) deallocate(ia)
if (allocated(val)) deallocate(val)
end subroutine prepare_ctest2imgs
subroutine prepare_stest2imgs(desc_a,x,result, np, icontxt, info)
use psb_base_mod
IMPLICIT NONE
type(psb_desc_type), intent(out):: desc_a
type(psb_s_vect_type), intent(out) :: x
real(psb_spk_), intent(out) :: result
integer, intent(out) :: icontxt, info
integer, intent(in) :: np
integer :: me, i=0, j
integer, parameter :: nrows=6
integer :: mid, true
integer, allocatable :: vg(:), ia(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_ipk_) :: iictxt, icomm, flag
me = this_image()
info = 0
if (np < 2) then
print*,'You need at least 2 processes to run this test.'
info = 1
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
!Allocate vectors
if (allocated(vg)) deallocate(vg)
if (allocated(ia)) deallocate(ia)
if (allocated(val)) deallocate(val)
allocate(vg(nrows), STAT=info)
if (info == 0) allocate(ia(nrows), STAT=info)
if (info == 0) allocate(val(nrows), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
!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 (info /=0) then
print*,'ERROR in desc allocation', info
stop
endif
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)
if (info /=0) then
print*,'ERROR in psb_cdins', info
stop
endif
call psb_cdasb(desc_a, info)
if (info /=0) then
print*,'an error in psb_cdasb', info
stop
endif
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)
sync all
!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.0E0
endif
!Let's build the expected solution
result = 3.87298322E0
if (allocated(vg)) deallocate(vg)
if (allocated(ia)) deallocate(ia)
if (allocated(val)) deallocate(val)
end subroutine prepare_stest2imgs
subroutine prepare_dtest2imgs(desc_a,x,result, np, icontxt, info)
use psb_base_mod
IMPLICIT NONE
type(psb_desc_type), intent(out):: desc_a
type(psb_d_vect_type), intent(out) :: x
real(psb_dpk_), intent(out) :: result
integer, intent(out) :: icontxt, info
integer, intent(in) :: np
integer :: me, i=0, j
integer, parameter :: nrows=6
integer :: mid, true
integer, allocatable :: vg(:), ia(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_) :: iictxt, icomm, flag
me = this_image()
info = 0
if (np < 2) then
print*,'You need at least 2 processes to run this test.'
info = 1
return
endif
call psb_init(icontxt,np,MPI_COMM_WORLD)
!Allocate vectors
if (allocated(vg)) deallocate(vg)
if (allocated(ia)) deallocate(ia)
if (allocated(val)) deallocate(val)
allocate(vg(nrows), STAT=info)
if (info == 0) allocate(ia(nrows), STAT=info)
if (info == 0) allocate(val(nrows), STAT=info)
if (info /=0) then
print*,'ERROR while allocating some vectors'
info = -1
stop
endif
!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 (info /=0) then
print*,'ERROR in desc allocation', info
stop
endif
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)
if (info /=0) then
print*,'ERROR in psb_cdins', info
stop
endif
call psb_cdasb(desc_a, info)
if (info /=0) then
print*,'an error in psb_cdasb', info
stop
endif
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)
sync all
!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
!Let's build the expected solution
result = 3.8729833462074170d0
if (allocated(vg)) deallocate(vg)
if (allocated(ia)) deallocate(ia)
if (allocated(val)) deallocate(val)
end subroutine prepare_dtest2imgs
!--------- REAL TESTS
@test(nimgs=[std])
subroutine test_psb_cnrm2_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
type(psb_desc_type):: desc_a
type(psb_c_vect_type) :: x
complex(psb_spk_), allocatable :: v(:)
integer :: info, np, icontxt
real(psb_spk_) :: expected, result
np = num_images()
call prepare_test(desc_a,x,expected, np, icontxt, info)
v=x%get_vect()
call psb_genrm2s(result, v, desc_a,info)
@assertEqual(result,expected)
if (allocated(v)) deallocate(v)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_cnrm2_s
@test(nimgs=[std])
subroutine test_psb_snrm2_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
type(psb_desc_type):: desc_a
type(psb_s_vect_type) :: x
real(psb_spk_), allocatable :: v(:)
integer :: info, np, icontxt
real(psb_spk_) :: expected, result
np = num_images()
call prepare_test(desc_a,x,expected, np, icontxt, info)
v=x%get_vect()
call psb_genrm2s(result, v, desc_a,info)
@assertEqual(result,expected)
if (allocated(v)) deallocate(v)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_snrm2_s
@test(nimgs=[std])
subroutine test_psb_dnrm2_s(this)
implicit none
Class(CafTestMethod), intent(inout) :: this
type(psb_desc_type):: desc_a
type(psb_d_vect_type) :: x
real(psb_dpk_), allocatable :: v(:)
integer :: info, np, icontxt
real(psb_dpk_) :: expected, result
np = num_images()
call prepare_test(desc_a,x,expected, np, icontxt, info)
v=x%get_vect()
call psb_genrm2s(result, v, desc_a,info)
@assertEqual(result,expected)
call psb_gefree(x, desc_a, info)
call psb_cdfree(desc_a, info)
call psb_exit(icontxt)
end subroutine test_psb_dnrm2_s
end module test_psb_reduce_nrm2

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save