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.
pull/6/head
Salvatore Filippone 7 years ago
parent 3d347d31dc
commit e37b43d45a

@ -292,20 +292,6 @@ contains
integer(psb_mpik_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup integer(psb_mpik_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup
character(len=20), parameter :: name='psb_init' character(len=20), parameter :: name='psb_init'
integer(psb_ipk_) :: iinfo 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) call psb_set_debug_unit(psb_err_unit)
@ -396,30 +382,20 @@ contains
call psi_get_sizes() call psi_get_sizes()
if (ictxt == mpi_comm_null) return if (ictxt == mpi_comm_null) return
#endif #endif
call psb_init_vect_defaults()
call psb_set_vect_default(ivetdef) call psb_init_mat_defaults()
call psb_set_vect_default(svetdef) ! !$ call psb_rsb_init(info)
call psb_set_vect_default(dvetdef) ! !$ if (info.ne.psb_rsb_const_success) then
call psb_set_vect_default(cvetdef) ! !$ if (info.eq.psb_rsb_const_not_available) then
call psb_set_vect_default(zvetdef) ! !$ info=psb_success_ ! rsb is not present
! !$ else
call psb_set_mat_default(smatdef) ! !$ ! rsb failed to initialize, and we issue an internal error.
call psb_set_mat_default(dmatdef) ! !$ ! or shall we tolerate this ?
call psb_set_mat_default(cmatdef) ! !$ info=psb_err_internal_error_
call psb_set_mat_default(zmatdef) ! !$ call psb_errpush(info,name)
! !$ call psb_error(ictxt)
! !$ call psb_rsb_init(info) ! !$ endif
! !$ if (info.ne.psb_rsb_const_success) then ! !$ endif
! !$ 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 end subroutine psb_init_mpik

@ -191,25 +191,15 @@ contains
class(psb_c_vect_type), intent(inout) :: x class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_vect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_c_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -229,18 +219,9 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_c_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -321,6 +302,7 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function c_vect_get_fmt end function c_vect_get_fmt
subroutine c_vect_all(n, x, info, mold) subroutine c_vect_all(n, x, info, mold)
implicit none implicit none
@ -333,11 +315,7 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_c_base_vect_type :: x%v,stat=info) allocate(psb_c_base_vect_type :: x%v,stat=info)
endif endif
@ -481,23 +459,14 @@ contains
class(psb_c_vect_type), intent(inout) :: x class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), intent(in), optional :: mold
class(psb_c_base_vect_type), allocatable :: tmp class(psb_c_base_vect_type), allocatable :: tmp
class(psb_c_base_vect_type), pointer :: mld
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=psb_c_get_base_vect_default()) 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 end if
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
@ -949,18 +918,9 @@ contains
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) 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_multivect_type), intent(out) :: x
class(psb_c_base_multivect_type), intent(in), optional :: mold class(psb_c_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_multivect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(m,n) if (info == psb_success_) call x%v%bld(m,n)
@ -1085,11 +1035,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_c_base_multivect_type :: x%v,stat=info) allocate(psb_c_base_multivect_type :: x%v,stat=info)
endif endif
@ -1248,18 +1194,16 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info, mold=psb_c_get_base_multivect_default())
#endif endif
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v) if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info) call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
call move_alloc(tmp,x%v)
end subroutine c_vect_cnv end subroutine c_vect_cnv

