From cd47d999bac5ca9df2030eaf42219f54c611140b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 2 Nov 2011 15:05:37 +0000 Subject: [PATCH] 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. --- base/modules/psb_c_base_vect_mod.f90 | 10 +++++++--- base/modules/psb_c_mat_mod.f90 | 10 +++++----- base/modules/psb_c_vect_mod.f90 | 4 ++-- base/modules/psb_d_base_vect_mod.f90 | 10 +++++++--- base/modules/psb_d_mat_mod.f90 | 10 +++++----- base/modules/psb_d_vect_mod.f90 | 4 ++-- base/modules/psb_desc_type.f90 | 28 ++-------------------------- base/modules/psb_s_base_vect_mod.f90 | 10 +++++++--- base/modules/psb_s_mat_mod.f90 | 10 +++++----- base/modules/psb_s_vect_mod.f90 | 4 ++-- base/modules/psb_z_base_vect_mod.f90 | 11 ++++++++--- base/modules/psb_z_mat_mod.f90 | 8 ++++---- base/modules/psb_z_vect_mod.f90 | 4 ++-- base/serial/impl/psb_c_mat_impl.F90 | 4 ++-- base/serial/impl/psb_d_mat_impl.F90 | 4 ++-- base/serial/impl/psb_s_mat_impl.F90 | 4 ++-- base/serial/impl/psb_z_mat_impl.F90 | 4 ++-- base/tools/psb_d_map.f90 | 2 +- test/pargen/ppde.f90 | 9 ++++++--- 19 files changed, 73 insertions(+), 77 deletions(-) diff --git a/base/modules/psb_c_base_vect_mod.f90 b/base/modules/psb_c_base_vect_mod.f90 index b0c1f755..c07cc10e 100644 --- a/base/modules/psb_c_base_vect_mod.f90 +++ b/base/modules/psb_c_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index 403e1dcc..2f726969 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -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 diff --git a/base/modules/psb_c_vect_mod.f90 b/base/modules/psb_c_vect_mod.f90 index c285a262..fb6612b3 100644 --- a/base/modules/psb_c_vect_mod.f90 +++ b/base/modules/psb_c_vect_mod.f90 @@ -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) diff --git a/base/modules/psb_d_base_vect_mod.f90 b/base/modules/psb_d_base_vect_mod.f90 index 1a4b12bd..116b61c8 100644 --- a/base/modules/psb_d_base_vect_mod.f90 +++ b/base/modules/psb_d_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 452a0dec..5c1d4249 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -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 diff --git a/base/modules/psb_d_vect_mod.f90 b/base/modules/psb_d_vect_mod.f90 index dcff46de..a532d927 100644 --- a/base/modules/psb_d_vect_mod.f90 +++ b/base/modules/psb_d_vect_mod.f90 @@ -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) diff --git a/base/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 index 94171ba4..3b8bfeae 100644 --- a/base/modules/psb_desc_type.f90 +++ b/base/modules/psb_desc_type.f90 @@ -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 diff --git a/base/modules/psb_s_base_vect_mod.f90 b/base/modules/psb_s_base_vect_mod.f90 index 3aaf149e..b477a018 100644 --- a/base/modules/psb_s_base_vect_mod.f90 +++ b/base/modules/psb_s_base_vect_mod.f90 @@ -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 diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 9ae40e5e..465cafb9 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -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 diff --git a/base/modules/psb_s_vect_mod.f90 b/base/modules/psb_s_vect_mod.f90 index 56f20536..d10e8e77 100644 --- a/base/modules/psb_s_vect_mod.f90 +++ b/base/modules/psb_s_vect_mod.f90 @@ -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) diff --git a/base/modules/psb_z_base_vect_mod.f90 b/base/modules/psb_z_base_vect_mod.f90 index f53595db..381e942e 100644 --- a/base/modules/psb_z_base_vect_mod.f90 +++ b/base/modules/psb_z_base_vect_mod.f90 @@ -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) diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index 1c2ce263..fe6f8909 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -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 diff --git a/base/modules/psb_z_vect_mod.f90 b/base/modules/psb_z_vect_mod.f90 index 979559f4..81609542 100644 --- a/base/modules/psb_z_vect_mod.f90 +++ b/base/modules/psb_z_vect_mod.f90 @@ -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) diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index db9603ac..5a241a47 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -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. diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 4665a52d..02ab411b 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -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. diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index ce52a829..76045c54 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -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. diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 78268c06..4dcfb7ad 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -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. diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 028d92e3..48de8116 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -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' diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index b067b99d..ca62644b 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -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