fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Ensure that the CNV method pick up the default storage format.

Browse Source 
Populate the defaults at psb_init time.
pull/6/head
Salvatore Filippone 7 years ago
parent 63b84bfae9
commit 3d347d31dc
17 changed files with 196 additions and 103 deletions
Show Stats Download Patch File Download Diff File

14
base/modules/Makefile
Unescape Escape View File

@ -15,12 +15,6 @@ UTIL_MODS = aux/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_mod
comm/psb_s_linmap_mod.o comm/psb_d_linmap_mod.o comm/psb_c_linmap_mod.o comm/psb_z_linmap_mod.o \ comm/psb_s_linmap_mod.o comm/psb_d_linmap_mod.o comm/psb_c_linmap_mod.o comm/psb_z_linmap_mod.o \
comm/psb_comm_mod.o comm/psb_i_comm_mod.o comm/psb_s_comm_mod.o comm/psb_d_comm_mod.o\ comm/psb_comm_mod.o comm/psb_i_comm_mod.o comm/psb_s_comm_mod.o comm/psb_d_comm_mod.o\
comm/psb_c_comm_mod.o comm/psb_z_comm_mod.o \ comm/psb_c_comm_mod.o comm/psb_z_comm_mod.o \
serial/psb_i_base_vect_mod.o serial/psb_i_vect_mod.o\
serial/psb_d_base_vect_mod.o serial/psb_d_vect_mod.o\
serial/psb_s_base_vect_mod.o serial/psb_s_vect_mod.o\
serial/psb_c_base_vect_mod.o serial/psb_c_vect_mod.o\
serial/psb_z_base_vect_mod.o serial/psb_z_vect_mod.o\
serial/psb_vect_mod.o\
psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o \ psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o \
psblas/psb_d_psblas_mod.o psblas/psb_z_psblas_mod.o psblas/psb_psblas_mod.o \ psblas/psb_d_psblas_mod.o psblas/psb_z_psblas_mod.o psblas/psb_psblas_mod.o \
aux/psi_serial_mod.o aux/psi_i_serial_mod.o \ aux/psi_serial_mod.o aux/psi_i_serial_mod.o \
@ -30,6 +24,12 @@ UTIL_MODS = aux/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_mod
aux/psb_i_sort_mod.o aux/psb_s_sort_mod.o aux/psb_d_sort_mod.o \ aux/psb_i_sort_mod.o aux/psb_s_sort_mod.o aux/psb_d_sort_mod.o \
aux/psb_c_sort_mod.o aux/psb_z_sort_mod.o \ aux/psb_c_sort_mod.o aux/psb_z_sort_mod.o \
psb_check_mod.o aux/psb_hash_mod.o\ psb_check_mod.o aux/psb_hash_mod.o\
serial/psb_i_base_vect_mod.o serial/psb_i_vect_mod.o\
serial/psb_d_base_vect_mod.o serial/psb_d_vect_mod.o\
serial/psb_s_base_vect_mod.o serial/psb_s_vect_mod.o\
serial/psb_c_base_vect_mod.o serial/psb_c_vect_mod.o\
serial/psb_z_base_vect_mod.o serial/psb_z_vect_mod.o\
serial/psb_vect_mod.o\
serial/psb_base_mat_mod.o serial/psb_mat_mod.o\ serial/psb_base_mat_mod.o serial/psb_mat_mod.o\
serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_mat_mod.o \ serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_mat_mod.o \
serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_mat_mod.o \ serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_mat_mod.o \
@ -155,7 +155,7 @@ psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o psblas/psb_d_psblas_mod.o ps
psb_base_mod.o: $(MODULES) psb_base_mod.o: $(MODULES)
psi_penv_mod.o: psi_penv_mod.F90 $(BASIC_MODS) psi_penv_mod.o: psi_penv_mod.F90 $(BASIC_MODS) serial/psb_vect_mod.o serial/psb_mat_mod.o
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@ $(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS) psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS)