@ -191,25 +191,15 @@ contains
class(psb_d_vect_type), intent(inout) :: x class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in), optional :: mold class(psb_d_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_vect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_d_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -229,18 +219,9 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_d_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -321,6 +302,7 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function d_vect_get_fmt end function d_vect_get_fmt
subroutine d_vect_all(n, x, info, mold) subroutine d_vect_all(n, x, info, mold)
implicit none implicit none
@ -333,11 +315,7 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_d_base_vect_type :: x%v,stat=info) allocate(psb_d_base_vect_type :: x%v,stat=info)
endif endif
@ -481,23 +459,14 @@ contains
class(psb_d_vect_type), intent(inout) :: x class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in), optional :: mold class(psb_d_base_vect_type), intent(in), optional :: mold
class(psb_d_base_vect_type), allocatable :: tmp class(psb_d_base_vect_type), allocatable :: tmp
class(psb_d_base_vect_type), pointer :: mld
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=psb_d_get_base_vect_default()) 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 end if
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
@ -949,18 +918,9 @@ contains
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) 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_multivect_type), intent(out) :: x
class(psb_d_base_multivect_type), intent(in), optional :: mold class(psb_d_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_multivect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(m,n) if (info == psb_success_) call x%v%bld(m,n)
@ -1085,11 +1035,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_d_base_multivect_type :: x%v,stat=info) allocate(psb_d_base_multivect_type :: x%v,stat=info)
endif endif
@ -1248,18 +1194,16 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info, mold=psb_d_get_base_multivect_default())
#endif endif
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v) if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info) call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
call move_alloc(tmp,x%v)
end subroutine d_vect_cnv end subroutine d_vect_cnv

@ -164,25 +164,15 @@ contains
class(psb_i_vect_type), intent(inout) :: x class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -202,18 +192,9 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -294,6 +275,7 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function i_vect_get_fmt end function i_vect_get_fmt
subroutine i_vect_all(n, x, info, mold) subroutine i_vect_all(n, x, info, mold)
implicit none implicit none
@ -306,11 +288,7 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_i_base_vect_type :: x%v,stat=info) allocate(psb_i_base_vect_type :: x%v,stat=info)
endif endif
@ -454,23 +432,14 @@ contains
class(psb_i_vect_type), intent(inout) :: x class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold class(psb_i_base_vect_type), intent(in), optional :: mold
class(psb_i_base_vect_type), allocatable :: tmp class(psb_i_base_vect_type), allocatable :: tmp
class(psb_i_base_vect_type), pointer :: mld
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=psb_i_get_base_vect_default()) 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 end if
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
@ -678,18 +647,9 @@ contains
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) 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_multivect_type), intent(out) :: x
class(psb_i_base_multivect_type), intent(in), optional :: mold class(psb_i_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_multivect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(m,n) if (info == psb_success_) call x%v%bld(m,n)
@ -814,11 +764,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_i_base_multivect_type :: x%v,stat=info) allocate(psb_i_base_multivect_type :: x%v,stat=info)
endif endif
@ -977,18 +923,16 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info, mold=psb_i_get_base_multivect_default())
#endif endif
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v) if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info) call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
call move_alloc(tmp,x%v)
end subroutine i_vect_cnv end subroutine i_vect_cnv

@ -3,4 +3,24 @@ module psb_mat_mod
use psb_d_mat_mod use psb_d_mat_mod
use psb_c_mat_mod use psb_c_mat_mod
use psb_z_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 end module psb_mat_mod

@ -191,25 +191,15 @@ contains
class(psb_s_vect_type), intent(inout) :: x class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_vect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_s_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -229,18 +219,9 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_s_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -321,6 +302,7 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function s_vect_get_fmt end function s_vect_get_fmt
subroutine s_vect_all(n, x, info, mold) subroutine s_vect_all(n, x, info, mold)
implicit none implicit none
@ -333,11 +315,7 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_s_base_vect_type :: x%v,stat=info) allocate(psb_s_base_vect_type :: x%v,stat=info)
endif endif
@ -481,23 +459,14 @@ contains
class(psb_s_vect_type), intent(inout) :: x class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), intent(in), optional :: mold
class(psb_s_base_vect_type), allocatable :: tmp class(psb_s_base_vect_type), allocatable :: tmp
class(psb_s_base_vect_type), pointer :: mld
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=psb_s_get_base_vect_default()) 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 end if
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
@ -949,18 +918,9 @@ contains
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) 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_multivect_type), intent(out) :: x
class(psb_s_base_multivect_type), intent(in), optional :: mold class(psb_s_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_multivect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(m,n) if (info == psb_success_) call x%v%bld(m,n)
@ -1085,11 +1035,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_s_base_multivect_type :: x%v,stat=info) allocate(psb_s_base_multivect_type :: x%v,stat=info)
endif endif
@ -1248,18 +1194,16 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info, mold=psb_s_get_base_multivect_default())
#endif endif
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v) if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info) call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
call move_alloc(tmp,x%v)
end subroutine s_vect_cnv end subroutine s_vect_cnv

