mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
Take out HAVE_MOLD.
Make support for MOLD mandatory in compiler version. Define set_vect_defaults() and set_mat_defaults(), invoke them at _init() time.
This commit is contained in:
Salvatore Filippone
@@ -292,20 +292,6 @@ contains
|
||||
integer(psb_mpik_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup
|
||||
character(len=20), parameter :: name='psb_init'
|
||||
integer(psb_ipk_) :: iinfo
|
||||
!
|
||||
! Defaults for vectors and matrices
|
||||
!
|
||||
type(psb_s_csr_sparse_mat) :: smatdef
|
||||
type(psb_d_csr_sparse_mat) :: dmatdef
|
||||
type(psb_c_csr_sparse_mat) :: cmatdef
|
||||
type(psb_z_csr_sparse_mat) :: zmatdef
|
||||
|
||||
type(psb_i_base_vect_type) :: ivetdef
|
||||
type(psb_s_base_vect_type) :: svetdef
|
||||
type(psb_d_base_vect_type) :: dvetdef
|
||||
type(psb_c_base_vect_type) :: cvetdef
|
||||
type(psb_z_base_vect_type) :: zvetdef
|
||||
|
||||
!
|
||||
call psb_set_debug_unit(psb_err_unit)
|
||||
|
||||
@@ -396,30 +382,20 @@ contains
|
||||
call psi_get_sizes()
|
||||
if (ictxt == mpi_comm_null) return
|
||||
#endif
|
||||
|
||||
call psb_set_vect_default(ivetdef)
|
||||
call psb_set_vect_default(svetdef)
|
||||
call psb_set_vect_default(dvetdef)
|
||||
call psb_set_vect_default(cvetdef)
|
||||
call psb_set_vect_default(zvetdef)
|
||||
|
||||
call psb_set_mat_default(smatdef)
|
||||
call psb_set_mat_default(dmatdef)
|
||||
call psb_set_mat_default(cmatdef)
|
||||
call psb_set_mat_default(zmatdef)
|
||||
|
||||
! !$ call psb_rsb_init(info)
|
||||
! !$ if (info.ne.psb_rsb_const_success) then
|
||||
! !$ if (info.eq.psb_rsb_const_not_available) then
|
||||
! !$ info=psb_success_ ! rsb is not present
|
||||
! !$ else
|
||||
! !$ ! rsb failed to initialize, and we issue an internal error.
|
||||
! !$ ! or shall we tolerate this ?
|
||||
! !$ info=psb_err_internal_error_
|
||||
! !$ call psb_errpush(info,name)
|
||||
! !$ call psb_error(ictxt)
|
||||
! !$ endif
|
||||
! !$ endif
|
||||
call psb_init_vect_defaults()
|
||||
call psb_init_mat_defaults()
|
||||
! !$ call psb_rsb_init(info)
|
||||
! !$ if (info.ne.psb_rsb_const_success) then
|
||||
! !$ if (info.eq.psb_rsb_const_not_available) then
|
||||
! !$ info=psb_success_ ! rsb is not present
|
||||
! !$ else
|
||||
! !$ ! rsb failed to initialize, and we issue an internal error.
|
||||
! !$ ! or shall we tolerate this ?
|
||||
! !$ info=psb_err_internal_error_
|
||||
! !$ call psb_errpush(info,name)
|
||||
! !$ call psb_error(ictxt)
|
||||
! !$ endif
|
||||
! !$ endif
|
||||
|
||||
end subroutine psb_init_mpik
|
||||
|
||||
|
||||
@@ -191,25 +191,15 @@ contains
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_c_base_vect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_c_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_c_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -229,18 +219,9 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_c_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_c_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(n)
|
||||
|
||||
@@ -321,6 +302,7 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function c_vect_get_fmt
|
||||
|
||||
subroutine c_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
@@ -333,11 +315,7 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -481,23 +459,14 @@ contains
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
class(psb_c_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_c_base_vect_type), allocatable :: tmp
|
||||
class(psb_c_base_vect_type), pointer :: mld
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=psb_c_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_c_get_base_vect_default()
|
||||
call mld%mold(tmp,info)
|
||||
#endif
|
||||
end if
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
@@ -949,18 +918,9 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_c_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -973,22 +933,12 @@ contains
|
||||
class(psb_c_multivect_type), intent(out) :: x
|
||||
class(psb_c_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_c_base_multivect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_c_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(m,n)
|
||||
|
||||
@@ -1085,11 +1035,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_c_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -1248,18 +1194,16 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
else
|
||||
allocate(tmp,stat=info, mold=psb_c_get_base_multivect_default())
|
||||
endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
end subroutine c_vect_cnv
|
||||
|
||||
|
||||
|
||||
@@ -191,25 +191,15 @@ contains
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_d_base_vect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_d_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_d_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -229,18 +219,9 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_d_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_d_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(n)
|
||||
|
||||
@@ -321,6 +302,7 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function d_vect_get_fmt
|
||||
|
||||
subroutine d_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
@@ -333,11 +315,7 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -481,23 +459,14 @@ contains
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
class(psb_d_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_d_base_vect_type), allocatable :: tmp
|
||||
class(psb_d_base_vect_type), pointer :: mld
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=psb_d_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_d_get_base_vect_default()
|
||||
call mld%mold(tmp,info)
|
||||
#endif
|
||||
end if
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
@@ -949,18 +918,9 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_d_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -973,22 +933,12 @@ contains
|
||||
class(psb_d_multivect_type), intent(out) :: x
|
||||
class(psb_d_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_d_base_multivect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_d_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(m,n)
|
||||
|
||||
@@ -1085,11 +1035,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_d_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -1248,18 +1194,16 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
else
|
||||
allocate(tmp,stat=info, mold=psb_d_get_base_multivect_default())
|
||||
endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
end subroutine d_vect_cnv
|
||||
|
||||
|
||||
|
||||
@@ -164,25 +164,15 @@ contains
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_i_base_vect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_i_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -202,18 +192,9 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_i_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(n)
|
||||
|
||||
@@ -294,6 +275,7 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function i_vect_get_fmt
|
||||
|
||||
subroutine i_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
@@ -306,11 +288,7 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_i_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -454,23 +432,14 @@ contains
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_i_base_vect_type), allocatable :: tmp
|
||||
class(psb_i_base_vect_type), pointer :: mld
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=psb_i_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_i_get_base_vect_default()
|
||||
call mld%mold(tmp,info)
|
||||
#endif
|
||||
end if
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
@@ -678,18 +647,9 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_i_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -702,22 +662,12 @@ contains
|
||||
class(psb_i_multivect_type), intent(out) :: x
|
||||
class(psb_i_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_i_base_multivect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_i_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(m,n)
|
||||
|
||||
@@ -814,11 +764,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_i_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -977,18 +923,16 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
else
|
||||
allocate(tmp,stat=info, mold=psb_i_get_base_multivect_default())
|
||||
endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
end subroutine i_vect_cnv
|
||||
|
||||
|
||||
|
||||
@@ -3,4 +3,24 @@ module psb_mat_mod
|
||||
use psb_d_mat_mod
|
||||
use psb_c_mat_mod
|
||||
use psb_z_mat_mod
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_init_mat_defaults()
|
||||
implicit none
|
||||
!
|
||||
! Defaults for matrices
|
||||
!
|
||||
type(psb_s_csr_sparse_mat) :: smatdef
|
||||
type(psb_d_csr_sparse_mat) :: dmatdef
|
||||
type(psb_c_csr_sparse_mat) :: cmatdef
|
||||
type(psb_z_csr_sparse_mat) :: zmatdef
|
||||
|
||||
call psb_set_mat_default(smatdef)
|
||||
call psb_set_mat_default(dmatdef)
|
||||
call psb_set_mat_default(cmatdef)
|
||||
call psb_set_mat_default(zmatdef)
|
||||
|
||||
end subroutine psb_init_mat_defaults
|
||||
|
||||
end module psb_mat_mod
|
||||
|
||||
@@ -191,25 +191,15 @@ contains
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_s_base_vect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_s_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_s_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -229,18 +219,9 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_s_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_s_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(n)
|
||||
|
||||
@@ -321,6 +302,7 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function s_vect_get_fmt
|
||||
|
||||
subroutine s_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
@@ -333,11 +315,7 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -481,23 +459,14 @@ contains
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
class(psb_s_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_s_base_vect_type), allocatable :: tmp
|
||||
class(psb_s_base_vect_type), pointer :: mld
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=psb_s_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_s_get_base_vect_default()
|
||||
call mld%mold(tmp,info)
|
||||
#endif
|
||||
end if
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
@@ -949,18 +918,9 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_s_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -973,22 +933,12 @@ contains
|
||||
class(psb_s_multivect_type), intent(out) :: x
|
||||
class(psb_s_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_s_base_multivect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_s_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(m,n)
|
||||
|
||||
@@ -1085,11 +1035,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_s_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -1248,18 +1194,16 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
else
|
||||
allocate(tmp,stat=info, mold=psb_s_get_base_multivect_default())
|
||||
endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
end subroutine s_vect_cnv
|
||||
|
||||
|
||||
|
||||
@@ -9,4 +9,27 @@ module psb_vect_mod
|
||||
use psb_d_multivect_mod
|
||||
use psb_c_multivect_mod
|
||||
use psb_z_multivect_mod
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_init_vect_defaults()
|
||||
implicit none
|
||||
!
|
||||
! Defaults for vectors
|
||||
!
|
||||
|
||||
type(psb_i_base_vect_type) :: ivetdef
|
||||
type(psb_s_base_vect_type) :: svetdef
|
||||
type(psb_d_base_vect_type) :: dvetdef
|
||||
type(psb_c_base_vect_type) :: cvetdef
|
||||
type(psb_z_base_vect_type) :: zvetdef
|
||||
|
||||
call psb_set_vect_default(ivetdef)
|
||||
call psb_set_vect_default(svetdef)
|
||||
call psb_set_vect_default(dvetdef)
|
||||
call psb_set_vect_default(cvetdef)
|
||||
call psb_set_vect_default(zvetdef)
|
||||
|
||||
end subroutine psb_init_vect_defaults
|
||||
|
||||
end module psb_vect_mod
|
||||
|
||||
@@ -191,25 +191,15 @@ contains
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_z_base_vect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (allocated(x%v)) &
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_z_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_z_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -229,18 +219,9 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_z_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_z_get_base_vect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(n)
|
||||
|
||||
@@ -321,6 +302,7 @@ contains
|
||||
res = 'NULL'
|
||||
if (allocated(x%v)) res = x%v%get_fmt()
|
||||
end function z_vect_get_fmt
|
||||
|
||||
subroutine z_vect_all(n, x, info, mold)
|
||||
|
||||
implicit none
|
||||
@@ -333,11 +315,7 @@ contains
|
||||
& call x%free(info)
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_vect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -481,23 +459,14 @@ contains
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
class(psb_z_base_vect_type), intent(in), optional :: mold
|
||||
class(psb_z_base_vect_type), allocatable :: tmp
|
||||
class(psb_z_base_vect_type), pointer :: mld
|
||||
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=psb_z_get_base_vect_default())
|
||||
#else
|
||||
mld => psb_z_get_base_vect_default()
|
||||
call mld%mold(tmp,info)
|
||||
#endif
|
||||
end if
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
@@ -949,18 +918,9 @@ contains
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_z_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call x%v%bld(invect)
|
||||
@@ -973,22 +933,12 @@ contains
|
||||
class(psb_z_multivect_type), intent(out) :: x
|
||||
class(psb_z_base_multivect_type), intent(in), optional :: mold
|
||||
integer(psb_ipk_) :: info
|
||||
class(psb_z_base_multivect_type), pointer :: mld
|
||||
|
||||
info = psb_success_
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default())
|
||||
#else
|
||||
mld => psb_z_get_base_multivect_default()
|
||||
call mld%mold(x%v,info)
|
||||
#endif
|
||||
endif
|
||||
if (info == psb_success_) call x%v%bld(m,n)
|
||||
|
||||
@@ -1085,11 +1035,7 @@ contains
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(x%v,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(x%v,info)
|
||||
#endif
|
||||
else
|
||||
allocate(psb_z_base_multivect_type :: x%v,stat=info)
|
||||
endif
|
||||
@@ -1248,18 +1194,16 @@ contains
|
||||
integer(psb_ipk_) :: info
|
||||
|
||||
if (present(mold)) then
|
||||
#ifdef HAVE_MOLD
|
||||
allocate(tmp,stat=info,mold=mold)
|
||||
#else
|
||||
call mold%mold(tmp,info)
|
||||
#endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
else
|
||||
allocate(tmp,stat=info, mold=psb_z_get_base_multivect_default())
|
||||
endif
|
||||
if (allocated(x%v)) then
|
||||
call x%v%sync()
|
||||
if (info == psb_success_) call tmp%bld(x%v%v)
|
||||
call x%v%free(info)
|
||||
end if
|
||||
call move_alloc(tmp,x%v)
|
||||
end subroutine z_vect_cnv
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user