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

psblas3-matasb:

Browse Source 
base/modules/Makefile
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_tools_mod.f90
 base/modules/psb_d_vect_mod.F90
 base/tools/psb_dins.f90
 base/tools/psb_dspins.f90

Insert routines for vectors now take both vectors and arrays.
This commit is contained in:
Salvatore Filippone
2014-08-06 10:50:19 +00:00
parent 46fe7af14c
commit 047d928ed5
6 changed files with 203 additions and 16 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/Makefile
+1 -1
View File
@@ -109,7 +109,7 @@ psb_s_serial_mod.o psb_d_serial_mod.o psb_c_serial_mod.o psb_z_serial_mod.o: psb
psb_serial_mod.o: psb_s_serial_mod.o psb_d_serial_mod.o psb_c_serial_mod.o psb_z_serial_mod.o
psb_i_vect_mod.o: psb_i_base_vect_mod.o
psb_s_vect_mod.o: psb_s_base_vect_mod.o
psb_d_vect_mod.o: psb_d_base_vect_mod.o
psb_d_vect_mod.o: psb_d_base_vect_mod.o psb_i_vect_mod.o
psb_c_vect_mod.o: psb_c_base_vect_mod.o
psb_z_vect_mod.o: psb_z_base_vect_mod.o
psb_tools_mod.o: psb_cd_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\
base/modules/psb_d_base_vect_mod.f90
+33 -5
View File
@@ -76,7 +76,9 @@ module psb_d_base_vect_mod
! Assembly does almost nothing here, but is important
! in derived classes.
!
procedure, pass(x) :: ins => d_base_ins
procedure, pass(x) :: ins_a => d_base_ins_a
procedure, pass(x) :: ins_v => d_base_ins_v
generic, public :: ins => ins_a, ins_v
procedure, pass(x) :: zero => d_base_zero
procedure, pass(x) :: asb => d_base_asb
procedure, pass(x) :: free => d_base_free
@@ -296,7 +298,7 @@ contains
!! \param info return code
!!
!
subroutine d_base_ins(n,irl,val,dupl,x,info)
subroutine d_base_ins_a(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
@@ -343,8 +345,8 @@ contains
case default
info = 321
! !$ call psb_errpush(info,name)
! !$ goto 9999
! !$ call psb_errpush(info,name)
! !$ goto 9999
end select
end if
if (info /= 0) then
@@ -352,7 +354,33 @@ contains
return
end if
end subroutine d_base_ins
end subroutine d_base_ins_a
subroutine d_base_ins_v(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
class(psb_i_base_vect_type), intent(inout) :: irl
class(psb_d_base_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, isz
info = 0
if (psb_errstatus_fatal()) return
call irl%sync()
call val%sync()
call x%ins(n,irl%v,val%v,dupl,info)
if (info /= 0) then
call psb_errpush(info,'base_vect_ins')
return
end if
end subroutine d_base_ins_v
!
!> Function base_zero
base/modules/psb_d_tools_mod.f90
+14 -1
View File
@@ -31,7 +31,7 @@
!!$
Module psb_d_tools_mod
use psb_desc_mod, only : psb_desc_type, psb_dpk_, psb_ipk_
use psb_d_vect_mod, only : psb_d_base_vect_type, psb_d_vect_type
use psb_d_vect_mod, only : psb_d_base_vect_type, psb_d_vect_type, psb_i_vect_type
use psb_d_mat_mod, only : psb_dspmat_type, psb_d_base_sparse_mat
interface psb_geall
@@ -206,6 +206,19 @@ Module psb_d_tools_mod
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect
subroutine psb_dins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, psb_i_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: m
type(psb_desc_type), intent(in) :: desc_a
type(psb_d_vect_type), intent(inout) :: x
type(psb_i_vect_type), intent(inout) :: irw
type(psb_d_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect_v
subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, &
base/modules/psb_d_vect_mod.F90
+29 -5
View File
@@ -40,6 +40,7 @@
module psb_d_vect_mod
use psb_d_base_vect_mod
use psb_i_vect_mod
type psb_d_vect_type
class(psb_d_base_vect_type), allocatable :: v
@@ -76,7 +77,9 @@ module psb_d_vect_mod
procedure, pass(y) :: sctb => d_vect_sctb
generic, public :: sct => sctb
procedure, pass(x) :: free => d_vect_free
procedure, pass(x) :: ins => d_vect_ins
procedure, pass(x) :: ins_a => d_vect_ins_a
procedure, pass(x) :: ins_v => d_vect_ins_v
generic, public :: ins => ins_v, ins_a
procedure, pass(x) :: bld_x => d_vect_bld_x
procedure, pass(x) :: bld_n => d_vect_bld_n
generic, public :: bld => bld_x, bld_n
@@ -619,7 +622,7 @@ contains
end subroutine d_vect_free
subroutine d_vect_ins(n,irl,val,dupl,x,info)
subroutine d_vect_ins_a(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
class(psb_d_vect_type), intent(inout) :: x
@@ -635,10 +638,31 @@ contains
info = psb_err_invalid_vect_state_
return
end if
call x%v%ins(n,irl,val,dupl,info)
end subroutine d_vect_ins
end subroutine d_vect_ins_a
subroutine d_vect_ins_v(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
class(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
class(psb_i_vect_type), intent(inout) :: irl
class(psb_d_vect_type), intent(inout) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
info = 0
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
info = psb_err_invalid_vect_state_
return
end if
call x%v%ins(n,irl%v,val%v,dupl,info)
end subroutine d_vect_ins_v
subroutine d_vect_cnv(x,mold)
base/tools/psb_dins.f90
+117
View File
@@ -304,6 +304,123 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
end subroutine psb_dins_vect
subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
use psb_base_mod, psb_protect_name => psb_dins_vect_v
use psi_mod
implicit none
! m rows number of submatrix belonging to val to be inserted
! ix x global-row corresponding to position at which val submatrix
! must be inserted
!....parameters...
integer(psb_ipk_), intent(in) :: m
type(psb_i_vect_type), intent(inout) :: irw
type(psb_d_vect_type), intent(inout) :: val
type(psb_d_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals.....
integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:)
real(psb_dpk_), allocatable :: lval(:)
logical :: local_
character(len=20) :: name
if (psb_errstatus_fatal()) return
info=psb_success_
call psb_erractionsave(err_act)
name = 'psb_dinsvi'
if (.not.desc_a%is_ok()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
end if
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
!... check parameters....
if (m < 0) then
info = psb_err_iarg_neg_
int_err(1) = 1
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310
int_err(1) = 5
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999
endif
if (m == 0) return
loc_rows = desc_a%get_local_rows()
loc_cols = desc_a%get_local_cols()
mglob = desc_a%get_global_rows()
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
dupl_ = dupl
else
dupl_ = psb_dupl_ovwrt_
endif
if (present(local)) then
local_ = local
else
local_ = .false.
endif
if (local_) then
call x%ins(m,irw,val,dupl_,info)
else
irl = irw%get_vect()
lval = val%get_vect()
call desc_a%indxmap%g2lip(irl(1:m),info,owned=.true.)
call x%ins(m,irl,lval,dupl_,info)
end if
if (info /= 0) then
call psb_errpush(info,name)
goto 9999
end if
deallocate(irl)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_dins_vect_v
subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
use psb_base_mod, psb_protect_name => psb_dins_vect_r2
use psi_mod
base/tools/psb_dspins.f90
+9 -4
View File
@@ -80,11 +80,13 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
call psb_info(ictxt, me, np)
if (nz < 0) then
write(0,*)name, ' NZ ',nz
info = 1111
call psb_errpush(info,name)
goto 9999
end if
if (size(ia) < nz) then
write(0,*) name,' IA ',size(ia),nz
info = 1111
call psb_errpush(info,name)
goto 9999
@@ -92,16 +94,19 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
if (size(ja) < nz) then
info = 1111
write(0,*) name,' jA ',size(ja),nz
call psb_errpush(info,name)
goto 9999
end if
if (size(val) < nz) then
info = 1111
write(0,*) name,' VAL ',size(val),nz
call psb_errpush(info,name)
goto 9999
end if
if (nz == 0) return
if (nz == 0) return
if (present(rebuild)) then
rebuild_ = rebuild
else
@@ -130,7 +135,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
end if
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
if (info == 0) call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
if (info /= psb_success_) then
ierr(1) = info
@@ -180,9 +185,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
end if
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
if (info == 0) call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
t2 = psb_Wtime()
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
if (info == 0) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
t3=psb_wtime()
tcnv=t2-t1
tcsput=t3-t2