@ -9,4 +9,27 @@ module psb_vect_mod
use psb_d_multivect_mod use psb_d_multivect_mod
use psb_c_multivect_mod use psb_c_multivect_mod
use psb_z_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 end module psb_vect_mod

@ -191,25 +191,15 @@ contains
class(psb_z_vect_type), intent(inout) :: x class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_vect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_z_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) if (info == psb_success_) call x%v%bld(invect)
@ -229,18 +219,9 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_z_get_base_vect_default()) 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 endif
if (info == psb_success_) call x%v%bld(n) if (info == psb_success_) call x%v%bld(n)
@ -321,6 +302,7 @@ contains
res = 'NULL' res = 'NULL'
if (allocated(x%v)) res = x%v%get_fmt() if (allocated(x%v)) res = x%v%get_fmt()
end function z_vect_get_fmt end function z_vect_get_fmt
subroutine z_vect_all(n, x, info, mold) subroutine z_vect_all(n, x, info, mold)
implicit none implicit none
@ -333,11 +315,7 @@ contains
& call x%free(info) & call x%free(info)
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_z_base_vect_type :: x%v,stat=info) allocate(psb_z_base_vect_type :: x%v,stat=info)
endif endif
@ -481,23 +459,14 @@ contains
class(psb_z_vect_type), intent(inout) :: x class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), intent(in), optional :: mold
class(psb_z_base_vect_type), allocatable :: tmp class(psb_z_base_vect_type), allocatable :: tmp
class(psb_z_base_vect_type), pointer :: mld
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=psb_z_get_base_vect_default()) 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 end if
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
@ -949,18 +918,9 @@ contains
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(invect) 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_multivect_type), intent(out) :: x
class(psb_z_base_multivect_type), intent(in), optional :: mold class(psb_z_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_multivect_type), pointer :: mld
info = psb_success_ info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default()) 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 endif
if (info == psb_success_) call x%v%bld(m,n) if (info == psb_success_) call x%v%bld(m,n)
@ -1085,11 +1035,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else else
allocate(psb_z_base_multivect_type :: x%v,stat=info) allocate(psb_z_base_multivect_type :: x%v,stat=info)
endif endif
@ -1248,18 +1194,16 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else else
call mold%mold(tmp,info) allocate(tmp,stat=info, mold=psb_z_get_base_multivect_default())
#endif endif
if (allocated(x%v)) then if (allocated(x%v)) then
call x%v%sync() call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v) if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info) call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if end if
call move_alloc(tmp,x%v)
end subroutine z_vect_cnv end subroutine z_vect_cnv

@ -942,6 +942,7 @@ subroutine psb_c_base_clone(a,b,info)
class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b class(psb_c_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then if (allocated(b)) then
call b%free() call b%free()
deallocate(b, stat=info) deallocate(b, stat=info)
@ -953,12 +954,8 @@ subroutine psb_c_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that ! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly. ! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info) allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info) if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_c_base_clone end subroutine psb_c_base_clone
@ -1954,11 +1951,7 @@ subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(cone,d%v(1:nac),x,czero,info) if (info == psb_success_) call tmpv%mlt(cone,d%v(1:nac),x,czero,info)
if (info == psb_success_)& if (info == psb_success_)&
@ -1983,11 +1976,7 @@ subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info) if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)& if (info == psb_success_)&
& call a%inner_spsm(alpha,x,czero,tmpv,info,trans) & call a%inner_spsm(alpha,x,czero,tmpv,info,trans)

