diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 63d54732..82062b24 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -120,6 +120,7 @@ module psb_d_mat_mod generic, public :: cp_from => d_cp_from procedure, pass(a) :: d_cp_to => psb_d_cp_to generic, public :: cp_to => d_cp_to + procedure, pass(a) :: extract => psb_d_extract procedure, pass(a) :: d_transp_1mat => psb_d_transp_1mat procedure, pass(a) :: d_transp_2mat => psb_d_transp_2mat generic, public :: transp => d_transp_1mat, d_transp_2mat @@ -955,5 +956,12 @@ contains end function psb_d_get_nz_row - + subroutine psb_d_extract(a,b) + implicit none + class(psb_dspmat_type), intent(inout) :: a + class(psb_d_base_sparse_mat), allocatable, intent(out) :: b + + call move_alloc(a%a,b) + end subroutine psb_d_extract + end module psb_d_mat_mod diff --git a/util/Makefile b/util/Makefile index 5a0f8f8b..df5758c1 100644 --- a/util/Makefile +++ b/util/Makefile @@ -6,8 +6,9 @@ LIBDIR=../lib HERE=. BASEOBJS= psb_blockpart_mod.o psb_metispart_mod.o \ - psb_hbio_mod.o psb_mmio_mod.o psb_mat_dist_mod.o psb_gps_mod.o -IMPLOBJS= psb_hbio_impl.o psb_mmio_impl.o psb_mat_dist_impl.o + psb_hbio_mod.o psb_mmio_mod.o psb_mat_dist_mod.o \ + psb_renum_mod.o psb_gps_mod.o +IMPLOBJS= psb_hbio_impl.o psb_mmio_impl.o psb_mat_dist_impl.o psb_d_renum_impl.o MODOBJS=psb_util_mod.o $(BASEOBJS) OBJS=$(MODOBJS) $(IMPLOBJS) LIBMOD=psb_util_mod$(.mod) diff --git a/util/psb_d_renum_impl.F90 b/util/psb_d_renum_impl.F90 new file mode 100644 index 00000000..86f47ea3 --- /dev/null +++ b/util/psb_d_renum_impl.F90 @@ -0,0 +1,34 @@ +subroutine psb_d_mat_renum(alg,mat,info) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_d_mat_renum + use psb_gps_mod + integer, intent(in) :: alg + type(psb_dspmat_type), intent(inout) :: mat + integer, intent(out) :: info + + integer :: err_act + character(len=20) :: name, ch_err + + info = psb_success_ + name = 'mat_distf' + call psb_erractionsave(err_act) + + info = psb_success_ + + + + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error(ictxt) + return + end if + return + + +end subroutine psb_d_mat_renum diff --git a/util/psb_gps_mod.f90 b/util/psb_gps_mod.f90 index f52743ce..b4c2031a 100644 --- a/util/psb_gps_mod.f90 +++ b/util/psb_gps_mod.f90 @@ -37,7 +37,6 @@ ! Further revised and ported into the PSBLAS environment. ! module psb_gps_mod - use psb_base_mod ! public psb_gps_reduce ! @@ -108,6 +107,7 @@ CONTAINS ! COMMON/LVLW/-SUBROUTINES SETUP AND PIKLVL ASSUME THAT THERE ! ARE AT MOST 100 LEVELS. ! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370. + use psb_base_mod INTEGER NDSTK INTEGER STNODE, RVNODE, RENUM, STNUM, CCSTOR, SBNUM ! COMMON /GRA/ N, IDPTH, IDEG @@ -400,6 +400,7 @@ CONTAINS ! COMMON /GRA/ N, IDPTH, IDEG ! IT IS ASSUMED THAT THERE ARE AT MOST 100 LEVELS. ! COMMON /LVLW/ NHIGH(100), NLOW(100), NACUM(100) + use psb_base_mod DIMENSION LVL(N), LVLS1(N), LVLS2(N) INTEGER :: SZ !----------------------------------------------------- @@ -455,6 +456,7 @@ CONTAINS END FUNCTION SORT2 ! SUBROUTINE PIKLVL(LVLS1, LVLS2, CCSTOR, IDFLT, ISDIR) + use psb_base_mod ! PIKLVL CHOOSES THE LEVEL STRUCTURE USED IN NUMBERING GRAPH ! LVLS1- ON INPUT CONTAINS FORWARD LEVELING INFO ! LVLS2- ON INPUT CONTAINS REVERSE LEVELING INFO @@ -541,6 +543,7 @@ CONTAINS ! SUBROUTINE NUMBER(SND, NUM, NDSTK, LVLS2, NDEG, RENUM, LVLST,LSTPT,& & NR, NFLG, IBW2, IPF2, IPFA, ISDIR) + use psb_base_mod ! NUMBER PRODUCES THE NUMBERING OF THE GRAPH FOR MIN BANDWIDTH ! SND- ON INPUT THE NODE TO BEGIN NUMBERING ON ! NUM- ON INPUT AND OUTPUT, THE NEXT AVAILABLE NUMBER @@ -740,6 +743,7 @@ CONTAINS ! ! --------------------------------------------------------- SUBROUTINE REALLOC(VET,SZ1,SZ2) + use psb_base_mod ! PERFORM ON FLY REALLOCATION OF POINTER VET INCREASING ! ITS SIZE FROM SZ1 TO SZ2 IMPLICIT NONE diff --git a/util/psb_renum_mod.f90 b/util/psb_renum_mod.f90 new file mode 100644 index 00000000..8f33ca27 --- /dev/null +++ b/util/psb_renum_mod.f90 @@ -0,0 +1,14 @@ +module psb_renum_mod + use psb_base_mod + + interface psb_mat_renum + subroutine psb_d_mat_renum(alg,mat,info) + import psb_dspmat_type + integer, intent(in) :: alg + type(psb_dspmat_type), intent(inout) :: mat + integer, intent(out) :: info + end subroutine psb_d_mat_renum + end interface psb_mat_renum + + +end module psb_renum_mod diff --git a/util/psb_util_mod.f90 b/util/psb_util_mod.f90 index 8c9e59fb..141b9f0b 100644 --- a/util/psb_util_mod.f90 +++ b/util/psb_util_mod.f90 @@ -37,6 +37,6 @@ module psb_util_mod use psb_hbio_mod use psb_mmio_mod use psb_mat_dist_mod - use psb_gps_mod + use psb_renum_mod end module psb_util_mod