fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-09 15:41:45 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/modules/psb_base_mat_mod.f03
 base/modules/psb_d_base_mat_mod.f03
 base/modules/psb_linmap_mod.f90
 base/modules/psb_linmap_type_mod.f90
 base/modules/psb_serial_mod.f90
 base/modules/psb_spmat_type.f03
 base/serial/f03/psbn_d_coo_impl.f03
 base/serial/f03/psbn_d_csr_impl.f03
 prec/psb_dbjac_bld.f90
 prec/psb_dilu_fct.f90
 prec/psb_dprecbld.f90
 prec/psb_prec_mod.f90
 prec/psb_prec_type.f90
 test/fileread/df_sample.f90
 util/psb_metispart_mod.F90

1. Taken out psb_dspmat_type from definition modules.
2. Commented out compilation of all old serial stuff; 
3. Fixed (for the time being, but needs more exploration) CP_FROM and
   MV_FROM. 
4. BEWARE: new serial stuff is still incomplete.
This commit is contained in:
Salvatore Filippone
2009-09-22 16:15:42 +00:00
parent adb51fddc5
commit 720fbd161a
15 changed files with 1269 additions and 1196 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_base_mat_mod.f03
+82 -51
View File
@@ -3,9 +3,14 @@ module psb_base_mat_mod
use psb_const_mod
type :: psb_base_sparse_mat
integer, private :: m, n
integer, private :: state, duplicate
logical, private :: triangle, unitd, upper, sorted
integer :: m, n
integer :: state, duplicate
logical :: triangle, unitd, upper, sorted
! This is a different animal: it's a kitchen sink for
! any additional parameters that may be needed
! when converting to/from COO. Why here?
! Will tell you one day...
integer, allocatable :: aux(:)
contains
! ====================================
@@ -22,6 +27,7 @@ module psb_base_mat_mod
procedure, pass(a) :: get_state
procedure, pass(a) :: get_dupl
procedure, pass(a) :: get_fmt
procedure, pass(a) :: get_aux
procedure, pass(a) :: is_null
procedure, pass(a) :: is_bld
procedure, pass(a) :: is_upd
@@ -50,7 +56,7 @@ module psb_base_mat_mod
procedure, pass(a) :: set_lower
procedure, pass(a) :: set_triangle
procedure, pass(a) :: set_unit
procedure, pass(a) :: set_aux
! ====================================
@@ -58,6 +64,7 @@ module psb_base_mat_mod
! Data management
!
! ====================================
procedure, pass(a) :: get_neigh
procedure, pass(a) :: allocate_mnnz
procedure, pass(a) :: reallocate_nz
@@ -69,7 +76,9 @@ module psb_base_mat_mod
procedure, pass(a) :: csgetptn
generic, public :: csget => csgetptn
procedure, pass(a) :: print => sparse_print
procedure, pass(a) :: sizeof
procedure, pass(a) :: sizeof
!!$ procedure, pass(a) :: base_cp_from
!!$ procedure, pass(a) :: base_mv_from
end type psb_base_sparse_mat
@@ -80,7 +89,14 @@ module psb_base_mat_mod
& is_upd, is_asb, is_sorted, is_upper, is_lower, is_triangle, &
& is_unit, get_neigh, allocate_mn, allocate_mnnz, reallocate_nz, &
& free, sparse_print, get_fmt, trim, sizeof, reinit, csgetptn, &
& get_nz_row
& get_nz_row, get_aux, set_aux
!!$, base_mv_from, base_cp_from
interface cp_from
module procedure base_cp_from
end interface
interface mv_from
module procedure base_mv_from
end interface
contains
@@ -130,6 +146,22 @@ contains
end function get_ncols
subroutine set_aux(v,a)
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: v(:)
! TBD
write(0,*) 'SET_AUX is empty right now '
end subroutine set_aux
subroutine get_aux(v,a)
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(out), allocatable :: v(:)
! TBD
write(0,*) 'GET_AUX is empty right now '
end subroutine get_aux
subroutine set_nrows(m,a)
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
@@ -410,51 +442,50 @@ contains
end subroutine reinit
!!$
!!$ !
!!$ ! Since at this level we have only simple components,
!!$ ! mv_from is identical to cp_from.
!!$ !
!!$ subroutine mv_from(a,b)
!!$ use psb_error_mod
!!$ implicit none
!!$
!!$ class(psb_base_sparse_mat), intent(out) :: a
!!$ type(psb_base_sparse_mat), intent(inout) :: b
!!$
!!$ a%m = b%m
!!$ a%n = b%n
!!$ a%state = b%state
!!$ a%duplicate = b%duplicate
!!$ a%triangle = b%triangle
!!$ a%unitd = b%unitd
!!$ a%upper = b%upper
!!$ a%sorted = b%sorted
!!$
!!$ return
!!$
!!$ end subroutine mv_from
!!$
!!$ subroutine cp_from(a,b)
!!$ use psb_error_mod
!!$ implicit none
!!$
!!$ class(psb_base_sparse_mat), intent(out) :: a
!!$ type(psb_base_sparse_mat), intent(in) :: b
!!$
!!$ a%m = b%m
!!$ a%n = b%n
!!$ a%state = b%state
!!$ a%duplicate = b%duplicate
!!$ a%triangle = b%triangle
!!$ a%unitd = b%unitd
!!$ a%upper = b%upper
!!$ a%sorted = b%sorted
!!$
!!$ return
!!$
!!$ end subroutine cp_from
!!$
!
!
subroutine base_mv_from(a,b)
use psb_error_mod
implicit none
type(psb_base_sparse_mat), intent(out) :: a
type(psb_base_sparse_mat), intent(inout) :: b
a%m = b%m
a%n = b%n
a%state = b%state
a%duplicate = b%duplicate
a%triangle = b%triangle
a%unitd = b%unitd
a%upper = b%upper
a%sorted = b%sorted
call move_alloc(b%aux,a%aux)
return
end subroutine base_mv_from
subroutine base_cp_from(a,b)
use psb_error_mod
implicit none
type(psb_base_sparse_mat), intent(out) :: a
type(psb_base_sparse_mat), intent(in) :: b
a%m = b%m
a%n = b%n
a%state = b%state
a%duplicate = b%duplicate
a%triangle = b%triangle
a%unitd = b%unitd
a%upper = b%upper
a%sorted = b%sorted
a%aux = b%aux
return
end subroutine base_cp_from
subroutine sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
use psb_error_mod
implicit none
base/modules/psb_d_base_mat_mod.f03
+45
View File
@@ -32,6 +32,8 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_from_coo
procedure, pass(a) :: mv_to_fmt
procedure, pass(a) :: mv_from_fmt
!!$ procedure, pass(a) :: base_cp_from => d_base_cp_from
!!$ procedure, pass(a) :: base_mv_from => d_base_mv_from
end type psb_d_base_sparse_mat
private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,&
@@ -39,6 +41,16 @@ module psb_d_base_mat_mod
& cp_to_coo, cp_from_coo, cp_to_fmt, cp_from_fmt, &
& mv_to_coo, mv_from_coo, mv_to_fmt, mv_from_fmt, &
& get_diag, csclip, d_cssv, d_cssm
!!$, &
!!$ & d_base_mv_from, d_base_cp_from
interface cp_from
module procedure d_base_cp_from
end interface
interface mv_from
module procedure d_base_mv_from
end interface
type, extends(psb_d_base_sparse_mat) :: psb_d_coo_sparse_mat
@@ -314,6 +326,39 @@ contains
!
!====================================
!
! For the time being we do not have anything beyond
! the base components, but you never know.
!
subroutine d_base_mv_from(a,b)
use psb_error_mod
implicit none
type(psb_d_base_sparse_mat), intent(out) :: a
type(psb_d_base_sparse_mat), intent(inout) :: b
!!$ call a%psb_base_sparse_mat%base_mv_from(b%psb_base_sparse_mat)
call mv_from(a%psb_base_sparse_mat,b%psb_base_sparse_mat)
return
end subroutine d_base_mv_from
subroutine d_base_cp_from(a,b)
use psb_error_mod
implicit none
type(psb_d_base_sparse_mat), intent(out) :: a
type(psb_d_base_sparse_mat), intent(in) :: b
call cp_from(a%psb_base_sparse_mat,b%psb_base_sparse_mat)
return
end subroutine d_base_cp_from
subroutine cp_to_coo(a,b,info)
use psb_error_mod
use psb_realloc_mod
base/modules/psb_linmap_mod.f90
+1 -1
View File
@@ -37,7 +37,7 @@
!
module psb_linmap_mod
use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type, &
use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
use psb_descriptor_type
use psb_linmap_type_mod
base/modules/psb_linmap_type_mod.f90
+1 -1
View File
@@ -36,7 +36,7 @@
! to different spaces.
!
module psb_linmap_type_mod
use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type, &
use psb_spmat_type, only : psb_sspmat_type, &
& psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof
use psb_d_mat_mod, only: psb_d_sparse_mat
base/modules/psb_serial_mod.f90
+299 -299
View File
File diff suppressed because it is too large Load Diff
base/modules/psb_spmat_type.f03
+789 -798
View File
File diff suppressed because it is too large Load Diff
base/serial/f03/psbn_d_coo_impl.f03
+4 -4
View File
@@ -1849,7 +1849,7 @@ subroutine d_cp_coo_to_coo_impl(a,b,info)
call psb_erractionsave(err_act)
info = 0
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call cp_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat)
call b%set_nzeros(a%get_nzeros())
call b%reallocate(a%get_nzeros())
@@ -1894,7 +1894,7 @@ subroutine d_cp_coo_from_coo_impl(a,b,info)
call psb_erractionsave(err_act)
info = 0
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call cp_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat)
call a%set_nzeros(b%get_nzeros())
call a%reallocate(b%get_nzeros())
@@ -2311,7 +2311,7 @@ subroutine d_mv_coo_to_coo_impl(a,b,info)
call psb_erractionsave(err_act)
info = 0
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call mv_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat)
call b%set_nzeros(a%get_nzeros())
call b%reallocate(a%get_nzeros())
@@ -2356,7 +2356,7 @@ subroutine d_mv_coo_from_coo_impl(a,b,info)
call psb_erractionsave(err_act)
info = 0
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call mv_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat)
call a%set_nzeros(b%get_nzeros())
call a%reallocate(b%get_nzeros())
base/serial/f03/psbn_d_csr_impl.f03
+7 -7
View File
@@ -1708,7 +1708,7 @@ subroutine d_cp_csr_to_coo_impl(a,b,info)
nza = a%get_nzeros()
call b%allocate(nr,nc,nza)
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call cp_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat)
do i=1, nr
do j=a%irp(i),a%irp(i+1)-1
@@ -1749,8 +1749,7 @@ subroutine d_mv_csr_to_coo_impl(a,b,info)
nc = a%get_ncols()
nza = a%get_nzeros()
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call mv_from( b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat)
call b%set_nzeros(a%get_nzeros())
call move_alloc(a%ja,b%ja)
call move_alloc(a%val,b%val)
@@ -1797,7 +1796,8 @@ subroutine d_mv_csr_from_coo_impl(a,b,info)
nc = b%get_ncols()
nza = b%get_nzeros()
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call mv_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat)
! Dirty trick: call move_alloc to have the new data allocated just once.
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
@@ -1884,7 +1884,7 @@ subroutine d_mv_csr_to_fmt_impl(a,b,info)
call a%mv_to_coo(b,info)
! Need to fix trivial copies!
type is (psb_d_csr_sparse_mat)
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call mv_from(b%psb_d_base_sparse_mat,a%psb_d_base_sparse_mat)
call move_alloc(a%irp, b%irp)
call move_alloc(a%ja, b%ja)
call move_alloc(a%val, b%val)
@@ -1961,7 +1961,7 @@ subroutine d_mv_csr_from_fmt_impl(a,b,info)
call a%mv_from_coo(b,info)
type is (psb_d_csr_sparse_mat)
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call mv_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat)
call move_alloc(b%irp, a%irp)
call move_alloc(b%ja, a%ja)
call move_alloc(b%val, a%val)
@@ -2002,7 +2002,7 @@ subroutine d_cp_csr_from_fmt_impl(a,b,info)
call a%cp_from_coo(b,info)
type is (psb_d_csr_sparse_mat)
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call cp_from(a%psb_d_base_sparse_mat,b%psb_d_base_sparse_mat)
a%irp = b%irp
a%ja = b%ja
a%val = b%val
prec/psb_dbjac_bld.f90
+2 -2
View File
@@ -46,7 +46,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
integer :: i, m
integer :: int_err(5)
character :: trans, unitd
type(psb_dspmat_type) :: atmp
!!$ type(psb_dspmat_type) :: atmp
type(psb_d_csr_sparse_mat), allocatable :: lf, uf
real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8
integer nztota, err_act, n_row, nrow_a,n_col, nhalo
@@ -72,7 +72,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
endif
trans = 'N'
unitd = 'U'
call psb_nullify_sp(atmp)
!!$ call psb_nullify_sp(atmp)
call psb_cdcpy(desc_a,p%desc_data,info)
if(info /= 0) then
prec/psb_dilu_fct.f90
+7 -15
View File
@@ -43,11 +43,11 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
! .. Array Arguments ..
type(psb_d_sparse_mat),intent(in) :: a
type(psb_d_csr_sparse_mat),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck
type(psb_d_sparse_mat),intent(in), optional, target :: blck
real(psb_dpk_), intent(inout) :: d(:)
! .. Local Scalars ..
integer :: l1,l2,m,err_act
type(psb_dspmat_type), pointer :: blck_
type(psb_d_sparse_mat), pointer :: blck_
character(len=20) :: name, ch_err
name='psb_dcsrlu'
info = 0
@@ -64,19 +64,11 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
goto 9999
end if
call psb_nullify_sp(blck_) ! Why do we need this? Who knows....
call psb_sp_all(0,0,blck_,1,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call blck_%csall(0,0,info,1)
blck_%m=0
endif
call psb_dilu_fctint(m,a%get_nrows(),a,blck_%m,blck_,&
call psb_dilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,&
& d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info)
if(info /= 0) then
info=4010
@@ -99,7 +91,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
if (present(blck)) then
blck_ => null()
else
call psb_sp_free(blck_,info)
call blck_%free()
if(info /= 0) then
info=4010
ch_err='psb_sp_free'
@@ -127,8 +119,8 @@ contains
implicit none
type(psb_d_sparse_mat) :: a
type(psb_dspmat_type) :: b
type(psb_d_sparse_mat) :: a
type(psb_d_sparse_mat) :: b
integer :: m,ma,mb,l1,l2,info
integer, dimension(:) :: lia1,lia2,uia1,uia2
real(psb_dpk_), dimension(:) :: laspk,uaspk,d
prec/psb_dprecbld.f90
-1
View File
@@ -46,7 +46,6 @@ subroutine psb_dprecbld(aa,desc_a,p,info,upd)
& me,np,mglob, err_act
integer :: int_err(5)
character :: upd_
type(psb_dspmat_type), target :: a
integer,parameter :: iroot=psb_root_,iout=60,ilout=40
character(len=20) :: name, ch_err
prec/psb_prec_mod.f90
+8 -8
View File
@@ -86,7 +86,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_sprecinit
subroutine psb_dprecinit(prec,ptype,info)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
implicit none
type(psb_dprec_type), intent(inout) :: prec
@@ -130,7 +130,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_sprecsets
subroutine psb_dprecseti(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
implicit none
type(psb_dprec_type), intent(inout) :: prec
@@ -138,7 +138,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_dprecseti
subroutine psb_dprecsetd(prec,what,val,info)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
implicit none
type(psb_dprec_type), intent(inout) :: prec
@@ -205,7 +205,7 @@ module psb_prec_mod
character(len=1), optional :: trans
end subroutine psb_sprc_aply1
subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
@@ -216,7 +216,7 @@ module psb_prec_mod
real(psb_dpk_),intent(inout), optional, target :: work(:)
end subroutine psb_dprc_aply
subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
@@ -281,7 +281,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_sbjac_aply
subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
@@ -404,7 +404,7 @@ module psb_prec_mod
character, intent(in) :: upd
end subroutine psb_sdiagsc_bld
subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
use psb_d_mat_mod
integer, intent(out) :: info
@@ -447,7 +447,7 @@ module psb_prec_mod
integer, intent(out) :: info
end subroutine psb_sgprec_aply
subroutine psb_dgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_dpk_
use psb_base_mod, only : psb_desc_type, psb_dpk_
use psb_prec_type, only : psb_dprec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
prec/psb_prec_type.f90
+1 -1
View File
@@ -38,7 +38,7 @@ module psb_prec_type
! Reduces size of .mod file.
use psb_base_mod, only : psb_sspmat_type, psb_cspmat_type,&
& psb_dspmat_type, psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,&
& psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,&
& psb_desc_type, psb_sizeof, psb_sp_free, psb_cdfree,&
& psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus
use psb_d_mat_mod, only : psb_d_sparse_mat
test/fileread/df_sample.f90
+2 -7
View File
@@ -182,13 +182,8 @@ program df_sample
write(*,'("Partition type: graph")')
write(*,'(" ")')
! write(0,'("Build type: graph")')
select type (aa=>aux_a%a)
type is (psb_d_csr_sparse_mat)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,np)
class default
write(0,*) 'Should never get here!'
call psb_abort(ictxt)
end select
call build_mtpart(aux_a,np)
endif
call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
util/psb_metispart_mod.F90
+21 -1
View File
@@ -58,7 +58,11 @@ module psb_metispart_mod
& getv_mtpart, free_part
private
integer, allocatable, save :: graph_vect(:)
interface build_mtpart
module procedure build_mtpart, d_mat_build_mtpart
end interface
contains
subroutine part_graph(global_indx,n,np,pv,nv)
@@ -130,6 +134,22 @@ contains
end if
end subroutine getv_mtpart
subroutine d_mat_build_mtpart(a,nparts)
use psb_base_mod
type(psb_d_sparse_mat), intent(in) :: a
integer :: nparts
select type (aa=>a%a)
type is (psb_d_csr_sparse_mat)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts)
class default
write(0,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine d_mat_build_mtpart
subroutine build_mtpart(n,fida,ia1,ia2,nparts)
use psb_base_mod