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

Modified IPK/LPK/EPK/MPK.

Browse Source 
Split & reworked realloc module.
ILmat
Salvatore Filippone 8 years ago
parent 15c01cb5e5
commit 0c4a5c9716
22 changed files with 6811 additions and 3844 deletions
Show Stats Download Patch File Download Diff File

15
base/modules/Makefile
Unescape Escape View File

@ -1,6 +1,13 @@
include ../../Make.inc
BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o
BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o \
basics/psb_m_realloc_mod.o \
basics/psb_e_realloc_mod.o \
basics/psb_s_realloc_mod.o \
basics/psb_d_realloc_mod.o \
basics/psb_c_realloc_mod.o \
basics/psb_z_realloc_mod.o
COMMINT=psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o
UTIL_MODS = aux/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\
desc/psb_gen_block_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o\
@ -63,6 +70,12 @@ $(UTIL_MODS): $(BASIC_MODS)
psi_penv_mod.o: psi_comm_buffers_mod.o
psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o: psi_penv_mod.o
psb_realloc_mod.o: basics/psb_m_realloc_mod.o \
basics/psb_e_realloc_mod.o \
basics/psb_s_realloc_mod.o \
basics/psb_d_realloc_mod.o \
basics/psb_c_realloc_mod.o \
basics/psb_z_realloc_mod.o
aux/psb_string_mod.o desc/psb_desc_const_mod.o psi_comm_buffers_mod.o: psb_const_mod.o
aux/psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o

1027
base/modules/basics/psb_c_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

1027
base/modules/basics/psb_d_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

1027
base/modules/basics/psb_e_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

1027
base/modules/basics/psb_m_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

1027
base/modules/basics/psb_s_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

1027
base/modules/basics/psb_z_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

22
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -33,6 +33,8 @@
module psb_const_mod
#if defined(HAVE_ISO_FORTRAN_ENV)
use iso_fortran_env
! This is a 2-byte integer, just in case
integer, parameter :: psb_i2pk_ = int16
! This is always a 4-byte integer, for MPI-related stuff
integer, parameter :: psb_mpk_ = int32
! This is always an 8-byte integer.
@ -45,12 +47,15 @@ module psb_const_mod
integer, parameter :: psb_dpk_ = real64
#else
integer, parameter :: indig=8
integer, parameter :: lndig=12
! This is a 2-byte integer, just in case
integer, parameter :: i2ndig=4
integer, parameter :: psb_i2pk_ = selected_int_kind(i2ndig)
! This is always a 4-byte integer, for MPI-related stuff
integer, parameter :: indig=8
integer, parameter :: psb_mpk_ = selected_int_kind(indig)
! This is always an 8-byte integer.
integer, parameter :: lndig=12
integer, parameter :: psb_epk_ = selected_int_kind(lndig)
!
! These must be the kind parameter corresponding to psb_mpi_r_dpk_
@ -98,6 +103,7 @@ module psb_const_mod
integer(psb_ipk_), save :: psb_sizeof_sp
integer(psb_ipk_), save :: psb_sizeof_dp
integer(psb_ipk_), save :: psb_sizeof_i2p
integer(psb_ipk_), save :: psb_sizeof_mp
integer(psb_ipk_), save :: psb_sizeof_ep
integer(psb_ipk_), save :: psb_sizeof_ip
@ -105,6 +111,7 @@ module psb_const_mod
!
! Integer type identifiers for MPI operations.
!
integer(psb_mpk_), save :: psb_mpi_i2pk_int
integer(psb_mpk_), save :: psb_mpi_epk_int
integer(psb_mpk_), save :: psb_mpi_mpk_int
integer(psb_mpk_), save :: psb_mpi_ipk_int
@ -124,10 +131,15 @@ module psb_const_mod
!
! Handy & miscellaneous constants
!
integer(psb_epk_), parameter :: ezero=0, eone=1
integer(psb_epk_), parameter :: etwo=2, ethree=3,emone=-1
integer(psb_mpk_), parameter :: mzero=0, mone=1
integer(psb_mpk_), parameter :: mtwo=2, mthree=3,mmone=-1
integer(psb_lpk_), parameter :: lzero=0, lone=1
integer(psb_lpk_), parameter :: ltwo=2, lthree=3,lmone=-1
integer(psb_ipk_), parameter :: izero=0, ione=1
integer(psb_ipk_), parameter :: itwo=2, ithree=3,mone=-1
integer(psb_ipk_), parameter :: itwo=2, ithree=3,imone=-1
integer(psb_ipk_), parameter :: psb_root_=0
real(psb_spk_), parameter :: szero=0.0_psb_spk_, sone=1.0_psb_spk_
real(psb_dpk_), parameter :: dzero=0.0_psb_dpk_, done=1.0_psb_dpk_
@ -138,6 +150,8 @@ module psb_const_mod
real(psb_dpk_), parameter :: d_epstol=1.1e-16_psb_dpk_ ! Unit roundoff.
real(psb_spk_), parameter :: s_epstol=5.e-8_psb_spk_ ! Is this right?
character, parameter :: psb_all_='A', psb_topdef_=' '
logical, parameter :: psb_m_is_complex_ = .false.
logical, parameter :: psb_e_is_complex_ = .false.
logical, parameter :: psb_i_is_complex_ = .false.
logical, parameter :: psb_l_is_complex_ = .false.
logical, parameter :: psb_s_is_complex_ = .false.

