added tests for halo exchange, dmat_dist, some of the collective subroutines
parent
af9ee44d73
commit
fc8e6c6895
@ -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…
Reference in New Issue