@ -1133,7 +1133,6 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_c_base_sparse_mat), allocatable :: altmp class(psb_c_base_sparse_mat), allocatable :: altmp
class(psb_c_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv' character(len=20) :: name='cscnv'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1155,11 +1154,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1176,12 +1171,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1238,7 +1228,6 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
class(psb_c_base_sparse_mat), allocatable :: altmp class(psb_c_base_sparse_mat), allocatable :: altmp
class(psb_c_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip' character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1266,11 +1255,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1287,12 +1272,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1507,11 +1487,7 @@ subroutine psb_c_mv_from(a,b)
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
call a%free() call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info) allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info) call a%a%mv_from_fmt(b,info)
call b%free() call b%free()
@ -1539,11 +1515,7 @@ subroutine psb_c_cp_from(a,b)
! however this would run the risk of messing up with data ! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data). ! allocated externally (e.g. GPU-side data).
! !
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info) if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1592,11 +1564,8 @@ subroutine psb_c_mold(a,b)
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
class(psb_c_base_sparse_mat), allocatable, intent(out) :: b class(psb_c_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info) allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_c_mold end subroutine psb_c_mold
@ -1706,11 +1675,7 @@ subroutine psb_c_transp_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
@ -1781,11 +1746,7 @@ subroutine psb_c_transc_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999

@ -942,6 +942,7 @@ subroutine psb_d_base_clone(a,b,info)
class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b class(psb_d_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then if (allocated(b)) then
call b%free() call b%free()
deallocate(b, stat=info) deallocate(b, stat=info)
@ -953,12 +954,8 @@ subroutine psb_d_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that ! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly. ! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info) allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info) if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_d_base_clone end subroutine psb_d_base_clone
@ -1954,11 +1951,7 @@ subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(done,d%v(1:nac),x,dzero,info) if (info == psb_success_) call tmpv%mlt(done,d%v(1:nac),x,dzero,info)
if (info == psb_success_)& if (info == psb_success_)&
@ -1983,11 +1976,7 @@ subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info) if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)& if (info == psb_success_)&
& call a%inner_spsm(alpha,x,dzero,tmpv,info,trans) & call a%inner_spsm(alpha,x,dzero,tmpv,info,trans)

@ -1133,7 +1133,6 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_d_base_sparse_mat), allocatable :: altmp class(psb_d_base_sparse_mat), allocatable :: altmp
class(psb_d_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv' character(len=20) :: name='cscnv'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1155,11 +1154,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1176,12 +1171,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1238,7 +1228,6 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
class(psb_d_base_sparse_mat), allocatable :: altmp class(psb_d_base_sparse_mat), allocatable :: altmp
class(psb_d_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip' character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1266,11 +1255,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1287,12 +1272,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1507,11 +1487,7 @@ subroutine psb_d_mv_from(a,b)
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
call a%free() call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info) allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info) call a%a%mv_from_fmt(b,info)
call b%free() call b%free()
@ -1539,11 +1515,7 @@ subroutine psb_d_cp_from(a,b)
! however this would run the risk of messing up with data ! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data). ! allocated externally (e.g. GPU-side data).
! !
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info) if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1592,11 +1564,8 @@ subroutine psb_d_mold(a,b)
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info) allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_d_mold end subroutine psb_d_mold
@ -1706,11 +1675,7 @@ subroutine psb_d_transp_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
@ -1781,11 +1746,7 @@ subroutine psb_d_transc_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999

@ -942,6 +942,7 @@ subroutine psb_s_base_clone(a,b,info)
class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b class(psb_s_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then if (allocated(b)) then
call b%free() call b%free()
deallocate(b, stat=info) deallocate(b, stat=info)
@ -953,12 +954,8 @@ subroutine psb_s_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that ! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly. ! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info) allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info) if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_s_base_clone end subroutine psb_s_base_clone
@ -1954,11 +1951,7 @@ subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(sone,d%v(1:nac),x,szero,info) if (info == psb_success_) call tmpv%mlt(sone,d%v(1:nac),x,szero,info)
if (info == psb_success_)& if (info == psb_success_)&
@ -1983,11 +1976,7 @@ subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info) if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)& if (info == psb_success_)&
& call a%inner_spsm(alpha,x,szero,tmpv,info,trans) & call a%inner_spsm(alpha,x,szero,tmpv,info,trans)