3774
base/modules/psb_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

109
base/modules/psi_comm_buffers_mod.F90
Unescape Escape View File

@ -65,6 +65,7 @@ module psi_comm_buffers_mod
integer(psb_mpk_), parameter:: psb_int8_tag = psb_char_tag + 1
integer(psb_mpk_), parameter:: psb_int2_tag = psb_int8_tag + 1
integer(psb_mpk_), parameter:: psb_int4_tag = psb_int2_tag + 1
integer(psb_mpk_), parameter:: psb_long_tag = psb_int4_tag + 1
integer(psb_mpk_), parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag
@ -76,6 +77,7 @@ module psi_comm_buffers_mod
integer(psb_mpk_), parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_int4_swap_tag = psb_int4_tag + psb_int_tag
integer(psb_mpk_), parameter:: psb_long_swap_tag = psb_long_tag + psb_int_tag
@ -89,22 +91,23 @@ module psi_comm_buffers_mod
integer(psb_mpk_), private, parameter:: psb_int8_type = psb_char_type + 1
integer(psb_mpk_), private, parameter:: psb_int2_type = psb_int8_type + 1
integer(psb_mpk_), private, parameter:: psb_int4_type = psb_int2_type + 1
integer(psb_mpk_), private, parameter:: psb_long_type = psb_int4_type + 1
type psb_buffer_node
integer(psb_mpk_) :: request
integer(psb_mpk_) :: icontxt
integer(psb_mpk_) :: buffer_type
integer(psb_ipk_), allocatable :: intbuf(:)
integer(psb_epk_), allocatable :: int8buf(:)
integer(2), allocatable :: int2buf(:)
integer(psb_mpk_), allocatable :: int4buf(:)
real(psb_spk_), allocatable :: realbuf(:)
real(psb_dpk_), allocatable :: doublebuf(:)
complex(psb_spk_), allocatable :: complexbuf(:)
complex(psb_dpk_), allocatable :: dcomplbuf(:)
logical, allocatable :: logbuf(:)
character(len=1), allocatable :: charbuf(:)
integer(psb_ipk_), allocatable :: intbuf(:)
integer(psb_epk_), allocatable :: int8buf(:)
integer(psb_i2pk_), allocatable :: int2buf(:)
integer(psb_mpk_), allocatable :: int4buf(:)
real(psb_spk_), allocatable :: realbuf(:)
real(psb_dpk_), allocatable :: doublebuf(:)
complex(psb_spk_), allocatable :: complexbuf(:)
complex(psb_dpk_), allocatable :: dcomplbuf(:)
logical, allocatable :: logbuf(:)
character(len=1), allocatable :: charbuf(:)
type(psb_buffer_node), pointer :: prev=>null(), next=>null()
end type psb_buffer_node
@ -114,29 +117,14 @@ module psi_comm_buffers_mod
interface psi_snd
module procedure psi_isnd,&
module procedure&
& psi_msnd, psi_esnd,&
& psi_ssnd, psi_dsnd,&
& psi_csnd, psi_zsnd,&
& psi_lsnd, psi_hsnd
& psi_logsnd, psi_hsnd,&
& psi_i2snd
end interface
#if defined(LONG_INTEGERS)
interface psi_snd
module procedure psi_i4snd
end interface
#endif
#if !defined(LONG_INTEGERS)
interface psi_snd
module procedure psi_i8snd
end interface
#endif
#if defined(SHORT_INTEGERS)
interface psi_snd
module procedure psi_i2snd
end interface
#endif
contains
subroutine psb_init_queue(mesg_queue,info)
@ -297,7 +285,7 @@ contains
! has already been copied.
!
! !!!!!!!!!!!!!!!!!
subroutine psi_isnd(icontxt,tag,dest,buffer,mesg_queue)
subroutine psi_msnd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
use mpi
#endif
@ -306,7 +294,7 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_) :: icontxt, tag, dest
integer(psb_ipk_), allocatable, intent(inout) :: buffer(:)
integer(psb_mpk_), allocatable, intent(inout) :: buffer(:)
type(psb_buffer_queue) :: mesg_queue
type(psb_buffer_node), pointer :: node
integer(psb_ipk_) :: info
@ -324,55 +312,17 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_ipk_int,&
call mpi_isend(node%intbuf,size(node%intbuf),psb_mpi_mpk_int,&
& dest,tag,icontxt,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
call psb_test_nodes(mesg_queue)
end subroutine psi_isnd
#if defined(LONG_INTEGERS)
subroutine psi_i4snd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_mpk_) :: icontxt, tag, dest
integer(psb_mpk_), allocatable, intent(inout) :: buffer(:)
type(psb_buffer_queue) :: mesg_queue
type(psb_buffer_node), pointer :: node
integer(psb_mpk_) :: info
integer(psb_mpk_) :: minfo
allocate(node, stat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_int4_type
call move_alloc(buffer,node%int4buf)
if (info /= 0) then
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_int,&
& dest,tag,icontxt,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
call psb_test_nodes(mesg_queue)
end subroutine psi_msnd
end subroutine psi_i4snd
#endif
#if !defined(LONG_INTEGERS)
subroutine psi_i8snd(icontxt,tag,dest,buffer,mesg_queue)
subroutine psi_esnd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
use mpi
#endif
@ -399,17 +349,15 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_lpk_int,&
call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_int,&
& dest,tag,icontxt,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
call psb_test_nodes(mesg_queue)
end subroutine psi_i8snd
#endif
end subroutine psi_esnd
#if defined(SHORT_INTEGERS)
subroutine psi_i2snd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
use mpi
@ -419,7 +367,7 @@ contains
include 'mpif.h'
#endif
integer(psb_mpk_) :: icontxt, tag, dest
integer(2), allocatable, intent(inout) :: buffer(:)
integer(psb_i2pk_), allocatable, intent(inout) :: buffer(:)
type(psb_buffer_queue) :: mesg_queue
type(psb_buffer_node), pointer :: node
integer(psb_ipk_) :: info
@ -437,7 +385,7 @@ contains
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_mpk_int2,&
call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_int,&
& dest,tag,icontxt,node%request,minfo)
info = minfo
call psb_insert_node(mesg_queue,node)
@ -445,7 +393,6 @@ contains
call psb_test_nodes(mesg_queue)
end subroutine psi_i2snd
#endif
subroutine psi_ssnd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
@ -592,7 +539,7 @@ contains
end subroutine psi_zsnd
subroutine psi_lsnd(icontxt,tag,dest,buffer,mesg_queue)
subroutine psi_logsnd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
use mpi
#endif
@ -626,7 +573,7 @@ contains
call psb_test_nodes(mesg_queue)
end subroutine psi_lsnd
end subroutine psi_logsnd
subroutine psi_hsnd(icontxt,tag,dest,buffer,mesg_queue)

