From 3d347d31dc77223c7e62915d546fbe4e3df55e6c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 5 Apr 2018 11:02:57 +0100 Subject: [PATCH] Ensure that the CNV method pick up the default storage format. Populate the defaults at psb_init time. --- base/modules/Makefile | 14 +++++----- base/modules/desc/psb_desc_const_mod.f90 | 3 +- base/modules/psi_penv_mod.F90 | 31 +++++++++++++++++++-- base/modules/serial/psb_c_vect_mod.F90 | 35 ++++++++++++++++-------- base/modules/serial/psb_d_vect_mod.F90 | 35 ++++++++++++++++-------- base/modules/serial/psb_i_vect_mod.F90 | 35 ++++++++++++++++-------- base/modules/serial/psb_s_vect_mod.F90 | 35 ++++++++++++++++-------- base/modules/serial/psb_z_vect_mod.F90 | 35 ++++++++++++++++-------- base/serial/impl/psb_c_mat_impl.F90 | 9 ++++-- base/serial/impl/psb_d_mat_impl.F90 | 9 ++++-- base/serial/impl/psb_s_mat_impl.F90 | 9 ++++-- base/serial/impl/psb_z_mat_impl.F90 | 9 ++++-- base/tools/psb_casb.f90 | 8 ++---- base/tools/psb_dasb.f90 | 8 ++---- base/tools/psb_iasb.f90 | 8 ++---- base/tools/psb_sasb.f90 | 8 ++---- base/tools/psb_zasb.f90 | 8 ++---- 17 files changed, 196 insertions(+), 103 deletions(-) diff --git a/base/modules/Makefile b/base/modules/Makefile index ec53f942..4c630baf 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -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_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 \ - 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_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 \ @@ -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_c_sort_mod.o aux/psb_z_sort_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_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 \ @@ -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) -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 $@ psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS) diff --git a/base/modules/desc/psb_desc_const_mod.f90 b/base/modules/desc/psb_desc_const_mod.f90 index 801a49e9..26d633fb 100644 --- a/base/modules/desc/psb_desc_const_mod.f90 +++ b/base/modules/desc/psb_desc_const_mod.f90 @@ -122,7 +122,8 @@ module psb_desc_const_mod interface subroutine psb_parts(glob_index,nrow,np,pv,nv) 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(*) end subroutine psb_parts end interface diff --git a/base/modules/psi_penv_mod.F90 b/base/modules/psi_penv_mod.F90 index 0be037a1..dec0b44f 100644 --- a/base/modules/psi_penv_mod.F90 +++ b/base/modules/psi_penv_mod.F90 @@ -273,6 +273,8 @@ contains use psi_comm_buffers_mod use psb_const_mod use psb_error_mod + use psb_mat_mod + use psb_vect_mod ! !$ use psb_rsb_mod #ifdef MPI_MOD use mpi @@ -282,8 +284,7 @@ contains include 'mpif.h' #endif 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_), allocatable :: iids(:) @@ -291,6 +292,21 @@ contains integer(psb_mpik_) :: np_, npavail, iam, info, basecomm, basegroup, newgroup character(len=20), parameter :: name='psb_init' integer(psb_ipk_) :: iinfo + ! + ! Defaults for vectors and matrices + ! + type(psb_s_csr_sparse_mat) :: smatdef + type(psb_d_csr_sparse_mat) :: dmatdef + type(psb_c_csr_sparse_mat) :: cmatdef + type(psb_z_csr_sparse_mat) :: zmatdef + + type(psb_i_base_vect_type) :: ivetdef + type(psb_s_base_vect_type) :: svetdef + type(psb_d_base_vect_type) :: dvetdef + type(psb_c_base_vect_type) :: cvetdef + type(psb_z_base_vect_type) :: zvetdef + + ! call psb_set_debug_unit(psb_err_unit) #if defined(SERIAL_MPI) @@ -381,6 +397,17 @@ contains if (ictxt == mpi_comm_null) return #endif + call psb_set_vect_default(ivetdef) + call psb_set_vect_default(svetdef) + call psb_set_vect_default(dvetdef) + call psb_set_vect_default(cvetdef) + call psb_set_vect_default(zvetdef) + + call psb_set_mat_default(smatdef) + call psb_set_mat_default(dmatdef) + call psb_set_mat_default(cmatdef) + call psb_set_mat_default(zmatdef) + ! !$ call psb_rsb_init(info) ! !$ if (info.ne.psb_rsb_const_success) then ! !$ if (info.eq.psb_rsb_const_not_available) then diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index c05f1dc7..fdd8060b 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -193,6 +193,7 @@ contains integer(psb_ipk_) :: info class(psb_c_base_vect_type), pointer :: mld + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -206,7 +207,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_c_get_base_vect_default()) #else - mld = psb_c_get_base_vect_default() + mld => psb_c_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -223,7 +224,7 @@ contains integer(psb_ipk_) :: info class(psb_c_base_vect_type), pointer :: mld - + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -237,7 +238,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_c_get_base_vect_default()) #else - mld = psb_c_get_base_vect_default() + mld => psb_c_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -480,21 +481,31 @@ contains class(psb_c_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(in), optional :: mold class(psb_c_base_vect_type), allocatable :: tmp + class(psb_c_base_vect_type), pointer :: mld integer(psb_ipk_) :: info + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(tmp,stat=info,mold=mold) #else call mold%mold(tmp,info) #endif - if (allocated(x%v)) then - call x%v%sync() - if (info == psb_success_) call tmp%bld(x%v%v) - call x%v%free(info) - end if - call move_alloc(tmp,x%v) + else +#ifdef HAVE_MOLD + allocate(tmp,stat=info,mold=psb_c_get_base_vect_default()) +#else + mld => psb_c_get_base_vect_default() + call mld%mold(tmp,info) +#endif + end if + if (allocated(x%v)) then + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) end if + call move_alloc(tmp,x%v) + end subroutine c_vect_cnv @@ -936,6 +947,7 @@ contains integer(psb_ipk_) :: info class(psb_c_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -946,7 +958,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default()) #else - mld = psb_c_get_base_multivect_default() + mld => psb_c_get_base_multivect_default() call mld%mold(x%v,info) #endif endif @@ -963,6 +975,7 @@ contains integer(psb_ipk_) :: info class(psb_c_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -973,7 +986,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default()) #else - mld = psb_c_get_base_multivect_default() + mld => psb_c_get_base_multivect_default() call mld%mold(x%v,info) #endif endif diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index baa97495..197a3e37 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -193,6 +193,7 @@ contains integer(psb_ipk_) :: info class(psb_d_base_vect_type), pointer :: mld + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -206,7 +207,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_d_get_base_vect_default()) #else - mld = psb_d_get_base_vect_default() + mld => psb_d_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -223,7 +224,7 @@ contains integer(psb_ipk_) :: info class(psb_d_base_vect_type), pointer :: mld - + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -237,7 +238,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_d_get_base_vect_default()) #else - mld = psb_d_get_base_vect_default() + mld => psb_d_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -480,21 +481,31 @@ contains class(psb_d_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(in), optional :: mold class(psb_d_base_vect_type), allocatable :: tmp + class(psb_d_base_vect_type), pointer :: mld integer(psb_ipk_) :: info + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(tmp,stat=info,mold=mold) #else call mold%mold(tmp,info) #endif - if (allocated(x%v)) then - call x%v%sync() - if (info == psb_success_) call tmp%bld(x%v%v) - call x%v%free(info) - end if - call move_alloc(tmp,x%v) + else +#ifdef HAVE_MOLD + allocate(tmp,stat=info,mold=psb_d_get_base_vect_default()) +#else + mld => psb_d_get_base_vect_default() + call mld%mold(tmp,info) +#endif + end if + if (allocated(x%v)) then + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) end if + call move_alloc(tmp,x%v) + end subroutine d_vect_cnv @@ -936,6 +947,7 @@ contains integer(psb_ipk_) :: info class(psb_d_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -946,7 +958,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default()) #else - mld = psb_d_get_base_multivect_default() + mld => psb_d_get_base_multivect_default() call mld%mold(x%v,info) #endif endif @@ -963,6 +975,7 @@ contains integer(psb_ipk_) :: info class(psb_d_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -973,7 +986,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default()) #else - mld = psb_d_get_base_multivect_default() + mld => psb_d_get_base_multivect_default() call mld%mold(x%v,info) #endif endif diff --git a/base/modules/serial/psb_i_vect_mod.F90 b/base/modules/serial/psb_i_vect_mod.F90 index 2d297058..1df4be14 100644 --- a/base/modules/serial/psb_i_vect_mod.F90 +++ b/base/modules/serial/psb_i_vect_mod.F90 @@ -166,6 +166,7 @@ contains integer(psb_ipk_) :: info class(psb_i_base_vect_type), pointer :: mld + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -179,7 +180,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_i_get_base_vect_default()) #else - mld = psb_i_get_base_vect_default() + mld => psb_i_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -196,7 +197,7 @@ contains integer(psb_ipk_) :: info class(psb_i_base_vect_type), pointer :: mld - + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -210,7 +211,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_i_get_base_vect_default()) #else - mld = psb_i_get_base_vect_default() + mld => psb_i_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -453,21 +454,31 @@ contains class(psb_i_vect_type), intent(inout) :: x class(psb_i_base_vect_type), intent(in), optional :: mold class(psb_i_base_vect_type), allocatable :: tmp + class(psb_i_base_vect_type), pointer :: mld integer(psb_ipk_) :: info + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(tmp,stat=info,mold=mold) #else call mold%mold(tmp,info) #endif - if (allocated(x%v)) then - call x%v%sync() - if (info == psb_success_) call tmp%bld(x%v%v) - call x%v%free(info) - end if - call move_alloc(tmp,x%v) + else +#ifdef HAVE_MOLD + allocate(tmp,stat=info,mold=psb_i_get_base_vect_default()) +#else + mld => psb_i_get_base_vect_default() + call mld%mold(tmp,info) +#endif + end if + if (allocated(x%v)) then + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) end if + call move_alloc(tmp,x%v) + end subroutine i_vect_cnv @@ -665,6 +676,7 @@ contains integer(psb_ipk_) :: info class(psb_i_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -675,7 +687,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default()) #else - mld = psb_i_get_base_multivect_default() + mld => psb_i_get_base_multivect_default() call mld%mold(x%v,info) #endif endif @@ -692,6 +704,7 @@ contains integer(psb_ipk_) :: info class(psb_i_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -702,7 +715,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default()) #else - mld = psb_i_get_base_multivect_default() + mld => psb_i_get_base_multivect_default() call mld%mold(x%v,info) #endif endif diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index b4ecd394..381ca3c8 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -193,6 +193,7 @@ contains integer(psb_ipk_) :: info class(psb_s_base_vect_type), pointer :: mld + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -206,7 +207,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_s_get_base_vect_default()) #else - mld = psb_s_get_base_vect_default() + mld => psb_s_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -223,7 +224,7 @@ contains integer(psb_ipk_) :: info class(psb_s_base_vect_type), pointer :: mld - + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -237,7 +238,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_s_get_base_vect_default()) #else - mld = psb_s_get_base_vect_default() + mld => psb_s_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -480,21 +481,31 @@ contains class(psb_s_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(in), optional :: mold class(psb_s_base_vect_type), allocatable :: tmp + class(psb_s_base_vect_type), pointer :: mld integer(psb_ipk_) :: info + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(tmp,stat=info,mold=mold) #else call mold%mold(tmp,info) #endif - if (allocated(x%v)) then - call x%v%sync() - if (info == psb_success_) call tmp%bld(x%v%v) - call x%v%free(info) - end if - call move_alloc(tmp,x%v) + else +#ifdef HAVE_MOLD + allocate(tmp,stat=info,mold=psb_s_get_base_vect_default()) +#else + mld => psb_s_get_base_vect_default() + call mld%mold(tmp,info) +#endif + end if + if (allocated(x%v)) then + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) end if + call move_alloc(tmp,x%v) + end subroutine s_vect_cnv @@ -936,6 +947,7 @@ contains integer(psb_ipk_) :: info class(psb_s_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -946,7 +958,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default()) #else - mld = psb_s_get_base_multivect_default() + mld => psb_s_get_base_multivect_default() call mld%mold(x%v,info) #endif endif @@ -963,6 +975,7 @@ contains integer(psb_ipk_) :: info class(psb_s_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -973,7 +986,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default()) #else - mld = psb_s_get_base_multivect_default() + mld => psb_s_get_base_multivect_default() call mld%mold(x%v,info) #endif endif diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index 788d3ab1..823ccf0c 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -193,6 +193,7 @@ contains integer(psb_ipk_) :: info class(psb_z_base_vect_type), pointer :: mld + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -206,7 +207,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_z_get_base_vect_default()) #else - mld = psb_z_get_base_vect_default() + mld => psb_z_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -223,7 +224,7 @@ contains integer(psb_ipk_) :: info class(psb_z_base_vect_type), pointer :: mld - + info = psb_success_ if (allocated(x%v)) & & call x%free(info) @@ -237,7 +238,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_z_get_base_vect_default()) #else - mld = psb_z_get_base_vect_default() + mld => psb_z_get_base_vect_default() call mld%mold(x%v,info) #endif endif @@ -480,21 +481,31 @@ contains class(psb_z_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(in), optional :: mold class(psb_z_base_vect_type), allocatable :: tmp + class(psb_z_base_vect_type), pointer :: mld integer(psb_ipk_) :: info + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(tmp,stat=info,mold=mold) #else call mold%mold(tmp,info) #endif - if (allocated(x%v)) then - call x%v%sync() - if (info == psb_success_) call tmp%bld(x%v%v) - call x%v%free(info) - end if - call move_alloc(tmp,x%v) + else +#ifdef HAVE_MOLD + allocate(tmp,stat=info,mold=psb_z_get_base_vect_default()) +#else + mld => psb_z_get_base_vect_default() + call mld%mold(tmp,info) +#endif + end if + if (allocated(x%v)) then + call x%v%sync() + if (info == psb_success_) call tmp%bld(x%v%v) + call x%v%free(info) end if + call move_alloc(tmp,x%v) + end subroutine z_vect_cnv @@ -936,6 +947,7 @@ contains integer(psb_ipk_) :: info class(psb_z_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -946,7 +958,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default()) #else - mld = psb_z_get_base_multivect_default() + mld => psb_z_get_base_multivect_default() call mld%mold(x%v,info) #endif endif @@ -963,6 +975,7 @@ contains integer(psb_ipk_) :: info class(psb_z_base_multivect_type), pointer :: mld + info = psb_success_ if (present(mold)) then #ifdef HAVE_MOLD allocate(x%v,stat=info,mold=mold) @@ -973,7 +986,7 @@ contains #ifdef HAVE_MOLD allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default()) #else - mld = psb_z_get_base_multivect_default() + mld => psb_z_get_base_multivect_default() call mld%mold(x%v,info) #endif endif diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 766939a8..8b233647 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -1179,7 +1179,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1290,7 +1290,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1811,6 +1811,7 @@ subroutine psb_c_asb(a,mold) class(psb_cspmat_type), intent(inout) :: a class(psb_c_base_sparse_mat), optional, intent(in) :: mold class(psb_c_base_sparse_mat), allocatable :: tmp + class(psb_c_base_sparse_mat), pointer :: mld integer(psb_ipk_) :: err_act, info character(len=20) :: name='c_asb' @@ -1829,6 +1830,10 @@ subroutine psb_c_asb(a,mold) call a%a%free() call move_alloc(tmp,a%a) end if + else + mld => psb_c_get_base_mat_default() + if (.not.same_type_as(a%a,mld)) & + & call a%cscnv(info) end if diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index bd504cc7..7ae42421 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1179,7 +1179,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1290,7 +1290,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1811,6 +1811,7 @@ subroutine psb_d_asb(a,mold) class(psb_dspmat_type), intent(inout) :: a class(psb_d_base_sparse_mat), optional, intent(in) :: mold class(psb_d_base_sparse_mat), allocatable :: tmp + class(psb_d_base_sparse_mat), pointer :: mld integer(psb_ipk_) :: err_act, info character(len=20) :: name='d_asb' @@ -1829,6 +1830,10 @@ subroutine psb_d_asb(a,mold) call a%a%free() call move_alloc(tmp,a%a) end if + else + mld => psb_d_get_base_mat_default() + if (.not.same_type_as(a%a,mld)) & + & call a%cscnv(info) end if diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 50919f15..50d43b1e 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -1179,7 +1179,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1290,7 +1290,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1811,6 +1811,7 @@ subroutine psb_s_asb(a,mold) class(psb_sspmat_type), intent(inout) :: a class(psb_s_base_sparse_mat), optional, intent(in) :: mold class(psb_s_base_sparse_mat), allocatable :: tmp + class(psb_s_base_sparse_mat), pointer :: mld integer(psb_ipk_) :: err_act, info character(len=20) :: name='s_asb' @@ -1829,6 +1830,10 @@ subroutine psb_s_asb(a,mold) call a%a%free() call move_alloc(tmp,a%a) end if + else + mld => psb_s_get_base_mat_default() + if (.not.same_type_as(a%a,mld)) & + & call a%cscnv(info) end if diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 9e88f19f..40b8e0dc 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -1179,7 +1179,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1290,7 +1290,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl) #if defined(HAVE_MOLD) allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) + mld => psb_get_mat_default(a) call mld%mold(altmp,info) #endif end if @@ -1811,6 +1811,7 @@ subroutine psb_z_asb(a,mold) class(psb_zspmat_type), intent(inout) :: a class(psb_z_base_sparse_mat), optional, intent(in) :: mold class(psb_z_base_sparse_mat), allocatable :: tmp + class(psb_z_base_sparse_mat), pointer :: mld integer(psb_ipk_) :: err_act, info character(len=20) :: name='z_asb' @@ -1829,6 +1830,10 @@ subroutine psb_z_asb(a,mold) call a%a%free() call move_alloc(tmp,a%a) end if + else + mld => psb_z_get_base_mat_default() + if (.not.same_type_as(a%a,mld)) & + & call a%cscnv(info) end if diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index bb43ea3b..463ec37d 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -313,9 +313,7 @@ subroutine psb_casb_vect(x, desc_a, info, mold, scratch) call psb_errpush(info,name,a_err='psb_halo') goto 9999 end if - if (present(mold)) then - call x%cnv(mold) - end if + call x%cnv(mold) end if if (debug_level >= psb_debug_ext_) & & 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.. call psb_halo(x(i),desc_a,info) if (info /= 0) exit - if (present(mold)) then - call x(i)%cnv(mold) - end if + call x(i)%cnv(mold) end do if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 4e673c16..93dc226e 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -313,9 +313,7 @@ subroutine psb_dasb_vect(x, desc_a, info, mold, scratch) call psb_errpush(info,name,a_err='psb_halo') goto 9999 end if - if (present(mold)) then - call x%cnv(mold) - end if + call x%cnv(mold) end if if (debug_level >= psb_debug_ext_) & & 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.. call psb_halo(x(i),desc_a,info) if (info /= 0) exit - if (present(mold)) then - call x(i)%cnv(mold) - end if + call x(i)%cnv(mold) end do if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index 148b011a..02d51425 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -313,9 +313,7 @@ subroutine psb_iasb_vect(x, desc_a, info, mold, scratch) call psb_errpush(info,name,a_err='psb_halo') goto 9999 end if - if (present(mold)) then - call x%cnv(mold) - end if + call x%cnv(mold) end if if (debug_level >= psb_debug_ext_) & & 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.. call psb_halo(x(i),desc_a,info) if (info /= 0) exit - if (present(mold)) then - call x(i)%cnv(mold) - end if + call x(i)%cnv(mold) end do if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index 496303cf..ebc675aa 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -313,9 +313,7 @@ subroutine psb_sasb_vect(x, desc_a, info, mold, scratch) call psb_errpush(info,name,a_err='psb_halo') goto 9999 end if - if (present(mold)) then - call x%cnv(mold) - end if + call x%cnv(mold) end if if (debug_level >= psb_debug_ext_) & & 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.. call psb_halo(x(i),desc_a,info) if (info /= 0) exit - if (present(mold)) then - call x(i)%cnv(mold) - end if + call x(i)%cnv(mold) end do if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 5e027b78..1e640bdd 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -313,9 +313,7 @@ subroutine psb_zasb_vect(x, desc_a, info, mold, scratch) call psb_errpush(info,name,a_err='psb_halo') goto 9999 end if - if (present(mold)) then - call x%cnv(mold) - end if + call x%cnv(mold) end if if (debug_level >= psb_debug_ext_) & & 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.. call psb_halo(x(i),desc_a,info) if (info /= 0) exit - if (present(mold)) then - call x(i)%cnv(mold) - end if + call x(i)%cnv(mold) end do if(info /= psb_success_) then info=psb_err_from_subroutine_