@ -1133,7 +1133,6 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_s_base_sparse_mat), allocatable :: altmp class(psb_s_base_sparse_mat), allocatable :: altmp
class(psb_s_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv' character(len=20) :: name='cscnv'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1155,11 +1154,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1176,12 +1171,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1238,7 +1228,6 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
class(psb_s_base_sparse_mat), allocatable :: altmp class(psb_s_base_sparse_mat), allocatable :: altmp
class(psb_s_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip' character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1266,11 +1255,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1287,12 +1272,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1507,11 +1487,7 @@ subroutine psb_s_mv_from(a,b)
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
call a%free() call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info) allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info) call a%a%mv_from_fmt(b,info)
call b%free() call b%free()
@ -1539,11 +1515,7 @@ subroutine psb_s_cp_from(a,b)
! however this would run the risk of messing up with data ! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data). ! allocated externally (e.g. GPU-side data).
! !
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info) if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1592,11 +1564,8 @@ subroutine psb_s_mold(a,b)
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), allocatable, intent(out) :: b class(psb_s_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info) allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_s_mold end subroutine psb_s_mold
@ -1706,11 +1675,7 @@ subroutine psb_s_transp_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
@ -1781,11 +1746,7 @@ subroutine psb_s_transc_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999

@ -942,6 +942,7 @@ subroutine psb_z_base_clone(a,b,info)
class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b class(psb_z_base_sparse_mat), allocatable, intent(inout) :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(b)) then if (allocated(b)) then
call b%free() call b%free()
deallocate(b, stat=info) deallocate(b, stat=info)
@ -953,12 +954,8 @@ subroutine psb_z_base_clone(a,b,info)
! Do not use SOURCE allocation: this makes sure that ! Do not use SOURCE allocation: this makes sure that
! memory allocated elsewhere is treated properly. ! memory allocated elsewhere is treated properly.
#if defined(HAVE_MOLD)
allocate(b,mold=a,stat=info) allocate(b,mold=a,stat=info)
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
#else
call a%mold(b,info)
#endif
if (info == psb_success_) call b%cp_from_fmt(a, info) if (info == psb_success_) call b%cp_from_fmt(a, info)
end subroutine psb_z_base_clone end subroutine psb_z_base_clone
@ -1954,11 +1951,7 @@ subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
goto 9999 goto 9999
end if end if
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call tmpv%mlt(zone,d%v(1:nac),x,zzero,info) if (info == psb_success_) call tmpv%mlt(zone,d%v(1:nac),x,zzero,info)
if (info == psb_success_)& if (info == psb_success_)&
@ -1983,11 +1976,7 @@ subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
if (info == psb_success_) call y%mlt(d%v(1:nar),info) if (info == psb_success_) call y%mlt(d%v(1:nar),info)
else else
#ifdef HAVE_MOLD
allocate(tmpv, mold=y,stat=info) allocate(tmpv, mold=y,stat=info)
#else
call y%mold(tmpv,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_)& if (info == psb_success_)&
& call a%inner_spsm(alpha,x,zzero,tmpv,info,trans) & call a%inner_spsm(alpha,x,zzero,tmpv,info,trans)

