test/fileread/runs/dfs.inp
 util/psb_amd_order.c
 util/psb_d_renum_impl.F90

Fixed interface with AMD.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 1b2cf62547
commit 49b895aeb0

@ -1,6 +1,6 @@
11 Number of inputs 11 Number of inputs
sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or pde40.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html NONE sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
MM File format: MM: Matrix Market HB: Harwell-Boeing. MM File format: MM: Matrix Market HB: Harwell-Boeing.
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC

@ -38,7 +38,7 @@ int psb_amd_order(int n, int Ap[], int Ai[], int P[])
int i; int i;
#ifdef HAVE_AMD_ #ifdef HAVE_AMD_
i= amd_order(n,Ap,Ai, P,(double *)NULL, (double *)NULL); i= amd_order(n,Ap,Ai, P,(double *)NULL, (double *)NULL);
if ((i==AMD_OK)||(AMD_OK_BUT_JUMBLED)) return(0); if ((i==AMD_OK)||(i==AMD_OK_BUT_JUMBLED)) return(0);
#endif #endif
return(-1); return(-1);
} }

@ -188,14 +188,15 @@ contains
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, allocatable, optional, intent(out) :: operm(:) integer, allocatable, optional, intent(out) :: operm(:)
! !
#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING) #if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
interface interface
function psb_amd_order(n,ap,ai,p)& function psb_amd_order(n,ap,ai,p)&
& result(res) bind(c,name='psb_amd_order') & result(res) bind(c,name='psb_amd_order')
use iso_c_binding use iso_c_binding
integer(c_int) :: res, n integer(c_int) :: res
integer(c_int), value :: n
integer(c_int) :: ap(*), ai(*), p(*) integer(c_int) :: ap(*), ai(*), p(*)
end function psb_amd_order end function psb_amd_order
end interface end interface
@ -204,10 +205,10 @@ contains
type(psb_d_csc_sparse_mat) :: acsc type(psb_d_csc_sparse_mat) :: acsc
class(psb_d_base_sparse_mat), allocatable :: aa class(psb_d_base_sparse_mat), allocatable :: aa
type(psb_d_coo_sparse_mat) :: acoo type(psb_d_coo_sparse_mat) :: acoo
integer :: err_act integer :: err_act
character(len=20) :: name character(len=20) :: name
integer :: i, j, k, ideg, nr, ibw, ipf, idpth integer :: i, j, k, ideg, nr, ibw, ipf, idpth, nz
info = psb_success_ info = psb_success_
name = 'mat_renum_amd' name = 'mat_renum_amd'
@ -216,24 +217,32 @@ contains
#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING) #if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING)
info = psb_success_ info = psb_success_
nr = a%get_nrows() nr = a%get_nrows()
allocate(perm(nr)) nz = a%get_nzeros()
allocate(perm(nr),stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%mold(aa)
call a%mv_to(aa) allocate(aa, mold=a%a)
call aa%mv_to_fmt(acsc,info) call a%mv_to(acsc)
acsc%ia(:) = acsc%ia(:) - 1 acsc%ia(:) = acsc%ia(:) - 1
acsc%icp(:) = acsc%icp(:) - 1 acsc%icp(:) = acsc%icp(:) - 1
info = psb_amd_order(nr,acsc%icp,acsc%ia,perm) info = psb_amd_order(nr,acsc%icp,acsc%ia,perm)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_from_subroutine_ info = psb_err_from_subroutine_
call psb_errpush(info,name) call psb_errpush(info,name,a_err='psb_amd_order')
goto 9999 goto 9999
end if end if
perm(:) = perm(:) + 1 perm(:) = perm(:) + 1
acsc%ia(:) = acsc%ia(:) - 1 acsc%ia(:) = acsc%ia(:) + 1
acsc%icp(:) = acsc%icp(:) - 1 acsc%icp(:) = acsc%icp(:) + 1
call acsc%mv_to_coo(acoo,info) call acsc%mv_to_coo(acoo,info)
do i=1, acoo%get_nzeros() do i=1, acoo%get_nzeros()
@ -254,9 +263,9 @@ contains
end if end if
operm(1:nr) = perm(1:nr) operm(1:nr) = perm(1:nr)
end if end if
deallocate(aa,perm) deallocate(aa,perm)
#else #else
info = psb_err_missing_aux_lib_ info = psb_err_missing_aux_lib_

Loading…
Cancel
Save