diff --git a/config/pac.m4 b/config/pac.m4 index 828787ad..5e31a441 100644 --- a/config/pac.m4 +++ b/config/pac.m4 @@ -1583,6 +1583,7 @@ fi if test "x$pac_amd_header_ok" == "xyes" ; then + psblas_cv_amd_includes="$AMD_INCLUDES" AMD_LIBS="$psblas_cv_amd $AMD_LIBDIR" LIBS="$AMD_LIBS -lm $LIBS"; AC_MSG_CHECKING([for amd_order in $AMD_LIBS]) diff --git a/configure b/configure index b882587b..5fbdd694 100755 --- a/configure +++ b/configure @@ -9152,6 +9152,7 @@ fi if test "x$pac_amd_header_ok" == "xyes" ; then + psblas_cv_amd_includes="$AMD_INCLUDES" AMD_LIBS="$psblas_cv_amd $AMD_LIBDIR" LIBS="$AMD_LIBS -lm $LIBS"; { $as_echo "$as_me:${as_lineno-$LINENO}: checking for amd_order in $AMD_LIBS" >&5 @@ -9282,6 +9283,7 @@ CPPFLAGS="$SAVE_CPPFLAGS"; if test "x$psblas_cv_have_amd" == "xyes" ; then FDEFINES="$mld_cv_define_prepend-DHAVE_AMD $FDEFINES" + CDEFINES="-DHAVE_AMD_ $psblas_cv_amd_includes $CDEFINES" fi diff --git a/configure.ac b/configure.ac index 9a5bb692..ec2ea03b 100755 --- a/configure.ac +++ b/configure.ac @@ -684,6 +684,7 @@ fi PAC_CHECK_AMD if test "x$psblas_cv_have_amd" == "xyes" ; then FDEFINES="$mld_cv_define_prepend-DHAVE_AMD $FDEFINES" + CDEFINES="-DHAVE_AMD_ $psblas_cv_amd_includes $CDEFINES" fi diff --git a/util/Makefile b/util/Makefile index 136d8ff2..bd461d7a 100644 --- a/util/Makefile +++ b/util/Makefile @@ -17,7 +17,8 @@ IMPLOBJS= psb_s_hbio_impl.o psb_d_hbio_impl.o \ psb_s_renum_impl.o psb_d_renum_impl.o \ psb_c_renum_impl.o psb_z_renum_impl.o MODOBJS=psb_util_mod.o $(BASEOBJS) -OBJS=$(MODOBJS) $(IMPLOBJS) +COBJS=psb_amd_interface.o +OBJS=$(MODOBJS) $(IMPLOBJS) $(COBJS) LIBMOD=psb_util_mod$(.mod) LOCAL_MODS=$(MODOBJS:.o=$(.mod)) LIBNAME=$(UTILLIBNAME) diff --git a/util/psb_amd_interface.c b/util/psb_amd_interface.c new file mode 100644 index 00000000..e5d899c0 --- /dev/null +++ b/util/psb_amd_interface.c @@ -0,0 +1,45 @@ +/* + Parallel Sparse BLAS version 3.0 + (C) Copyright 2006, 2007, 2008, 2009, 2010 + Salvatore Filippone University of Rome Tor Vergata + Alfredo Buttari CNRS-IRIT, Toulouse + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions, and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. The name of the PSBLAS group or the names of its contributors may + not be used to endorse or promote products derived from this + software without specific written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED + TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR + PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS + BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + +*/ +#ifdef HAVE_AMD_ +#include "amd.h" +#endif + +int psb_amd_interface(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); +#endif + return(-1); +} + diff --git a/util/psb_d_renum_impl.F90 b/util/psb_d_renum_impl.F90 index 14d22239..9451e357 100644 --- a/util/psb_d_renum_impl.F90 +++ b/util/psb_d_renum_impl.F90 @@ -180,20 +180,33 @@ contains subroutine psb_mat_renum_amd(a,info,operm) +#if defined(HAVE_AMD) && defined(HAVE_ISO_C_BINDING) + use iso_c_binding +#endif use psb_base_mod implicit none 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_interface(n,ap,ai,p)& + & result(res) bind(c,name='psb_amd_interface') + use iso_c_binding + integer(c_int) :: res, n + integer(c_int) :: ap(*), ai(*), p(*) + end function psb_amd_interface + end interface +#endif + + type(psb_d_csc_sparse_mat) :: acsc class(psb_d_base_sparse_mat), allocatable :: aa - type(psb_d_csr_sparse_mat) :: acsr type(psb_d_coo_sparse_mat) :: acoo integer :: err_act character(len=20) :: name - integer, allocatable :: ndstk(:,:), iold(:), ndeg(:), perm(:) integer :: i, j, k, ideg, nr, ibw, ipf, idpth info = psb_success_ @@ -204,67 +217,48 @@ contains info = psb_success_ nr = a%get_nrows() - allocate(operm(nr)) - do i=1, nr - operm(i) = i + allocate(perm(nr)) + + call a%mold(aa) + call a%mv_to(aa) + call aa%mv_to_fmt(acsc,info) + + acsc%ia(:) = acsc%ia(:) - 1 + acsc%icp(:) = acsc%icp(:) - 1 + info = psb_amd_interface(nr,acsc%icp,acsc%ia,perm) + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name) + goto 9999 + end if + perm(:) = perm(:) + 1 + acsc%ia(:) = acsc%ia(:) - 1 + acsc%icp(:) = acsc%icp(:) - 1 + + call acsc%mv_to_coo(acoo,info) + do i=1, acoo%get_nzeros() + acoo%ia(i) = perm(acoo%ia(i)) + acoo%ja(i) = perm(acoo%ja(i)) end do -!!$ call a%mold(aa) -!!$ call a%mv_to(aa) -!!$ call aa%mv_to_fmt(acsr,info) -!!$ ! Insert call to gps_reduce -!!$ nr = acsr%get_nrows() -!!$ ideg = 0 -!!$ do i=1, nr -!!$ ideg = max(ideg,acsr%irp(i+1)-acsr%irp(i)) -!!$ end do -!!$ allocate(ndstk(nr,ideg), iold(nr), perm(nr+1), ndeg(nr),stat=info) -!!$ if (info /= 0) then -!!$ info = psb_err_alloc_dealloc_ -!!$ call psb_errpush(info, name) -!!$ goto 9999 -!!$ end if -!!$ do i=1, nr -!!$ iold(i) = i -!!$ ndstk(i,:) = 0 -!!$ k = 0 -!!$ do j=acsr%irp(i),acsr%irp(i+1)-1 -!!$ k = k + 1 -!!$ ndstk(i,k) = acsr%ja(j) -!!$ end do -!!$ end do -!!$ perm = 0 -!!$ -!!$ call psb_gps_reduce(ndstk,nr,ideg,iold,perm,ndeg,ibw,ipf,idpth) -!!$ -!!$ if (.not.psb_isaperm(nr,perm)) then -!!$ write(0,*) 'Something wrong: bad perm from gps_reduce' -!!$ info = psb_err_from_subroutine_ -!!$ call psb_errpush(info,name) -!!$ goto 9999 -!!$ end if -!!$ ! Move to coordinate to apply renumbering -!!$ call acsr%mv_to_coo(acoo,info) -!!$ do i=1, acoo%get_nzeros() -!!$ acoo%ia(i) = perm(acoo%ia(i)) -!!$ acoo%ja(i) = perm(acoo%ja(i)) -!!$ end do -!!$ call acoo%fix(info) -!!$ -!!$ ! Get back to where we started from -!!$ call aa%mv_from_coo(acoo,info) -!!$ call a%mv_from(aa) -!!$ if (present(operm)) then -!!$ call psb_realloc(nr,operm,info) -!!$ if (info /= psb_success_) then -!!$ info = psb_err_alloc_dealloc_ -!!$ call psb_errpush(info,name) -!!$ goto 9999 -!!$ end if -!!$ operm(1:nr) = perm(1:nr) -!!$ end if -!!$ -!!$ deallocate(aa) + call acoo%fix(info) + + ! Get back to where we started from + call aa%mv_from_coo(acoo,info) + call a%mv_from(aa) + if (present(operm)) then + call psb_realloc(nr,operm,info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + operm(1:nr) = perm(1:nr) + end if + + deallocate(aa,perm) + #else + info = psb_err_missing_aux_lib_ call psb_errpush(info, name) goto 9999