@ -1133,7 +1133,6 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
class(psb_z_base_sparse_mat), allocatable :: altmp class(psb_z_base_sparse_mat), allocatable :: altmp
class(psb_z_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv' character(len=20) :: name='cscnv'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1155,11 +1154,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1176,12 +1171,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1238,7 +1228,6 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
class(psb_z_base_sparse_mat), allocatable :: altmp class(psb_z_base_sparse_mat), allocatable :: altmp
class(psb_z_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
character(len=20) :: name='cscnv_ip' character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -1266,11 +1255,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else
call mold%mold(altmp,info)
#endif
else if (present(type)) then else if (present(type)) then
@ -1287,12 +1272,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else
mld => psb_get_mat_default(a)
call mld%mold(altmp,info)
#endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
@ -1507,11 +1487,7 @@ subroutine psb_z_mv_from(a,b)
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
call a%free() call a%free()
#if defined(HAVE_MOLD)
allocate(a%a,mold=b, stat=info) allocate(a%a,mold=b, stat=info)
#else
call b%mold(a%a,info)
#endif
call a%a%mv_from_fmt(b,info) call a%a%mv_from_fmt(b,info)
call b%free() call b%free()
@ -1539,11 +1515,7 @@ subroutine psb_z_cp_from(a,b)
! however this would run the risk of messing up with data ! however this would run the risk of messing up with data
! allocated externally (e.g. GPU-side data). ! allocated externally (e.g. GPU-side data).
! !
#if defined(HAVE_MOLD)
allocate(a%a,mold=b,stat=info) allocate(a%a,mold=b,stat=info)
#else
call b%mold(a%a,info)
#endif
if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info /= psb_success_) info = psb_err_alloc_dealloc_
if (info == psb_success_) call a%a%cp_from_fmt(b, info) if (info == psb_success_) call a%a%cp_from_fmt(b, info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -1592,11 +1564,8 @@ subroutine psb_z_mold(a,b)
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
class(psb_z_base_sparse_mat), allocatable, intent(out) :: b class(psb_z_base_sparse_mat), allocatable, intent(out) :: b
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
#if defined(HAVE_MOLD)
allocate(b,mold=a%a, stat=info) allocate(b,mold=a%a, stat=info)
#else
call a%a%mold(b,info)
#endif
end subroutine psb_z_mold end subroutine psb_z_mold
@ -1706,11 +1675,7 @@ subroutine psb_z_transp_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999
@ -1781,11 +1746,7 @@ subroutine psb_z_transc_2mat(a,b)
goto 9999 goto 9999
endif endif
call b%free() call b%free()
#if defined(HAVE_MOLD)
allocate(b%a,mold=a%a,stat=info) allocate(b%a,mold=a%a,stat=info)
#else
call a%a%mold(b%a,info)
#endif
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
goto 9999 goto 9999

231
configure vendored

@ -7174,35 +7174,44 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran SAME_TYPE_AS" >&5
# Optional features $as_echo_n "checking support for Fortran SAME_TYPE_AS... " >&6; }
#
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran VOLATILE" >&5
$as_echo_n "checking support for Fortran VOLATILE... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_exeext='' ac_exeext=''
ac_ext='F90' ac_ext='f90'
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
program conftest program stt
integer, volatile :: i, j type foo
end program conftest integer :: i
end type foo
type, extends(foo) :: new_foo
integer :: j
end type new_foo
type(foo) :: foov
type(new_foo) :: nfv1, nfv2
write(*,*) 'foov == nfv1? ', same_type_as(foov,nfv1)
write(*,*) 'nfv2 == nfv1? ', same_type_as(nfv2,nfv1)
end program stt
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_VOLATILE $FDEFINES" :
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
echo "configure: failed program was:" >&5 echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5 cat conftest.$ac_ext >&5
as_fn_error $? "Sorry, cannot build PSBLAS without support for SAME_TYPE_AS.
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8." "$LINENO" 5
fi fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
@ -7214,31 +7223,30 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking test GENERIC interfaces" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran EXTENDS_TYPE_OF" >&5
$as_echo_n "checking test GENERIC interfaces... " >&6; } $as_echo_n "checking support for Fortran EXTENDS_TYPE_OF... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_exeext='' ac_exeext=''
ac_ext='F90' ac_ext='f90'
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
module conftest program xtt
type foo
interface foo integer :: i
subroutine i_sub_foo(v) end type foo
integer, intent(inout) :: v(:) type, extends(foo) :: new_foo
end subroutine i_sub_foo integer :: j
end interface foo end type new_foo
type(foo) :: foov
interface bar type(new_foo) :: nfv1, nfv2
procedure i_sub_foo
end interface bar
end module conftest write(*,*) 'nfv1 extends foov? ', extends_type_of(nfv1,foov)
end program xtt
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
@ -7249,7 +7257,8 @@ else
$as_echo "no" >&6; } $as_echo "no" >&6; }
echo "configure: failed program was:" >&5 echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5 cat conftest.$ac_ext >&5
FDEFINES="$psblas_cv_define_prepend-DHAVE_BUGGY_GENERICS $FDEFINES" as_fn_error $? "Sorry, cannot build PSBLAS without support for EXTENDS_TYPE_OF.
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8." "$LINENO" 5
fi fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
@ -7261,8 +7270,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran FLUSH statement" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran MOLD= allocation" >&5
$as_echo_n "checking support for Fortran FLUSH statement... " >&6; } $as_echo_n "checking support for Fortran MOLD= allocation... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
@ -7273,23 +7282,32 @@ ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
program conftest program xtt
integer :: iunit=10 type foo
open(10) integer :: i
write(10,*) 'Test ' end type foo
flush(10) type, extends(foo) :: new_foo
close(10) integer :: j
end program conftest end type new_foo
class(foo), allocatable :: fooab
type(new_foo) :: nfv
integer :: info
allocate(fooab, mold=nfv, stat=info)
end program xtt
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_FLUSH_STMT $FDEFINES" :
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
echo "configure: failed program was:" >&5 echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5 cat conftest.$ac_ext >&5
as_fn_error $? "Sorry, cannot build PSBLAS without support for MOLD= allocation.
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8." "$LINENO" 5
fi fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
@ -7301,26 +7319,30 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for ISO_FORTRAN_ENV" >&5 #
$as_echo_n "checking support for ISO_FORTRAN_ENV... " >&6; } # Optional features
#
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran VOLATILE" >&5
$as_echo_n "checking support for Fortran VOLATILE... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_exeext='' ac_exeext=''
ac_ext='f90' ac_ext='F90'
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
program test program conftest
use iso_fortran_env integer, volatile :: i, j
end program test end program conftest
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_ISO_FORTRAN_ENV $FDEFINES" FDEFINES="$psblas_cv_define_prepend-DHAVE_VOLATILE $FDEFINES"
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
@ -7337,46 +7359,42 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran FINAL" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking test GENERIC interfaces" >&5
$as_echo_n "checking support for Fortran FINAL... " >&6; } $as_echo_n "checking test GENERIC interfaces... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_exeext='' ac_exeext=''
ac_ext='f90' ac_ext='F90'
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
module conftest_mod module conftest
type foo
integer :: i
contains
final :: destroy_foo
end type foo
private destroy_foo interface foo
contains subroutine i_sub_foo(v)
subroutine destroy_foo(a) integer, intent(inout) :: v(:)
type(foo) :: a end subroutine i_sub_foo
! Just a test end interface foo
end subroutine destroy_foo
end module conftest_mod interface bar
program conftest procedure i_sub_foo
use conftest_mod end interface bar
type(foo) :: foovar
end program conftest end module conftest
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_FINAL $FDEFINES" :
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
echo "configure: failed program was:" >&5 echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5 cat conftest.$ac_ext >&5
FDEFINES="$psblas_cv_define_prepend-DHAVE_BUGGY_GENERICS $FDEFINES"
fi fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
@ -7388,8 +7406,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran SAME_TYPE_AS" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran FLUSH statement" >&5
$as_echo_n "checking support for Fortran SAME_TYPE_AS... " >&6; } $as_echo_n "checking support for Fortran FLUSH statement... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
@ -7400,25 +7418,18 @@ ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
program stt program conftest
type foo integer :: iunit=10
integer :: i open(10)
end type foo write(10,*) 'Test '
type, extends(foo) :: new_foo flush(10)
integer :: j close(10)
end type new_foo end program conftest
type(foo) :: foov
type(new_foo) :: nfv1, nfv2
write(*,*) 'foov == nfv1? ', same_type_as(foov,nfv1)
write(*,*) 'nfv2 == nfv1? ', same_type_as(nfv2,nfv1)
end program stt
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_SAME_TYPE_AS $FDEFINES" FDEFINES="$psblas_cv_define_prepend-DHAVE_FLUSH_STMT $FDEFINES"
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
@ -7435,8 +7446,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran EXTENDS_TYPE_OF" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for ISO_FORTRAN_ENV" >&5
$as_echo_n "checking support for Fortran EXTENDS_TYPE_OF... " >&6; } $as_echo_n "checking support for ISO_FORTRAN_ENV... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
@ -7447,23 +7458,14 @@ ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
program xtt program test
type foo use iso_fortran_env
integer :: i end program test
end type foo
type, extends(foo) :: new_foo
integer :: j
end type new_foo
type(foo) :: foov
type(new_foo) :: nfv1, nfv2
write(*,*) 'nfv1 extends foov? ', extends_type_of(nfv1,foov)
end program xtt
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_EXTENDS_TYPE_OF $FDEFINES" FDEFINES="$psblas_cv_define_prepend-DHAVE_ISO_FORTRAN_ENV $FDEFINES"
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
@ -7480,8 +7482,8 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran MOLD= allocation" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: checking support for Fortran FINAL" >&5
$as_echo_n "checking support for Fortran MOLD= allocation... " >&6; } $as_echo_n "checking support for Fortran FINAL... " >&6; }
ac_ext=${ac_fc_srcext-f} ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5' ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5' ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
@ -7492,25 +7494,29 @@ ac_compiler_gnu=$ac_cv_fc_compiler_gnu
ac_fc=${MPIFC-$FC}; ac_fc=${MPIFC-$FC};
cat > conftest.$ac_ext <<_ACEOF cat > conftest.$ac_ext <<_ACEOF
program xtt module conftest_mod
type foo type foo
integer :: i integer :: i
contains
final :: destroy_foo
end type foo end type foo
type, extends(foo) :: new_foo
integer :: j
end type new_foo
class(foo), allocatable :: fooab
type(new_foo) :: nfv
integer :: info
allocate(fooab, mold=nfv, stat=info)
end program xtt private destroy_foo
contains
subroutine destroy_foo(a)
type(foo) :: a
! Just a test
end subroutine destroy_foo
end module conftest_mod
program conftest
use conftest_mod
type(foo) :: foovar
end program conftest
_ACEOF _ACEOF
if ac_fn_fc_try_compile "$LINENO"; then : if ac_fn_fc_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; } $as_echo "yes" >&6; }
FDEFINES="$psblas_cv_define_prepend-DHAVE_MOLD $FDEFINES" FDEFINES="$psblas_cv_define_prepend-DHAVE_FINAL $FDEFINES"
else else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; } $as_echo "no" >&6; }
@ -7527,6 +7533,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
############################################################################### ###############################################################################
# Additional pathname stuff (yes, it is redundant and confusing...) # Additional pathname stuff (yes, it is redundant and confusing...)
############################################################################### ###############################################################################

