mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
psblas3:
base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_c_vect_mod.f90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_d_vect_mod.f90 base/modules/psb_desc_type.f90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_s_vect_mod.f90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_mat_mod.f90 base/modules/psb_z_vect_mod.f90 base/serial/impl/psb_c_mat_impl.F90 base/serial/impl/psb_d_mat_impl.F90 base/serial/impl/psb_s_mat_impl.F90 base/serial/impl/psb_z_mat_impl.F90 base/tools/psb_d_map.f90 test/pargen/ppde.f90 VECT: fixed behaviour of set_vect. MAT: fixed interface of CP_TO.
This commit is contained in:
Salvatore Filippone
@@ -113,10 +113,14 @@ contains
|
||||
subroutine c_base_set_vect(x,val)
|
||||
class(psb_c_base_vect_type), intent(inout) :: x
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
|
||||
integer :: nr
|
||||
integer :: info
|
||||
x%v = val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
nr = min(size(x%v),size(val))
|
||||
x%v(1:nr) = val(1:nr)
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
end subroutine c_base_set_vect
|
||||
|
||||
|
||||
|
||||
@@ -482,7 +482,7 @@ module psb_c_mat_mod
|
||||
interface
|
||||
subroutine psb_c_mv_from(a,b)
|
||||
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
|
||||
class(psb_cspmat_type), intent(out) :: a
|
||||
class(psb_cspmat_type), intent(out) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
end subroutine psb_c_mv_from
|
||||
end interface
|
||||
@@ -490,15 +490,15 @@ module psb_c_mat_mod
|
||||
interface
|
||||
subroutine psb_c_cp_from(a,b)
|
||||
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
|
||||
class(psb_cspmat_type), intent(out) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_cspmat_type), intent(out) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
end subroutine psb_c_cp_from
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_c_mv_to(a,b)
|
||||
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_c_mv_to
|
||||
end interface
|
||||
@@ -506,7 +506,7 @@ module psb_c_mat_mod
|
||||
interface
|
||||
subroutine psb_c_cp_to(a,b)
|
||||
import :: psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_c_cp_to
|
||||
end interface
|
||||
|
||||
@@ -115,8 +115,8 @@ contains
|
||||
end subroutine c_vect_set_scal
|
||||
|
||||
subroutine c_vect_set_vect(x,val)
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
|
||||
integer :: info
|
||||
if (allocated(x%v)) call x%v%set(val)
|
||||
|
||||
@@ -113,10 +113,14 @@ contains
|
||||
subroutine d_base_set_vect(x,val)
|
||||
class(psb_d_base_vect_type), intent(inout) :: x
|
||||
real(psb_dpk_), intent(in) :: val(:)
|
||||
|
||||
integer :: nr
|
||||
integer :: info
|
||||
x%v = val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
nr = min(size(x%v),size(val))
|
||||
x%v(1:nr) = val(1:nr)
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
end subroutine d_base_set_vect
|
||||
|
||||
|
||||
|
||||
@@ -484,7 +484,7 @@ module psb_d_mat_mod
|
||||
interface
|
||||
subroutine psb_d_mv_from(a,b)
|
||||
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
|
||||
class(psb_dspmat_type), intent(out) :: a
|
||||
class(psb_dspmat_type), intent(out) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: b
|
||||
end subroutine psb_d_mv_from
|
||||
end interface
|
||||
@@ -492,15 +492,15 @@ module psb_d_mat_mod
|
||||
interface
|
||||
subroutine psb_d_cp_from(a,b)
|
||||
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
|
||||
class(psb_dspmat_type), intent(out) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_dspmat_type), intent(out) :: a
|
||||
class(psb_d_base_sparse_mat), intent(in) :: b
|
||||
end subroutine psb_d_cp_from
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_d_mv_to(a,b)
|
||||
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
class(psb_d_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_d_mv_to
|
||||
end interface
|
||||
@@ -508,7 +508,7 @@ module psb_d_mat_mod
|
||||
interface
|
||||
subroutine psb_d_cp_to(a,b)
|
||||
import :: psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
class(psb_d_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_d_cp_to
|
||||
end interface
|
||||
|
||||
@@ -115,8 +115,8 @@ contains
|
||||
end subroutine d_vect_set_scal
|
||||
|
||||
subroutine d_vect_set_vect(x,val)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
real(psb_dpk_), intent(in) :: val(:)
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
real(psb_dpk_), intent(in) :: val(:)
|
||||
|
||||
integer :: info
|
||||
if (allocated(x%v)) call x%v%set(val)
|
||||
|
||||
@@ -224,37 +224,13 @@ module psb_descriptor_type
|
||||
procedure, pass(desc) :: get_local_cols => psb_cd_get_local_cols
|
||||
procedure, pass(desc) :: get_global_rows => psb_cd_get_global_rows
|
||||
procedure, pass(desc) :: get_global_cols => psb_cd_get_global_cols
|
||||
procedure, pass(desc) :: sizeof => psb_cd_sizeof
|
||||
end type psb_desc_type
|
||||
|
||||
interface psb_sizeof
|
||||
module procedure psb_cd_sizeof
|
||||
end interface psb_sizeof
|
||||
|
||||
!!$ interface psb_is_ok_desc
|
||||
!!$ module procedure psb_is_ok_desc
|
||||
!!$ end interface psb_is_ok_desc
|
||||
!!$
|
||||
!!$ interface psb_is_valid_desc
|
||||
!!$ module procedure psb_is_valid_desc
|
||||
!!$ end interface psb_is_valid_desc
|
||||
!!$
|
||||
!!$ interface psb_is_asb_desc
|
||||
!!$ module procedure psb_is_asb_desc
|
||||
!!$ end interface psb_is_asb_desc
|
||||
!!$
|
||||
!!$ interface psb_is_upd_desc
|
||||
!!$ module procedure psb_is_upd_desc
|
||||
!!$ end interface psb_is_upd_desc
|
||||
!!$
|
||||
!!$ interface psb_is_ovl_desc
|
||||
!!$ module procedure psb_is_ovl_desc
|
||||
!!$ end interface psb_is_ovl_desc
|
||||
!!$
|
||||
!!$ interface psb_is_bld_desc
|
||||
!!$ module procedure psb_is_bld_desc
|
||||
!!$ end interface psb_is_bld_desc
|
||||
!!$
|
||||
|
||||
interface psb_move_alloc
|
||||
module procedure psb_cdtransfer
|
||||
end interface psb_move_alloc
|
||||
@@ -273,7 +249,7 @@ contains
|
||||
implicit none
|
||||
!....Parameters...
|
||||
|
||||
Type(psb_desc_type), intent(in) :: desc
|
||||
class(psb_desc_type), intent(in) :: desc
|
||||
integer(psb_long_int_k_) :: val
|
||||
|
||||
val = 0
|
||||
|
||||
@@ -113,10 +113,14 @@ contains
|
||||
subroutine s_base_set_vect(x,val)
|
||||
class(psb_s_base_vect_type), intent(inout) :: x
|
||||
real(psb_spk_), intent(in) :: val(:)
|
||||
|
||||
integer :: nr
|
||||
integer :: info
|
||||
x%v = val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
nr = min(size(x%v),size(val))
|
||||
x%v(1:nr) = val(1:nr)
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
end subroutine s_base_set_vect
|
||||
|
||||
|
||||
|
||||
@@ -485,7 +485,7 @@ module psb_s_mat_mod
|
||||
interface
|
||||
subroutine psb_s_mv_from(a,b)
|
||||
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
|
||||
class(psb_sspmat_type), intent(out) :: a
|
||||
class(psb_sspmat_type), intent(out) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: b
|
||||
end subroutine psb_s_mv_from
|
||||
end interface
|
||||
@@ -493,15 +493,15 @@ module psb_s_mat_mod
|
||||
interface
|
||||
subroutine psb_s_cp_from(a,b)
|
||||
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
|
||||
class(psb_sspmat_type), intent(out) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_sspmat_type), intent(out) :: a
|
||||
class(psb_s_base_sparse_mat), intent(in) :: b
|
||||
end subroutine psb_s_cp_from
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_s_mv_to(a,b)
|
||||
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
class(psb_s_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_s_mv_to
|
||||
end interface
|
||||
@@ -509,7 +509,7 @@ module psb_s_mat_mod
|
||||
interface
|
||||
subroutine psb_s_cp_to(a,b)
|
||||
import :: psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
class(psb_s_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_s_cp_to
|
||||
end interface
|
||||
|
||||
@@ -115,8 +115,8 @@ contains
|
||||
end subroutine s_vect_set_scal
|
||||
|
||||
subroutine s_vect_set_vect(x,val)
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
real(psb_spk_), intent(in) :: val(:)
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
real(psb_spk_), intent(in) :: val(:)
|
||||
|
||||
integer :: info
|
||||
if (allocated(x%v)) call x%v%set(val)
|
||||
|
||||
@@ -113,11 +113,16 @@ contains
|
||||
subroutine z_base_set_vect(x,val)
|
||||
class(psb_z_base_vect_type), intent(inout) :: x
|
||||
complex(psb_dpk_), intent(in) :: val(:)
|
||||
|
||||
integer :: nr
|
||||
integer :: info
|
||||
x%v = val
|
||||
|
||||
if (allocated(x%v)) then
|
||||
nr = min(size(x%v),size(val))
|
||||
x%v(1:nr) = val(1:nr)
|
||||
else
|
||||
x%v = val
|
||||
end if
|
||||
end subroutine z_base_set_vect
|
||||
|
||||
|
||||
|
||||
function constructor(x) result(this)
|
||||
|
||||
@@ -482,7 +482,7 @@ module psb_z_mat_mod
|
||||
interface
|
||||
subroutine psb_z_mv_from(a,b)
|
||||
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
|
||||
class(psb_zspmat_type), intent(out) :: a
|
||||
class(psb_zspmat_type), intent(out) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: b
|
||||
end subroutine psb_z_mv_from
|
||||
end interface
|
||||
@@ -490,15 +490,15 @@ module psb_z_mat_mod
|
||||
interface
|
||||
subroutine psb_z_cp_from(a,b)
|
||||
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
|
||||
class(psb_zspmat_type), intent(out) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_zspmat_type), intent(out) :: a
|
||||
class(psb_z_base_sparse_mat), intent(in) :: b
|
||||
end subroutine psb_z_cp_from
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_z_mv_to(a,b)
|
||||
import :: psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
class(psb_z_base_sparse_mat), intent(out) :: b
|
||||
end subroutine psb_z_mv_to
|
||||
end interface
|
||||
|
||||
@@ -115,8 +115,8 @@ contains
|
||||
end subroutine z_vect_set_scal
|
||||
|
||||
subroutine z_vect_set_vect(x,val)
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
complex(psb_dpk_), intent(in) :: val(:)
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
complex(psb_dpk_), intent(in) :: val(:)
|
||||
|
||||
integer :: info
|
||||
if (allocated(x%v)) call x%v%set(val)
|
||||
|
||||
@@ -1413,8 +1413,8 @@ subroutine psb_c_cp_from(a,b)
|
||||
use psb_string_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_c_cp_from
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(out) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_cspmat_type), intent(out) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
Integer :: err_act, info
|
||||
character(len=20) :: name='clone'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
@@ -1414,8 +1414,8 @@ subroutine psb_d_cp_from(a,b)
|
||||
use psb_string_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_d_cp_from
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(out) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_dspmat_type), intent(out) :: a
|
||||
class(psb_d_base_sparse_mat), intent(in) :: b
|
||||
Integer :: err_act, info
|
||||
character(len=20) :: name='clone'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
@@ -1412,8 +1412,8 @@ subroutine psb_s_cp_from(a,b)
|
||||
use psb_string_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_s_cp_from
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(out) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_sspmat_type), intent(out) :: a
|
||||
class(psb_s_base_sparse_mat), intent(in) :: b
|
||||
Integer :: err_act, info
|
||||
character(len=20) :: name='clone'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
@@ -1413,8 +1413,8 @@ subroutine psb_z_cp_from(a,b)
|
||||
use psb_string_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_z_cp_from
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(out) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
|
||||
class(psb_zspmat_type), intent(out) :: a
|
||||
class(psb_z_base_sparse_mat), intent(in) :: b
|
||||
Integer :: err_act, info
|
||||
character(len=20) :: name='clone'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
@@ -121,7 +121,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work)
|
||||
real(psb_dpk_), optional :: work(:)
|
||||
! Local
|
||||
type(psb_d_vect_type) :: xt, yt
|
||||
real(psb_dpk_), allocatable :: xta(:), yta(:)
|
||||
real(psb_dpk_), allocatable :: xta(:), yta(:)
|
||||
integer :: i, j, nr1, nc1,nr2, nc2 ,&
|
||||
& map_kind, map_data, nr, ictxt
|
||||
character(len=20), parameter :: name='psb_map_X2Y'
|
||||
|
||||
@@ -399,8 +399,8 @@ contains
|
||||
real(psb_dpk_), allocatable :: val(:)
|
||||
! deltah dimension of each grid cell
|
||||
! deltat discretization time
|
||||
real(psb_dpk_) :: deltah, deltah2
|
||||
real(psb_dpk_),parameter :: rhs=0.d0,one=1.d0,zero=0.d0
|
||||
real(psb_dpk_) :: deltah, deltah2
|
||||
real(psb_dpk_), parameter :: rhs=0.d0,one=1.d0,zero=0.d0
|
||||
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen
|
||||
real(psb_dpk_) :: a1, a2, a3, a4, b1, b2, b3
|
||||
external :: a1, a2, a3, a4, b1, b2, b3
|
||||
@@ -562,7 +562,10 @@ contains
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x+1,y,z)
|
||||
if (ix<idim) then
|
||||
if (ix==idim) then
|
||||
val(element)=-b3(x,y,z)/deltah2
|
||||
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b3(x,y,z)/deltah2
|
||||
icol(element) = (ix)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
|
||||
Reference in New Issue
Block a user