3
base/modules/desc/psb_desc_const_mod.f90
Unescape Escape View File

@ -122,7 +122,8 @@ module psb_desc_const_mod
interface interface
subroutine psb_parts(glob_index,nrow,np,pv,nv) subroutine psb_parts(glob_index,nrow,np,pv,nv)
import :: psb_ipk_ import :: psb_ipk_
integer(psb_ipk_), intent (in) :: glob_index,nrow, np integer(psb_ipk_), intent (in) :: glob_index, nrow
integer(psb_ipk_), intent (in) :: np
integer(psb_ipk_), intent (out) :: nv, pv(*) integer(psb_ipk_), intent (out) :: nv, pv(*)
end subroutine psb_parts end subroutine psb_parts
end interface end interface

29
base/modules/psi_penv_mod.F90
Unescape Escape View File

@ -273,6 +273,8 @@ contains
use psi_comm_buffers_mod use psi_comm_buffers_mod
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
use psb_mat_mod
use psb_vect_mod
! !$ use psb_rsb_mod ! !$ use psb_rsb_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
@ -284,13 +286,27 @@ contains
integer(psb_mpik_), intent(out) :: ictxt integer(psb_mpik_), intent(out) :: ictxt
integer(psb_mpik_), intent(in), optional :: np, basectxt, ids(:) integer(psb_mpik_), intent(in), optional :: np, basectxt, ids(:)
integer(psb_mpik_) :: i, isnullcomm integer(psb_mpik_) :: i, isnullcomm
integer(psb_mpik_), allocatable :: iids(:) integer(psb_mpik_), allocatable :: iids(:)
logical :: initialized logical :: initialized
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)
#if defined(SERIAL_MPI) #if defined(SERIAL_MPI)
@ -381,6 +397,17 @@ contains
if (ictxt == mpi_comm_null) return if (ictxt == mpi_comm_null) return
#endif #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) ! !$ call psb_rsb_init(info)
! !$ if (info.ne.psb_rsb_const_success) then ! !$ if (info.ne.psb_rsb_const_success) then
! !$ if (info.eq.psb_rsb_const_not_available) then ! !$ if (info.eq.psb_rsb_const_not_available) then