@ -529,6 +529,24 @@ PAC_FORTRAN_TEST_ISO_C_BIND(
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])] Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
) )
PAC_FORTRAN_TEST_SAME_TYPE(
[],
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for SAME_TYPE_AS.
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
)
PAC_FORTRAN_TEST_EXTENDS_TYPE(
[],
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for EXTENDS_TYPE_OF.
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
)
PAC_FORTRAN_TEST_MOLD(
[],
[AC_MSG_ERROR([Sorry, cannot build PSBLAS without support for MOLD= allocation.
Please get a Fortran compiler that supports it, e.g. GNU Fortran 4.8.])]
)
# #
# Optional features # Optional features
# #
@ -554,17 +572,6 @@ PAC_FORTRAN_TEST_FINAL(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_FINAL $FDEFINES"], [FDEFINES="$psblas_cv_define_prepend-DHAVE_FINAL $FDEFINES"],
) )
PAC_FORTRAN_TEST_SAME_TYPE(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_SAME_TYPE_AS $FDEFINES"],
)
PAC_FORTRAN_TEST_EXTENDS_TYPE(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_EXTENDS_TYPE_OF $FDEFINES"],
)
PAC_FORTRAN_TEST_MOLD(
[FDEFINES="$psblas_cv_define_prepend-DHAVE_MOLD $FDEFINES"],
)
############################################################################### ###############################################################################
# Additional pathname stuff (yes, it is redundant and confusing...) # Additional pathname stuff (yes, it is redundant and confusing...)

Loading…
Cancel
Save