2
base/modules/psi_p2p_mod.F90
Unescape Escape View File

@ -108,7 +108,7 @@ module psi_p2p_mod
end interface
#endif
w
contains

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

@ -158,14 +158,16 @@ contains
#if defined(INT_I4_L4)
psb_mpi_ipk_int = mpi_integer
psb_mpi_lpk_int = mpi_integer
#elsif defined(INT_I4_L8)
#elif defined(INT_I4_L8)
psb_mpi_ipk_int = mpi_integer
psb_mpi_lpk_int = mpi_integer8
#elsif defined(INT_I8_L8)
#elif defined(INT_I8_L8)
psb_mpi_ipk_int = mpi_integer8
psb_mpi_lpk_int = mpi_integer8
#else
! This should never happen
write(psb_err_unit,*) 'Warning: an impossible IPK/LPK combination.'
write(psb_err_unit,*) 'Something went wrong at configuration time.'
psb_mpi_ipk_int = -1
psb_mpi_lpk_int = -1
#endif

69
base/modules/serial/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -69,8 +69,9 @@ module psb_c_base_vect_mod
! Constructors/allocators
!
procedure, pass(x) :: bld_x => c_base_bld_x
procedure, pass(x) :: bld_n => c_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => c_base_bld_mn
procedure, pass(x) :: bld_en => c_base_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: all => c_base_all
procedure, pass(x) :: mold => c_base_mold
!
@ -82,7 +83,9 @@ module psb_c_base_vect_mod
procedure, pass(x) :: ins_v => c_base_ins_v
generic, public :: ins => ins_a, ins_v
procedure, pass(x) :: zero => c_base_zero
procedure, pass(x) :: asb => c_base_asb
procedure, pass(x) :: asb_m => c_base_asb_m
procedure, pass(x) :: asb_e => c_base_asb_e
generic, public :: asb => asb_m, asb_e
procedure, pass(x) :: free => c_base_free
!
! Sync: centerpiece of handling of external storage.
@ -239,21 +242,37 @@ contains
! Create with size, but no initialization
!
!> Function bld_n:
!> Function bld_mn:
!! \memberof psb_c_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine c_base_bld_n(x,n)
subroutine c_base_bld_mn(x,n)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine c_base_bld_mn
!> Function bld_en:
!! \memberof psb_c_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine c_base_bld_en(x,n)
use psb_realloc_mod
integer(psb_epk_), intent(in) :: n
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine c_base_bld_n
end subroutine c_base_bld_en
!> Function base_all:
!! \memberof psb_c_base_vect_type
@ -435,11 +454,41 @@ contains
!!
!
subroutine c_base_asb(n, x, info)
subroutine c_base_asb_m(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine c_base_asb_m
!
! Assembly.
! For derived classes: after this the vector
! storage is supposed to be in sync.
!
!> Function base_asb:
!! \memberof psb_c_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine c_base_asb_e(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_epk_), intent(in) :: n
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@ -449,7 +498,7 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine c_base_asb
end subroutine c_base_asb_e
!
!> Function base_free:

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

@ -62,8 +62,9 @@ module psb_c_vect_mod
procedure, pass(x) :: ins_v => c_vect_ins_v
generic, public :: ins => ins_v, ins_a
procedure, pass(x) :: bld_x => c_vect_bld_x
procedure, pass(x) :: bld_n => c_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => c_vect_bld_mn
procedure, pass(x) :: bld_en => c_vect_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: get_vect => c_vect_get_vect
procedure, pass(x) :: cnv => c_vect_cnv
procedure, pass(x) :: set_scal => c_vect_set_scal
@ -112,7 +113,8 @@ module psb_c_vect_mod
& c_vect_all, c_vect_reall, c_vect_zero, c_vect_asb, &
& c_vect_gthab, c_vect_gthzv, c_vect_sctb, &
& c_vect_free, c_vect_ins_a, c_vect_ins_v, c_vect_bld_x, &
& c_vect_bld_n, c_vect_get_vect, c_vect_cnv, c_vect_set_scal, &
& c_vect_bld_mn, c_vect_bld_en, c_vect_get_vect, &
& c_vect_cnv, c_vect_set_scal, &
& c_vect_set_vect, c_vect_clone, c_vect_sync, c_vect_is_host, &
& c_vect_is_dev, c_vect_is_sync, c_vect_set_host, &
& c_vect_set_dev, c_vect_set_sync
@ -216,8 +218,8 @@ contains
end subroutine c_vect_bld_x
subroutine c_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n
subroutine c_vect_bld_mn(x,n,mold)
integer(psb_mpk_), intent(in) :: n
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
@ -243,7 +245,37 @@ contains
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine c_vect_bld_n
end subroutine c_vect_bld_mn
subroutine c_vect_bld_en(x,n,mold)
integer(psb_epk_), intent(in) :: n
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
class(psb_c_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_c_get_base_vect_default())
#else
mld = psb_c_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine c_vect_bld_en
function c_vect_get_vect(x) result(res)
class(psb_c_vect_type), intent(inout) :: x

69
base/modules/serial/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -69,8 +69,9 @@ module psb_d_base_vect_mod
! Constructors/allocators
!
procedure, pass(x) :: bld_x => d_base_bld_x
procedure, pass(x) :: bld_n => d_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => d_base_bld_mn
procedure, pass(x) :: bld_en => d_base_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: all => d_base_all
procedure, pass(x) :: mold => d_base_mold
!
@ -82,7 +83,9 @@ module psb_d_base_vect_mod
procedure, pass(x) :: ins_v => d_base_ins_v
generic, public :: ins => ins_a, ins_v
procedure, pass(x) :: zero => d_base_zero
procedure, pass(x) :: asb => d_base_asb
procedure, pass(x) :: asb_m => d_base_asb_m
procedure, pass(x) :: asb_e => d_base_asb_e
generic, public :: asb => asb_m, asb_e
procedure, pass(x) :: free => d_base_free
!
! Sync: centerpiece of handling of external storage.
@ -239,21 +242,37 @@ contains
! Create with size, but no initialization
!
!> Function bld_n:
!> Function bld_mn:
!! \memberof psb_d_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine d_base_bld_n(x,n)
subroutine d_base_bld_mn(x,n)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine d_base_bld_mn
!> Function bld_en:
!! \memberof psb_d_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine d_base_bld_en(x,n)
use psb_realloc_mod
integer(psb_epk_), intent(in) :: n
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine d_base_bld_n
end subroutine d_base_bld_en
!> Function base_all:
!! \memberof psb_d_base_vect_type
@ -435,11 +454,41 @@ contains
!!
!
subroutine d_base_asb(n, x, info)
subroutine d_base_asb_m(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine d_base_asb_m
!
! Assembly.
! For derived classes: after this the vector
! storage is supposed to be in sync.
!
!> Function base_asb:
!! \memberof psb_d_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine d_base_asb_e(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_epk_), intent(in) :: n
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@ -449,7 +498,7 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine d_base_asb
end subroutine d_base_asb_e
!
!> Function base_free:

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

@ -62,8 +62,9 @@ module psb_d_vect_mod
procedure, pass(x) :: ins_v => d_vect_ins_v
generic, public :: ins => ins_v, ins_a
procedure, pass(x) :: bld_x => d_vect_bld_x
procedure, pass(x) :: bld_n => d_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => d_vect_bld_mn
procedure, pass(x) :: bld_en => d_vect_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: get_vect => d_vect_get_vect
procedure, pass(x) :: cnv => d_vect_cnv
procedure, pass(x) :: set_scal => d_vect_set_scal
@ -112,7 +113,8 @@ module psb_d_vect_mod
& d_vect_all, d_vect_reall, d_vect_zero, d_vect_asb, &
& d_vect_gthab, d_vect_gthzv, d_vect_sctb, &
& d_vect_free, d_vect_ins_a, d_vect_ins_v, d_vect_bld_x, &
& d_vect_bld_n, d_vect_get_vect, d_vect_cnv, d_vect_set_scal, &
& d_vect_bld_mn, d_vect_bld_en, d_vect_get_vect, &
& d_vect_cnv, d_vect_set_scal, &
& d_vect_set_vect, d_vect_clone, d_vect_sync, d_vect_is_host, &
& d_vect_is_dev, d_vect_is_sync, d_vect_set_host, &
& d_vect_set_dev, d_vect_set_sync
@ -216,8 +218,8 @@ contains
end subroutine d_vect_bld_x
subroutine d_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n
subroutine d_vect_bld_mn(x,n,mold)
integer(psb_mpk_), intent(in) :: n
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
@ -243,7 +245,37 @@ contains
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine d_vect_bld_n
end subroutine d_vect_bld_mn
subroutine d_vect_bld_en(x,n,mold)
integer(psb_epk_), intent(in) :: n
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
class(psb_d_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_d_get_base_vect_default())
#else
mld = psb_d_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine d_vect_bld_en
function d_vect_get_vect(x) result(res)
class(psb_d_vect_type), intent(inout) :: x

69
base/modules/serial/psb_i_base_vect_mod.f90
Unescape Escape View File

@ -68,8 +68,9 @@ module psb_i_base_vect_mod
! Constructors/allocators
!
procedure, pass(x) :: bld_x => i_base_bld_x
procedure, pass(x) :: bld_n => i_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => i_base_bld_mn
procedure, pass(x) :: bld_en => i_base_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: all => i_base_all
procedure, pass(x) :: mold => i_base_mold
!
@ -81,7 +82,9 @@ module psb_i_base_vect_mod
procedure, pass(x) :: ins_v => i_base_ins_v
generic, public :: ins => ins_a, ins_v
procedure, pass(x) :: zero => i_base_zero
procedure, pass(x) :: asb => i_base_asb
procedure, pass(x) :: asb_m => i_base_asb_m
procedure, pass(x) :: asb_e => i_base_asb_e
generic, public :: asb => asb_m, asb_e
procedure, pass(x) :: free => i_base_free
!
! Sync: centerpiece of handling of external storage.
@ -208,21 +211,37 @@ contains
! Create with size, but no initialization
!
!> Function bld_n:
!> Function bld_mn:
!! \memberof psb_i_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine i_base_bld_n(x,n)
subroutine i_base_bld_mn(x,n)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine i_base_bld_mn
!> Function bld_en:
!! \memberof psb_i_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine i_base_bld_en(x,n)
use psb_realloc_mod
integer(psb_epk_), intent(in) :: n
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine i_base_bld_n
end subroutine i_base_bld_en
!> Function base_all:
!! \memberof psb_i_base_vect_type
@ -404,11 +423,41 @@ contains
!!
!
subroutine i_base_asb(n, x, info)
subroutine i_base_asb_m(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine i_base_asb_m
!
! Assembly.
! For derived classes: after this the vector
! storage is supposed to be in sync.
!
!> Function base_asb:
!! \memberof psb_i_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine i_base_asb_e(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_epk_), intent(in) :: n
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@ -418,7 +467,7 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine i_base_asb
end subroutine i_base_asb_e
!
!> Function base_free:

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

@ -61,8 +61,9 @@ module psb_i_vect_mod
procedure, pass(x) :: ins_v => i_vect_ins_v
generic, public :: ins => ins_v, ins_a
procedure, pass(x) :: bld_x => i_vect_bld_x
procedure, pass(x) :: bld_n => i_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => i_vect_bld_mn
procedure, pass(x) :: bld_en => i_vect_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: get_vect => i_vect_get_vect
procedure, pass(x) :: cnv => i_vect_cnv
procedure, pass(x) :: set_scal => i_vect_set_scal
@ -90,7 +91,8 @@ module psb_i_vect_mod
& i_vect_all, i_vect_reall, i_vect_zero, i_vect_asb, &
& i_vect_gthab, i_vect_gthzv, i_vect_sctb, &
& i_vect_free, i_vect_ins_a, i_vect_ins_v, i_vect_bld_x, &
& i_vect_bld_n, i_vect_get_vect, i_vect_cnv, i_vect_set_scal, &
& i_vect_bld_mn, i_vect_bld_en, i_vect_get_vect, &
& i_vect_cnv, i_vect_set_scal, &
& i_vect_set_vect, i_vect_clone, i_vect_sync, i_vect_is_host, &
& i_vect_is_dev, i_vect_is_sync, i_vect_set_host, &
& i_vect_set_dev, i_vect_set_sync
@ -189,8 +191,8 @@ contains
end subroutine i_vect_bld_x
subroutine i_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n
subroutine i_vect_bld_mn(x,n,mold)
integer(psb_mpk_), intent(in) :: n
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
@ -216,7 +218,37 @@ contains
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine i_vect_bld_n
end subroutine i_vect_bld_mn
subroutine i_vect_bld_en(x,n,mold)
integer(psb_epk_), intent(in) :: n
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
class(psb_i_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_i_get_base_vect_default())
#else
mld = psb_i_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine i_vect_bld_en
function i_vect_get_vect(x) result(res)
class(psb_i_vect_type), intent(inout) :: x

69
base/modules/serial/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -69,8 +69,9 @@ module psb_s_base_vect_mod
! Constructors/allocators
!
procedure, pass(x) :: bld_x => s_base_bld_x
procedure, pass(x) :: bld_n => s_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => s_base_bld_mn
procedure, pass(x) :: bld_en => s_base_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: all => s_base_all
procedure, pass(x) :: mold => s_base_mold
!
@ -82,7 +83,9 @@ module psb_s_base_vect_mod
procedure, pass(x) :: ins_v => s_base_ins_v
generic, public :: ins => ins_a, ins_v
procedure, pass(x) :: zero => s_base_zero
procedure, pass(x) :: asb => s_base_asb
procedure, pass(x) :: asb_m => s_base_asb_m
procedure, pass(x) :: asb_e => s_base_asb_e
generic, public :: asb => asb_m, asb_e
procedure, pass(x) :: free => s_base_free
!
! Sync: centerpiece of handling of external storage.
@ -239,21 +242,37 @@ contains
! Create with size, but no initialization
!
!> Function bld_n:
!> Function bld_mn:
!! \memberof psb_s_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine s_base_bld_n(x,n)
subroutine s_base_bld_mn(x,n)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine s_base_bld_mn
!> Function bld_en:
!! \memberof psb_s_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine s_base_bld_en(x,n)
use psb_realloc_mod
integer(psb_epk_), intent(in) :: n
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine s_base_bld_n
end subroutine s_base_bld_en
!> Function base_all:
!! \memberof psb_s_base_vect_type
@ -435,11 +454,41 @@ contains
!!
!
subroutine s_base_asb(n, x, info)
subroutine s_base_asb_m(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine s_base_asb_m
!
! Assembly.
! For derived classes: after this the vector
! storage is supposed to be in sync.
!
!> Function base_asb:
!! \memberof psb_s_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine s_base_asb_e(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_epk_), intent(in) :: n
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@ -449,7 +498,7 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine s_base_asb
end subroutine s_base_asb_e
!
!> Function base_free:

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

@ -62,8 +62,9 @@ module psb_s_vect_mod
procedure, pass(x) :: ins_v => s_vect_ins_v
generic, public :: ins => ins_v, ins_a
procedure, pass(x) :: bld_x => s_vect_bld_x
procedure, pass(x) :: bld_n => s_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => s_vect_bld_mn
procedure, pass(x) :: bld_en => s_vect_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: get_vect => s_vect_get_vect
procedure, pass(x) :: cnv => s_vect_cnv
procedure, pass(x) :: set_scal => s_vect_set_scal
@ -112,7 +113,8 @@ module psb_s_vect_mod
& s_vect_all, s_vect_reall, s_vect_zero, s_vect_asb, &
& s_vect_gthab, s_vect_gthzv, s_vect_sctb, &
& s_vect_free, s_vect_ins_a, s_vect_ins_v, s_vect_bld_x, &
& s_vect_bld_n, s_vect_get_vect, s_vect_cnv, s_vect_set_scal, &
& s_vect_bld_mn, s_vect_bld_en, s_vect_get_vect, &
& s_vect_cnv, s_vect_set_scal, &
& s_vect_set_vect, s_vect_clone, s_vect_sync, s_vect_is_host, &
& s_vect_is_dev, s_vect_is_sync, s_vect_set_host, &
& s_vect_set_dev, s_vect_set_sync
@ -216,8 +218,8 @@ contains
end subroutine s_vect_bld_x
subroutine s_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n
subroutine s_vect_bld_mn(x,n,mold)
integer(psb_mpk_), intent(in) :: n
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
@ -243,7 +245,37 @@ contains
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine s_vect_bld_n
end subroutine s_vect_bld_mn
subroutine s_vect_bld_en(x,n,mold)
integer(psb_epk_), intent(in) :: n
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
class(psb_s_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_s_get_base_vect_default())
#else
mld = psb_s_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine s_vect_bld_en
function s_vect_get_vect(x) result(res)
class(psb_s_vect_type), intent(inout) :: x

69
base/modules/serial/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -69,8 +69,9 @@ module psb_z_base_vect_mod
! Constructors/allocators
!
procedure, pass(x) :: bld_x => z_base_bld_x
procedure, pass(x) :: bld_n => z_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => z_base_bld_mn
procedure, pass(x) :: bld_en => z_base_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: all => z_base_all
procedure, pass(x) :: mold => z_base_mold
!
@ -82,7 +83,9 @@ module psb_z_base_vect_mod
procedure, pass(x) :: ins_v => z_base_ins_v
generic, public :: ins => ins_a, ins_v
procedure, pass(x) :: zero => z_base_zero
procedure, pass(x) :: asb => z_base_asb
procedure, pass(x) :: asb_m => z_base_asb_m
procedure, pass(x) :: asb_e => z_base_asb_e
generic, public :: asb => asb_m, asb_e
procedure, pass(x) :: free => z_base_free
!
! Sync: centerpiece of handling of external storage.
@ -239,21 +242,37 @@ contains
! Create with size, but no initialization
!
!> Function bld_n:
!> Function bld_mn:
!! \memberof psb_z_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine z_base_bld_n(x,n)
subroutine z_base_bld_mn(x,n)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine z_base_bld_mn
!> Function bld_en:
!! \memberof psb_z_base_vect_type
!! \brief Build method with size (uninitialized data)
!! \param n size to be allocated.
!!
subroutine z_base_bld_en(x,n)
use psb_realloc_mod
integer(psb_epk_), intent(in) :: n
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine z_base_bld_n
end subroutine z_base_bld_en
!> Function base_all:
!! \memberof psb_z_base_vect_type
@ -435,11 +454,41 @@ contains
!!
!
subroutine z_base_asb(n, x, info)
subroutine z_base_asb_m(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_), intent(in) :: n
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine z_base_asb_m
!
! Assembly.
! For derived classes: after this the vector
! storage is supposed to be in sync.
!
!> Function base_asb:
!! \memberof psb_z_base_vect_type
!! \brief Assemble vector: reallocate as necessary.
!!
!! \param n final size
!! \param info return code
!!
!
subroutine z_base_asb_e(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_epk_), intent(in) :: n
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
@ -449,7 +498,7 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
call x%sync()
end subroutine z_base_asb
end subroutine z_base_asb_e
!
!> Function base_free:

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

@ -62,8 +62,9 @@ module psb_z_vect_mod
procedure, pass(x) :: ins_v => z_vect_ins_v
generic, public :: ins => ins_v, ins_a
procedure, pass(x) :: bld_x => z_vect_bld_x
procedure, pass(x) :: bld_n => z_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: bld_mn => z_vect_bld_mn
procedure, pass(x) :: bld_en => z_vect_bld_en
generic, public :: bld => bld_x, bld_mn, bld_en
procedure, pass(x) :: get_vect => z_vect_get_vect
procedure, pass(x) :: cnv => z_vect_cnv
procedure, pass(x) :: set_scal => z_vect_set_scal
@ -112,7 +113,8 @@ module psb_z_vect_mod
& z_vect_all, z_vect_reall, z_vect_zero, z_vect_asb, &
& z_vect_gthab, z_vect_gthzv, z_vect_sctb, &
& z_vect_free, z_vect_ins_a, z_vect_ins_v, z_vect_bld_x, &
& z_vect_bld_n, z_vect_get_vect, z_vect_cnv, z_vect_set_scal, &
& z_vect_bld_mn, z_vect_bld_en, z_vect_get_vect, &
& z_vect_cnv, z_vect_set_scal, &
& z_vect_set_vect, z_vect_clone, z_vect_sync, z_vect_is_host, &
& z_vect_is_dev, z_vect_is_sync, z_vect_set_host, &
& z_vect_set_dev, z_vect_set_sync
@ -216,8 +218,8 @@ contains
end subroutine z_vect_bld_x
subroutine z_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n
subroutine z_vect_bld_mn(x,n,mold)
integer(psb_mpk_), intent(in) :: n
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
@ -243,7 +245,37 @@ contains
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine z_vect_bld_n
end subroutine z_vect_bld_mn
subroutine z_vect_bld_en(x,n,mold)
integer(psb_epk_), intent(in) :: n
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
class(psb_z_base_vect_type), pointer :: mld
if (allocated(x%v)) &
& call x%free(info)
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(x%v,stat=info,mold=mold)
#else
call mold%mold(x%v,info)
#endif
else
#ifdef HAVE_MOLD
allocate(x%v,stat=info, mold=psb_z_get_base_vect_default())
#else
mld = psb_z_get_base_vect_default()
call mld%mold(x%v,info)
#endif
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine z_vect_bld_en
function z_vect_get_vect(x) result(res)
class(psb_z_vect_type), intent(inout) :: x

Write Preview
Loading…
Cancel
Save