From 49b895aeb012412e029cf92e86a8605825d18cc8 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 22 Nov 2011 10:15:28 +0000 Subject: [PATCH] psblas3: test/fileread/runs/dfs.inp util/psb_amd_order.c util/psb_d_renum_impl.F90 Fixed interface with AMD. --- test/fileread/runs/dfs.inp | 4 ++-- util/psb_amd_order.c | 2 +- util/psb_d_renum_impl.F90 | 37 +++++++++++++++++++++++-------------- 3 files changed, 26 insertions(+), 17 deletions(-) diff --git a/test/fileread/runs/dfs.inp b/test/fileread/runs/dfs.inp index bc55c554..c2521d76 100644 --- a/test/fileread/runs/dfs.inp +++ b/test/fileread/runs/dfs.inp @@ -1,6 +1,6 @@ 11 Number of inputs -sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or -sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html +pde40.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or +NONE sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html MM File format: MM: Matrix Market HB: Harwell-Boeing. BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG BJAC Preconditioner NONE DIAG BJAC diff --git a/util/psb_amd_order.c b/util/psb_amd_order.c index b4aab068..e1df5a4a 100644 --- a/util/psb_amd_order.c +++ b/util/psb_amd_order.c @@ -38,7 +38,7 @@ int psb_amd_order(int n, int Ap[], int Ai[], int P[]) int i; #ifdef HAVE_AMD_ 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 return(-1); } diff --git a/util/psb_d_renum_impl.F90 b/util/psb_d_renum_impl.F90 index 601d278a..ecac7b93 100644 --- a/util/psb_d_renum_impl.F90 +++ b/util/psb_d_renum_impl.F90 @@ -188,14 +188,15 @@ contains type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info integer, allocatable, optional, intent(out) :: operm(:) - + ! #if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING) interface function psb_amd_order(n,ap,ai,p)& & result(res) bind(c,name='psb_amd_order') use iso_c_binding - integer(c_int) :: res, n + integer(c_int) :: res + integer(c_int), value :: n integer(c_int) :: ap(*), ai(*), p(*) end function psb_amd_order end interface @@ -204,10 +205,10 @@ contains type(psb_d_csc_sparse_mat) :: acsc class(psb_d_base_sparse_mat), allocatable :: aa type(psb_d_coo_sparse_mat) :: acoo - + integer :: err_act 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_ name = 'mat_renum_amd' @@ -216,24 +217,32 @@ contains #if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING) info = psb_success_ - nr = a%get_nrows() - allocate(perm(nr)) + nr = a%get_nrows() + 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) - call aa%mv_to_fmt(acsc,info) + + allocate(aa, mold=a%a) + call a%mv_to(acsc) acsc%ia(:) = acsc%ia(:) - 1 acsc%icp(:) = acsc%icp(:) - 1 + info = psb_amd_order(nr,acsc%icp,acsc%ia,perm) if (info /= psb_success_) then info = psb_err_from_subroutine_ - call psb_errpush(info,name) + call psb_errpush(info,name,a_err='psb_amd_order') goto 9999 end if + perm(:) = perm(:) + 1 - acsc%ia(:) = acsc%ia(:) - 1 - acsc%icp(:) = acsc%icp(:) - 1 + acsc%ia(:) = acsc%ia(:) + 1 + acsc%icp(:) = acsc%icp(:) + 1 call acsc%mv_to_coo(acoo,info) do i=1, acoo%get_nzeros() @@ -254,9 +263,9 @@ contains end if operm(1:nr) = perm(1:nr) end if - + deallocate(aa,perm) - + #else info = psb_err_missing_aux_lib_