mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 07:04:57 +00:00
psblas3:
Makefile base/modules/psb_d_mat_mod.f90 util/Makefile util/psb_d_renum_impl.F90 util/psb_gps_mod.f90 util/psb_renum_mod.f90 util/psb_util_mod.f90 Defined renum interface.
This commit is contained in:
@@ -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
|
||||
|
||||
+3
-2
@@ -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)
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user