35
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -193,6 +193,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_vect_type), pointer :: mld class(psb_c_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -206,7 +207,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_c_get_base_vect_default() mld => psb_c_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -223,7 +224,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_vect_type), pointer :: mld class(psb_c_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -237,7 +238,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_c_get_base_vect_default() mld => psb_c_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -480,21 +481,31 @@ 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_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else #else
call mold%mold(tmp,info) call mold%mold(tmp,info)
#endif #endif
if (allocated(x%v)) then else
call x%v%sync() #ifdef HAVE_MOLD
if (info == psb_success_) call tmp%bld(x%v%v) allocate(tmp,stat=info,mold=psb_c_get_base_vect_default())
call x%v%free(info) #else
end if mld => psb_c_get_base_vect_default()
call move_alloc(tmp,x%v) call mld%mold(tmp,info)
#endif
end if
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 end if
call move_alloc(tmp,x%v)
end subroutine c_vect_cnv end subroutine c_vect_cnv
@ -936,6 +947,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_multivect_type), pointer :: mld class(psb_c_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -946,7 +958,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_c_get_base_multivect_default() mld => psb_c_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -963,6 +975,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_c_base_multivect_type), pointer :: mld class(psb_c_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -973,7 +986,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_c_get_base_multivect_default() mld => psb_c_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif

35
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -193,6 +193,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_vect_type), pointer :: mld class(psb_d_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -206,7 +207,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_d_get_base_vect_default() mld => psb_d_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -223,7 +224,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_vect_type), pointer :: mld class(psb_d_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -237,7 +238,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_d_get_base_vect_default() mld => psb_d_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -480,21 +481,31 @@ 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_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else #else
call mold%mold(tmp,info) call mold%mold(tmp,info)
#endif #endif
if (allocated(x%v)) then else
call x%v%sync() #ifdef HAVE_MOLD
if (info == psb_success_) call tmp%bld(x%v%v) allocate(tmp,stat=info,mold=psb_d_get_base_vect_default())
call x%v%free(info) #else
end if mld => psb_d_get_base_vect_default()
call move_alloc(tmp,x%v) call mld%mold(tmp,info)
#endif
end if
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 end if
call move_alloc(tmp,x%v)
end subroutine d_vect_cnv end subroutine d_vect_cnv
@ -936,6 +947,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_multivect_type), pointer :: mld class(psb_d_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -946,7 +958,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_d_get_base_multivect_default() mld => psb_d_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -963,6 +975,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_d_base_multivect_type), pointer :: mld class(psb_d_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -973,7 +986,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_d_get_base_multivect_default() mld => psb_d_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif

35
base/modules/serial/psb_i_vect_mod.F90
Unescape Escape View File

@ -166,6 +166,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld class(psb_i_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -179,7 +180,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_i_get_base_vect_default() mld => psb_i_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -196,7 +197,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld class(psb_i_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -210,7 +211,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_i_get_base_vect_default() mld => psb_i_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -453,21 +454,31 @@ 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_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else #else
call mold%mold(tmp,info) call mold%mold(tmp,info)
#endif #endif
if (allocated(x%v)) then else
call x%v%sync() #ifdef HAVE_MOLD
if (info == psb_success_) call tmp%bld(x%v%v) allocate(tmp,stat=info,mold=psb_i_get_base_vect_default())
call x%v%free(info) #else
end if mld => psb_i_get_base_vect_default()
call move_alloc(tmp,x%v) call mld%mold(tmp,info)
#endif
end if
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 end if
call move_alloc(tmp,x%v)
end subroutine i_vect_cnv end subroutine i_vect_cnv
@ -665,6 +676,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_multivect_type), pointer :: mld class(psb_i_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -675,7 +687,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_i_get_base_multivect_default() mld => psb_i_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -692,6 +704,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_i_base_multivect_type), pointer :: mld class(psb_i_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -702,7 +715,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_i_get_base_multivect_default() mld => psb_i_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif

35
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -193,6 +193,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_vect_type), pointer :: mld class(psb_s_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -206,7 +207,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_s_get_base_vect_default() mld => psb_s_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -223,7 +224,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_vect_type), pointer :: mld class(psb_s_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -237,7 +238,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_s_get_base_vect_default() mld => psb_s_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -480,21 +481,31 @@ 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_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else #else
call mold%mold(tmp,info) call mold%mold(tmp,info)
#endif #endif
if (allocated(x%v)) then else
call x%v%sync() #ifdef HAVE_MOLD
if (info == psb_success_) call tmp%bld(x%v%v) allocate(tmp,stat=info,mold=psb_s_get_base_vect_default())
call x%v%free(info) #else
end if mld => psb_s_get_base_vect_default()
call move_alloc(tmp,x%v) call mld%mold(tmp,info)
#endif
end if
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 end if
call move_alloc(tmp,x%v)
end subroutine s_vect_cnv end subroutine s_vect_cnv
@ -936,6 +947,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_multivect_type), pointer :: mld class(psb_s_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -946,7 +958,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_s_get_base_multivect_default() mld => psb_s_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -963,6 +975,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_s_base_multivect_type), pointer :: mld class(psb_s_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -973,7 +986,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_s_get_base_multivect_default() mld => psb_s_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif

35
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -193,6 +193,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_vect_type), pointer :: mld class(psb_z_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -206,7 +207,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_z_get_base_vect_default() mld => psb_z_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -223,7 +224,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_vect_type), pointer :: mld class(psb_z_base_vect_type), pointer :: mld
info = psb_success_
if (allocated(x%v)) & if (allocated(x%v)) &
& call x%free(info) & call x%free(info)
@ -237,7 +238,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_z_get_base_vect_default() mld => psb_z_get_base_vect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -480,21 +481,31 @@ 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_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold) allocate(tmp,stat=info,mold=mold)
#else #else
call mold%mold(tmp,info) call mold%mold(tmp,info)
#endif #endif
if (allocated(x%v)) then else
call x%v%sync() #ifdef HAVE_MOLD
if (info == psb_success_) call tmp%bld(x%v%v) allocate(tmp,stat=info,mold=psb_z_get_base_vect_default())
call x%v%free(info) #else
end if mld => psb_z_get_base_vect_default()
call move_alloc(tmp,x%v) call mld%mold(tmp,info)
#endif
end if
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 end if
call move_alloc(tmp,x%v)
end subroutine z_vect_cnv end subroutine z_vect_cnv
@ -936,6 +947,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_multivect_type), pointer :: mld class(psb_z_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -946,7 +958,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_z_get_base_multivect_default() mld => psb_z_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif
@ -963,6 +975,7 @@ contains
integer(psb_ipk_) :: info integer(psb_ipk_) :: info
class(psb_z_base_multivect_type), pointer :: mld class(psb_z_base_multivect_type), pointer :: mld
info = psb_success_
if (present(mold)) then if (present(mold)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold) allocate(x%v,stat=info,mold=mold)
@ -973,7 +986,7 @@ contains
#ifdef HAVE_MOLD #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 #else
mld = psb_z_get_base_multivect_default() mld => psb_z_get_base_multivect_default()
call mld%mold(x%v,info) call mld%mold(x%v,info)
#endif #endif
endif endif

9
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -1179,7 +1179,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1290,7 +1290,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1811,6 +1811,7 @@ subroutine psb_c_asb(a,mold)
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
class(psb_c_base_sparse_mat), optional, intent(in) :: mold class(psb_c_base_sparse_mat), optional, intent(in) :: mold
class(psb_c_base_sparse_mat), allocatable :: tmp class(psb_c_base_sparse_mat), allocatable :: tmp
class(psb_c_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
character(len=20) :: name='c_asb' character(len=20) :: name='c_asb'
@ -1829,6 +1830,10 @@ subroutine psb_c_asb(a,mold)
call a%a%free() call a%a%free()
call move_alloc(tmp,a%a) call move_alloc(tmp,a%a)
end if end if
else
mld => psb_c_get_base_mat_default()
if (.not.same_type_as(a%a,mld)) &
& call a%cscnv(info)
end if end if

9
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -1179,7 +1179,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1290,7 +1290,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1811,6 +1811,7 @@ subroutine psb_d_asb(a,mold)
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), optional, intent(in) :: mold class(psb_d_base_sparse_mat), optional, intent(in) :: mold
class(psb_d_base_sparse_mat), allocatable :: tmp class(psb_d_base_sparse_mat), allocatable :: tmp
class(psb_d_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
character(len=20) :: name='d_asb' character(len=20) :: name='d_asb'
@ -1829,6 +1830,10 @@ subroutine psb_d_asb(a,mold)
call a%a%free() call a%a%free()
call move_alloc(tmp,a%a) call move_alloc(tmp,a%a)
end if end if
else
mld => psb_d_get_base_mat_default()
if (.not.same_type_as(a%a,mld)) &
& call a%cscnv(info)
end if end if

9
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -1179,7 +1179,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1290,7 +1290,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1811,6 +1811,7 @@ subroutine psb_s_asb(a,mold)
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
class(psb_s_base_sparse_mat), optional, intent(in) :: mold class(psb_s_base_sparse_mat), optional, intent(in) :: mold
class(psb_s_base_sparse_mat), allocatable :: tmp class(psb_s_base_sparse_mat), allocatable :: tmp
class(psb_s_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
character(len=20) :: name='s_asb' character(len=20) :: name='s_asb'
@ -1829,6 +1830,10 @@ subroutine psb_s_asb(a,mold)
call a%a%free() call a%a%free()
call move_alloc(tmp,a%a) call move_alloc(tmp,a%a)
end if end if
else
mld => psb_s_get_base_mat_default()
if (.not.same_type_as(a%a,mld)) &
& call a%cscnv(info)
end if end if

9
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -1179,7 +1179,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1290,7 +1290,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl)
#if defined(HAVE_MOLD) #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 #else
mld = psb_get_mat_default(a) mld => psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
@ -1811,6 +1811,7 @@ subroutine psb_z_asb(a,mold)
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
class(psb_z_base_sparse_mat), optional, intent(in) :: mold class(psb_z_base_sparse_mat), optional, intent(in) :: mold
class(psb_z_base_sparse_mat), allocatable :: tmp class(psb_z_base_sparse_mat), allocatable :: tmp
class(psb_z_base_sparse_mat), pointer :: mld
integer(psb_ipk_) :: err_act, info integer(psb_ipk_) :: err_act, info
character(len=20) :: name='z_asb' character(len=20) :: name='z_asb'
@ -1829,6 +1830,10 @@ subroutine psb_z_asb(a,mold)
call a%a%free() call a%a%free()
call move_alloc(tmp,a%a) call move_alloc(tmp,a%a)
end if end if
else
mld => psb_z_get_base_mat_default()
if (.not.same_type_as(a%a,mld)) &
& call a%cscnv(info)
end if end if

8
base/tools/psb_casb.f90
Unescape Escape View File

@ -313,9 +313,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
if (present(mold)) then call x%cnv(mold)
call x%cnv(mold)
end if
end if end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -391,9 +389,7 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x(i),desc_a,info) call psb_halo(x(i),desc_a,info)
if (info /= 0) exit if (info /= 0) exit
if (present(mold)) then call x(i)%cnv(mold)
call x(i)%cnv(mold)
end if
end do end do
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

8
base/tools/psb_dasb.f90
Unescape Escape View File

@ -313,9 +313,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
if (present(mold)) then call x%cnv(mold)
call x%cnv(mold)
end if
end if end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -391,9 +389,7 @@ subroutine psb_dasb_vect_r2(x, desc_a, info, mold, scratch)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x(i),desc_a,info) call psb_halo(x(i),desc_a,info)
if (info /= 0) exit if (info /= 0) exit
if (present(mold)) then call x(i)%cnv(mold)
call x(i)%cnv(mold)
end if
end do end do
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

