You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2813 lines
86 KiB
Fortran
2813 lines
86 KiB
Fortran
module psb_d_mvsv_tester
|
|
contains
|
|
|
|
|
|
subroutine d_usmv_2_n_ap3_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=1
|
|
! 1 1
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 1/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/9, 3/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_ap3_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_ap3_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 0 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/6, 6/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_ap3_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_ap3_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 3 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/15, 6/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 1 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_ap3_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=0
|
|
! 1 3
|
|
! 3 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
|
|
real*8 :: VA(3)=(/1, 3, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/12, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_ap3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=0
|
|
! 1 3
|
|
! 3 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
|
|
real*8 :: VA(3)=(/1, 3, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/12, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_ap3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=1
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(1)=(/1/)
|
|
integer(psb_ipk_) :: JA(1)=(/1/)
|
|
real*8 :: VA(1)=(/1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/3, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_ap3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_ap1_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 0 2
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 2/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/4, 5/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_ap1_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_ap1_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 1 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 1/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/5, 3/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_ap1_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_ap1_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=1
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(1)=(/1/)
|
|
integer(psb_ipk_) :: JA(1)=(/1/)
|
|
real*8 :: VA(1)=(/1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/4, 3/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 1 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_ap1_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 3 4
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 4/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/1, 7/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_ap1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 1 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 1/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/2, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_ap1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 3
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/1, 3/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_ap1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_am1_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 0 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/2, 2/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_am1_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_am1_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=1
|
|
! 1 3
|
|
! 1 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
|
|
real*8 :: VA(3)=(/1, 3, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/1, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_am1_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_am1_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 0 3
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/2, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 1 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_am1_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=0
|
|
! 1 3
|
|
! 0 3
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 2, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-4, -3/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_am1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 3 5
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 5/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-4, -5/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_am1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=0
|
|
! 1 2
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 1/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 2/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-1, -2/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_am1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_am3_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=1
|
|
! 1 0
|
|
! 0 6
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 6/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/0, -15/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_am3_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_am3_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=1
|
|
! 1 2
|
|
! 1 3
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=4
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(4)=(/1, 1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(4)=(/1, 2, 1, 2/)
|
|
real*8 :: VA(4)=(/1, 2, 1, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-3, -12/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_am3_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_am3_bp1_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=1
|
|
! 1 3
|
|
! 3 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 1, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 2, 1/)
|
|
real*8 :: VA(3)=(/1, 3, 3/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-9, -6/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 1 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_am3_bp1_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=1
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(1)=(/1/)
|
|
integer(psb_ipk_) :: JA(1)=(/1/)
|
|
real*8 :: VA(1)=(/1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-3, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_usmv_2_n_am3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=1
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(1)=(/1/)
|
|
integer(psb_ipk_) :: JA(1)=(/1/)
|
|
real*8 :: VA(1)=(/1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-3, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_usmv_2_t_am3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_usmv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
integer(psb_ipk_) :: incy=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 0
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=1
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(1)=(/1/)
|
|
integer(psb_ipk_) :: JA(1)=(/1/)
|
|
real*8 :: VA(1)=(/1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/-3, 0/)! reference cy after
|
|
real*8 :: bcy(2)=(/3, 3/)! reference bcy before
|
|
real*8 :: y(2)=(/3, 3/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spmm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spmm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 usmv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_usmv_2_c_am3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_n_ap3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 3 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 1/)
|
|
real*8 :: x(2)=(/3, 12/)! reference x
|
|
real*8 :: cy(2)=(/9, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_ussv_2_n_ap3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_t_ap3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 2 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 2, 1/)
|
|
real*8 :: x(2)=(/9, 3/)! reference x
|
|
real*8 :: cy(2)=(/9, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_ussv_2_t_ap3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_c_ap3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 3 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 1/)
|
|
real*8 :: x(2)=(/12, 3/)! reference x
|
|
real*8 :: cy(2)=(/9, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 3 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_ussv_2_c_ap3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_n_ap1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 3 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 3, 1/)
|
|
real*8 :: x(2)=(/1, 4/)! reference x
|
|
real*8 :: cy(2)=(/1, 1/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_ussv_2_n_ap1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_t_ap1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 1 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 1, 1/)
|
|
real*8 :: x(2)=(/2, 1/)! reference x
|
|
real*8 :: cy(2)=(/1, 1/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_ussv_2_t_ap1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_c_ap1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/1, 1/)! reference x
|
|
real*8 :: cy(2)=(/1, 1/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha= 1 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_ussv_2_c_ap1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_n_am1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 1 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 1, 1/)
|
|
real*8 :: x(2)=(/-1, -2/)! reference x
|
|
real*8 :: cy(2)=(/1, 1/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_ussv_2_n_am1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_t_am1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 6 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 6, 1/)
|
|
real*8 :: x(2)=(/-7, -1/)! reference x
|
|
real*8 :: cy(2)=(/1, 1/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_ussv_2_t_am1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_c_am1_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=-1
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 2 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 2, 1/)
|
|
real*8 :: x(2)=(/-3, -1/)! reference x
|
|
real*8 :: cy(2)=(/1, 1/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-1 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_ussv_2_c_am1_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_n_am3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='n'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 1 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=3
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(3)=(/1, 2, 2/)
|
|
integer(psb_ipk_) :: JA(3)=(/1, 1, 2/)
|
|
real*8 :: VA(3)=(/1, 1, 1/)
|
|
real*8 :: x(2)=(/-3, -6/)! reference x
|
|
real*8 :: cy(2)=(/9, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=n is ok"
|
|
end subroutine d_ussv_2_n_am3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_t_am3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='t'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/-3, -3/)! reference x
|
|
real*8 :: cy(2)=(/9, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=t is ok"
|
|
end subroutine d_ussv_2_t_am3_bm0_ix1_iy1
|
|
!
|
|
|
|
subroutine d_ussv_2_c_am3_bm0_ix1_iy1(res,afmt,ctxt)
|
|
use psb_base_mod
|
|
implicit none
|
|
character(len=*) :: afmt
|
|
type(psb_dspmat_type) :: a
|
|
type(psb_desc_type) :: desc_a
|
|
type(psb_ctxt_type) :: ctxt
|
|
integer(psb_ipk_) :: iam=-1, np=-1
|
|
integer(psb_ipk_) :: info=-1
|
|
|
|
integer(psb_ipk_) ::res,istat=0,i
|
|
character::transa='c'
|
|
integer(psb_ipk_) :: incx=1
|
|
real*8 :: alpha=-3
|
|
real*8 :: beta=0
|
|
! 1 0
|
|
! 0 1
|
|
|
|
! declaration of VA,IA,JA
|
|
integer(psb_ipk_) :: nnz=2
|
|
integer(psb_ipk_) :: m=2
|
|
integer(psb_ipk_) :: k=2
|
|
integer(psb_ipk_) :: IA(2)=(/1, 2/)
|
|
integer(psb_ipk_) :: JA(2)=(/1, 2/)
|
|
real*8 :: VA(2)=(/1, 1/)
|
|
real*8 :: x(2)=(/-3, -3/)! reference x
|
|
real*8 :: cy(2)=(/9, 9/)! reference cy after
|
|
real*8 :: bcy(2)=(/0, 0/)! reference bcy before
|
|
real*8 :: y(2)=(/0, 0/)! y
|
|
|
|
y=bcy
|
|
res=0
|
|
call psb_info(ctxt,iam,np)
|
|
if(iam<0)then
|
|
info=-1
|
|
goto 9999
|
|
endif
|
|
call psb_barrier(ctxt)
|
|
call psb_cdall(ctxt,desc_a,info,nl=m)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spall(a,desc_a,info,nnz=nnz)
|
|
if (info /= psb_success_)goto 9996
|
|
call a%set_triangle()
|
|
call a%set_lower()
|
|
call a%set_unit(.false.)
|
|
|
|
call psb_barrier(ctxt)
|
|
call psb_spins(nnz,IA,JA,VA,a,desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_cdasb(desc_a,info)
|
|
if (info /= psb_success_)goto 9996
|
|
call psb_spasb(a,desc_a,info,afmt=afmt)
|
|
if(info.ne.0)print *,"matrix assembly failed"
|
|
if(info.ne.0)goto 9996
|
|
|
|
call psb_spsm(alpha,A,x,beta,y,desc_a,info,transa)
|
|
if(info.ne.0)print *,"psb_spsm failed"
|
|
if(info.ne.0)goto 9996
|
|
do i=1,2
|
|
if(y(i) /= cy(i))print*,"results mismatch:",y,"instead of",cy
|
|
if(y(i) /= cy(i))info=-1
|
|
if(y(i) /= cy(i))goto 9996
|
|
enddo
|
|
9996 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_spfree(a,desc_a,info)
|
|
if (info /= psb_success_)goto 9997
|
|
9997 continue
|
|
if(info /= psb_success_)res=res+1
|
|
call psb_cdfree(desc_a,info)
|
|
if (info /= psb_success_)goto 9998
|
|
9998 continue
|
|
if(info /= psb_success_)res=res+1
|
|
9999 continue
|
|
if(info /= psb_success_)res=res+1
|
|
if(res /= 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is not ok"
|
|
if(res == 0)print*,"on d matrix 2 x 2 blocked 1 x 1 ussv alpha=-3 beta= 0 incx=1 incy=1 trans=c is ok"
|
|
end subroutine d_ussv_2_c_am3_bm0_ix1_iy1
|
|
!
|
|
end module psb_d_mvsv_tester
|