From 1c3a1f938cc9b2713dc2499de5027a395caea360 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 31 Mar 2011 14:14:57 +0000 Subject: [PATCH] psblas3: base/modules/psb_sort_mod.f90 base/modules/psi_penv_mod.F90 configure.ac configure test/fileread/runs/dfs.inp misc fixes to configure, interfaces for sorting, how to call mpi_init. --- base/modules/psb_sort_mod.f90 | 73 +++++++++++++++++++++++++++++++++++ base/modules/psi_penv_mod.F90 | 2 +- configure | 4 +- configure.ac | 2 +- test/fileread/runs/dfs.inp | 2 +- 5 files changed, 78 insertions(+), 5 deletions(-) diff --git a/base/modules/psb_sort_mod.f90 b/base/modules/psb_sort_mod.f90 index d85ccda1..cfa347f2 100644 --- a/base/modules/psb_sort_mod.f90 +++ b/base/modules/psb_sort_mod.f90 @@ -647,4 +647,77 @@ module psb_sort_mod end interface + interface psb_free_heap + module procedure psb_free_int_heap, psb_free_int_idx_heap,& + & psb_free_real_idx_heap, psb_free_scomplex_idx_heap, & + & psb_free_double_idx_heap, psb_free_dcomplex_idx_heap + end interface + +contains + + subroutine psb_free_int_heap(heap,info) + implicit none + type(psb_int_heap), intent(inout) :: heap + integer, intent(out) :: info + + info=psb_success_ + if (allocated(heap%keys)) deallocate(heap%keys,stat=info) + + end subroutine psb_free_int_heap + + subroutine psb_free_real_idx_heap(heap,info) + implicit none + type(psb_real_idx_heap), intent(inout) :: heap + integer, intent(out) :: info + + info=psb_success_ + if (allocated(heap%keys)) deallocate(heap%keys,stat=info) + if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) + + end subroutine psb_free_real_idx_heap + + subroutine psb_free_double_idx_heap(heap,info) + implicit none + type(psb_double_idx_heap), intent(inout) :: heap + integer, intent(out) :: info + + info=psb_success_ + if (allocated(heap%keys)) deallocate(heap%keys,stat=info) + if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) + + end subroutine psb_free_double_idx_heap + + subroutine psb_free_int_idx_heap(heap,info) + implicit none + type(psb_int_idx_heap), intent(inout) :: heap + integer, intent(out) :: info + + info=psb_success_ + if (allocated(heap%keys)) deallocate(heap%keys,stat=info) + if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) + + end subroutine psb_free_int_idx_heap + + subroutine psb_free_scomplex_idx_heap(heap,info) + implicit none + type(psb_scomplex_idx_heap), intent(inout) :: heap + integer, intent(out) :: info + + info=psb_success_ + if (allocated(heap%keys)) deallocate(heap%keys,stat=info) + if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) + + end subroutine psb_free_scomplex_idx_heap + + subroutine psb_free_dcomplex_idx_heap(heap,info) + implicit none + type(psb_dcomplex_idx_heap), intent(inout) :: heap + integer, intent(out) :: info + + info=psb_success_ + if (allocated(heap%keys)) deallocate(heap%keys,stat=info) + if ((info == psb_success_).and.(allocated(heap%idxs))) deallocate(heap%idxs,stat=info) + + end subroutine psb_free_dcomplex_idx_heap + end module psb_sort_mod diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index b01ad4b9..04b1df55 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -146,7 +146,7 @@ contains #else call mpi_initialized(initialized,info) if ((.not.initialized).or.(info /= mpi_success)) then - call mpi_init(info) + if (info == mpi_success) call mpi_init(info) if (info /= mpi_success) then write(psb_err_unit,*) 'Error in initalizing MPI, bailing out',info stop diff --git a/configure b/configure index 4308de39..e89f68b5 100755 --- a/configure +++ b/configure @@ -557,7 +557,7 @@ PACKAGE_STRING='PSBLAS 3.0' PACKAGE_BUGREPORT='salvatore.filippone@uniroma2.it' PACKAGE_URL='' -ac_unique_file="base/modules/psb_sparse_mod.f90" +ac_unique_file="base/modules/psb_base_mod.f90" # Factoring default headers for most tests. ac_includes_default="\ #include @@ -6213,7 +6213,7 @@ else fi if test "X$psblas_cv_fc" == X"nag" ; then # Add needed options - F90COPT="$F90COPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" + F90COPT="$F90COPT -dcfuns -f2003 -mismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" EXTRA_OPT="-mismatch_all" fi diff --git a/configure.ac b/configure.ac index 431ea914..5eaaf353 100755 --- a/configure.ac +++ b/configure.ac @@ -425,7 +425,7 @@ else fi if test "X$psblas_cv_fc" == X"nag" ; then # Add needed options - F90COPT="$F90COPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" + F90COPT="$F90COPT -dcfuns -f2003 -mismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv" EXTRA_OPT="-mismatch_all" fi diff --git a/test/fileread/runs/dfs.inp b/test/fileread/runs/dfs.inp index f05f8e42..424d977b 100644 --- a/test/fileread/runs/dfs.inp +++ b/test/fileread/runs/dfs.inp @@ -1,5 +1,5 @@ 11 Number of inputs -thm1000x600.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or +thm200x120.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or NONE sherman3_rhs1.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