8
base/tools/psb_iasb.f90
Unescape Escape View File

@ -313,9 +313,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
if (present(mold)) then call x%cnv(mold)
call x%cnv(mold)
end if
end if end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -391,9 +389,7 @@ subroutine psb_iasb_vect_r2(x, desc_a, info, mold, scratch)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x(i),desc_a,info) call psb_halo(x(i),desc_a,info)
if (info /= 0) exit if (info /= 0) exit
if (present(mold)) then call x(i)%cnv(mold)
call x(i)%cnv(mold)
end if
end do end do
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

8
base/tools/psb_sasb.f90
Unescape Escape View File

@ -313,9 +313,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
if (present(mold)) then call x%cnv(mold)
call x%cnv(mold)
end if
end if end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -391,9 +389,7 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x(i),desc_a,info) call psb_halo(x(i),desc_a,info)
if (info /= 0) exit if (info /= 0) exit
if (present(mold)) then call x(i)%cnv(mold)
call x(i)%cnv(mold)
end if
end do end do
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

8
base/tools/psb_zasb.f90
Unescape Escape View File

@ -313,9 +313,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
if (present(mold)) then call x%cnv(mold)
call x%cnv(mold)
end if
end if end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & write(debug_unit,*) me,' ',trim(name),': end'
@ -391,9 +389,7 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
! ..update halo elements.. ! ..update halo elements..
call psb_halo(x(i),desc_a,info) call psb_halo(x(i),desc_a,info)
if (info /= 0) exit if (info /= 0) exit
if (present(mold)) then call x(i)%cnv(mold)
call x(i)%cnv(mold)
end if
end do end do
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

Write Preview
Loading…
Cancel
Save