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

Fixes to vector status and build processing for dealii

Browse Source
pull/31/head
sfilippone 5 months ago
parent 5333117010
commit c1ca1665e7
18 changed files with 348 additions and 48 deletions
Show Stats Download Patch File Download Diff File

29
base/modules/serial/psb_c_base_vect_mod.F90
Unescape Escape View File

@ -115,6 +115,7 @@ module psb_c_base_vect_mod
procedure, pass(x) :: is_bld => c_base_is_bld
procedure, pass(x) :: is_upd => c_base_is_upd
procedure, pass(x) :: is_asb => c_base_is_asb
procedure, pass(x) :: base_cpy => c_base_cpy
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
@ -686,7 +687,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -700,7 +701,9 @@ contains
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine c_base_asb_m
@ -767,7 +770,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -782,6 +785,8 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine c_base_asb_e
@ -1063,6 +1068,24 @@ contains
res = .true.
end function c_base_is_sync
!> Function base_cpy:
!! \memberof psb_d_base_vect_type
!! \brief base_cpy: copy base contents
!! \param y returned variable
!!
subroutine c_base_cpy(x, y)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(in) :: x
class(psb_c_base_vect_type), intent(out) :: y
if (allocated(x%v)) call y%bld(x%v)
call y%set_state(x%get_state())
call y%set_dupl(x%get_dupl())
call y%set_ncfs(x%get_ncfs())
if (allocated(x%iv)) y%iv = x%iv
end subroutine c_base_cpy
!
! Size info.

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

@ -64,6 +64,8 @@ module psb_c_vect_mod
procedure, pass(x) :: asb => c_vect_asb
procedure, pass(x) :: set_dupl => c_vect_set_dupl
procedure, pass(x) :: get_dupl => c_vect_get_dupl
procedure, pass(x) :: set_ncfs => c_vect_set_ncfs
procedure, pass(x) :: get_ncfs => c_vect_get_ncfs
procedure, pass(x) :: set_state => c_vect_set_state
procedure, pass(x) :: set_null => c_vect_set_null
procedure, pass(x) :: set_bld => c_vect_set_bld
@ -200,9 +202,9 @@ contains
class(psb_c_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_state()
res = x%v%get_dupl()
else
res = psb_vect_null_
res = psb_dupl_null_
end if
end function c_vect_get_dupl
@ -220,6 +222,31 @@ contains
end if
end subroutine c_vect_set_dupl
function c_vect_get_ncfs(x) result(res)
implicit none
class(psb_c_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_ncfs()
else
res = 0
end if
end function c_vect_get_ncfs
subroutine c_vect_set_ncfs(x,val)
implicit none
class(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (allocated(x%v)) then
if (present(val)) then
call x%v%set_ncfs(val)
else
call x%v%set_ncfs(0)
end if
end if
end subroutine c_vect_set_ncfs
function c_vect_get_state(x) result(res)
implicit none
class(psb_c_vect_type), intent(in) :: x
@ -311,7 +338,6 @@ contains
x%nrmv = val
end subroutine c_vect_set_nrmv
function c_vect_is_remote_build(x) result(res)
implicit none
@ -618,6 +644,7 @@ contains
if (allocated(x%v)) then
call x%v%asb(n,info,scratch=scratch)
call x%set_asb()
end if
end subroutine c_vect_asb
@ -732,6 +759,7 @@ contains
if (allocated(x%v%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%base_cpy(tmp)
call x%v%free(info)
endif
end if

29
base/modules/serial/psb_d_base_vect_mod.F90
Unescape Escape View File

@ -115,6 +115,7 @@ module psb_d_base_vect_mod
procedure, pass(x) :: is_bld => d_base_is_bld
procedure, pass(x) :: is_upd => d_base_is_upd
procedure, pass(x) :: is_asb => d_base_is_asb
procedure, pass(x) :: base_cpy => d_base_cpy
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
@ -693,7 +694,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -707,7 +708,9 @@ contains
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine d_base_asb_m
@ -774,7 +777,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -789,6 +792,8 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine d_base_asb_e
@ -1070,6 +1075,24 @@ contains
res = .true.
end function d_base_is_sync
!> Function base_cpy:
!! \memberof psb_d_base_vect_type
!! \brief base_cpy: copy base contents
!! \param y returned variable
!!
subroutine d_base_cpy(x, y)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(in) :: x
class(psb_d_base_vect_type), intent(out) :: y
if (allocated(x%v)) call y%bld(x%v)
call y%set_state(x%get_state())
call y%set_dupl(x%get_dupl())
call y%set_ncfs(x%get_ncfs())
if (allocated(x%iv)) y%iv = x%iv
end subroutine d_base_cpy
!
! Size info.

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

@ -64,6 +64,8 @@ module psb_d_vect_mod
procedure, pass(x) :: asb => d_vect_asb
procedure, pass(x) :: set_dupl => d_vect_set_dupl
procedure, pass(x) :: get_dupl => d_vect_get_dupl
procedure, pass(x) :: set_ncfs => d_vect_set_ncfs
procedure, pass(x) :: get_ncfs => d_vect_get_ncfs
procedure, pass(x) :: set_state => d_vect_set_state
procedure, pass(x) :: set_null => d_vect_set_null
procedure, pass(x) :: set_bld => d_vect_set_bld
@ -207,9 +209,9 @@ contains
class(psb_d_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_state()
res = x%v%get_dupl()
else
res = psb_vect_null_
res = psb_dupl_null_
end if
end function d_vect_get_dupl
@ -227,6 +229,31 @@ contains
end if
end subroutine d_vect_set_dupl
function d_vect_get_ncfs(x) result(res)
implicit none
class(psb_d_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_ncfs()
else
res = 0
end if
end function d_vect_get_ncfs
subroutine d_vect_set_ncfs(x,val)
implicit none
class(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (allocated(x%v)) then
if (present(val)) then
call x%v%set_ncfs(val)
else
call x%v%set_ncfs(0)
end if
end if
end subroutine d_vect_set_ncfs
function d_vect_get_state(x) result(res)
implicit none
class(psb_d_vect_type), intent(in) :: x
@ -318,7 +345,6 @@ contains
x%nrmv = val
end subroutine d_vect_set_nrmv
function d_vect_is_remote_build(x) result(res)
implicit none
@ -625,6 +651,7 @@ contains
if (allocated(x%v)) then
call x%v%asb(n,info,scratch=scratch)
call x%set_asb()
end if
end subroutine d_vect_asb
@ -739,6 +766,7 @@ contains
if (allocated(x%v%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%base_cpy(tmp)
call x%v%free(info)
endif
end if

29
base/modules/serial/psb_i_base_vect_mod.F90
Unescape Escape View File

@ -113,6 +113,7 @@ module psb_i_base_vect_mod
procedure, pass(x) :: is_bld => i_base_is_bld
procedure, pass(x) :: is_upd => i_base_is_upd
procedure, pass(x) :: is_asb => i_base_is_asb
procedure, pass(x) :: base_cpy => i_base_cpy
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
@ -619,7 +620,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -633,7 +634,9 @@ contains
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine i_base_asb_m
@ -700,7 +703,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -715,6 +718,8 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine i_base_asb_e
@ -996,6 +1001,24 @@ contains
res = .true.
end function i_base_is_sync
!> Function base_cpy:
!! \memberof psb_d_base_vect_type
!! \brief base_cpy: copy base contents
!! \param y returned variable
!!
subroutine i_base_cpy(x, y)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(in) :: x
class(psb_i_base_vect_type), intent(out) :: y
if (allocated(x%v)) call y%bld(x%v)
call y%set_state(x%get_state())
call y%set_dupl(x%get_dupl())
call y%set_ncfs(x%get_ncfs())
if (allocated(x%iv)) y%iv = x%iv
end subroutine i_base_cpy
!
! Size info.

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

@ -63,6 +63,8 @@ module psb_i_vect_mod
procedure, pass(x) :: asb => i_vect_asb
procedure, pass(x) :: set_dupl => i_vect_set_dupl
procedure, pass(x) :: get_dupl => i_vect_get_dupl
procedure, pass(x) :: set_ncfs => i_vect_set_ncfs
procedure, pass(x) :: get_ncfs => i_vect_get_ncfs
procedure, pass(x) :: set_state => i_vect_set_state
procedure, pass(x) :: set_null => i_vect_set_null
procedure, pass(x) :: set_bld => i_vect_set_bld
@ -145,9 +147,9 @@ contains
class(psb_i_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_state()
res = x%v%get_dupl()
else
res = psb_vect_null_
res = psb_dupl_null_
end if
end function i_vect_get_dupl
@ -165,6 +167,31 @@ contains
end if
end subroutine i_vect_set_dupl
function i_vect_get_ncfs(x) result(res)
implicit none
class(psb_i_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_ncfs()
else
res = 0
end if
end function i_vect_get_ncfs
subroutine i_vect_set_ncfs(x,val)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (allocated(x%v)) then
if (present(val)) then
call x%v%set_ncfs(val)
else
call x%v%set_ncfs(0)
end if
end if
end subroutine i_vect_set_ncfs
function i_vect_get_state(x) result(res)
implicit none
class(psb_i_vect_type), intent(in) :: x
@ -256,7 +283,6 @@ contains
x%nrmv = val
end subroutine i_vect_set_nrmv
function i_vect_is_remote_build(x) result(res)
implicit none
@ -563,6 +589,7 @@ contains
if (allocated(x%v)) then
call x%v%asb(n,info,scratch=scratch)
call x%set_asb()
end if
end subroutine i_vect_asb
@ -677,6 +704,7 @@ contains
if (allocated(x%v%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%base_cpy(tmp)
call x%v%free(info)
endif
end if

29
base/modules/serial/psb_l_base_vect_mod.F90
Unescape Escape View File

@ -114,6 +114,7 @@ module psb_l_base_vect_mod
procedure, pass(x) :: is_bld => l_base_is_bld
procedure, pass(x) :: is_upd => l_base_is_upd
procedure, pass(x) :: is_asb => l_base_is_asb
procedure, pass(x) :: base_cpy => l_base_cpy
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
@ -620,7 +621,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -634,7 +635,9 @@ contains
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine l_base_asb_m
@ -701,7 +704,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -716,6 +719,8 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine l_base_asb_e
@ -997,6 +1002,24 @@ contains
res = .true.
end function l_base_is_sync
!> Function base_cpy:
!! \memberof psb_d_base_vect_type
!! \brief base_cpy: copy base contents
!! \param y returned variable
!!
subroutine l_base_cpy(x, y)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_l_base_vect_type), intent(in) :: x
class(psb_l_base_vect_type), intent(out) :: y
if (allocated(x%v)) call y%bld(x%v)
call y%set_state(x%get_state())
call y%set_dupl(x%get_dupl())
call y%set_ncfs(x%get_ncfs())
if (allocated(x%iv)) y%iv = x%iv
end subroutine l_base_cpy
!
! Size info.

34
base/modules/serial/psb_l_vect_mod.F90
Unescape Escape View File

@ -64,6 +64,8 @@ module psb_l_vect_mod
procedure, pass(x) :: asb => l_vect_asb
procedure, pass(x) :: set_dupl => l_vect_set_dupl
procedure, pass(x) :: get_dupl => l_vect_get_dupl
procedure, pass(x) :: set_ncfs => l_vect_set_ncfs
procedure, pass(x) :: get_ncfs => l_vect_get_ncfs
procedure, pass(x) :: set_state => l_vect_set_state
procedure, pass(x) :: set_null => l_vect_set_null
procedure, pass(x) :: set_bld => l_vect_set_bld
@ -146,9 +148,9 @@ contains
class(psb_l_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_state()
res = x%v%get_dupl()
else
res = psb_vect_null_
res = psb_dupl_null_
end if
end function l_vect_get_dupl
@ -166,6 +168,31 @@ contains
end if
end subroutine l_vect_set_dupl
function l_vect_get_ncfs(x) result(res)
implicit none
class(psb_l_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_ncfs()
else
res = 0
end if
end function l_vect_get_ncfs
subroutine l_vect_set_ncfs(x,val)
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (allocated(x%v)) then
if (present(val)) then
call x%v%set_ncfs(val)
else
call x%v%set_ncfs(0)
end if
end if
end subroutine l_vect_set_ncfs
function l_vect_get_state(x) result(res)
implicit none
class(psb_l_vect_type), intent(in) :: x
@ -257,7 +284,6 @@ contains
x%nrmv = val
end subroutine l_vect_set_nrmv
function l_vect_is_remote_build(x) result(res)
implicit none
@ -564,6 +590,7 @@ contains
if (allocated(x%v)) then
call x%v%asb(n,info,scratch=scratch)
call x%set_asb()
end if
end subroutine l_vect_asb
@ -678,6 +705,7 @@ contains
if (allocated(x%v%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%base_cpy(tmp)
call x%v%free(info)
endif
end if

29
base/modules/serial/psb_s_base_vect_mod.F90
Unescape Escape View File

@ -115,6 +115,7 @@ module psb_s_base_vect_mod
procedure, pass(x) :: is_bld => s_base_is_bld
procedure, pass(x) :: is_upd => s_base_is_upd
procedure, pass(x) :: is_asb => s_base_is_asb
procedure, pass(x) :: base_cpy => s_base_cpy
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
@ -693,7 +694,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -707,7 +708,9 @@ contains
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine s_base_asb_m
@ -774,7 +777,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -789,6 +792,8 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine s_base_asb_e
@ -1070,6 +1075,24 @@ contains
res = .true.
end function s_base_is_sync
!> Function base_cpy:
!! \memberof psb_d_base_vect_type
!! \brief base_cpy: copy base contents
!! \param y returned variable
!!
subroutine s_base_cpy(x, y)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(in) :: x
class(psb_s_base_vect_type), intent(out) :: y
if (allocated(x%v)) call y%bld(x%v)
call y%set_state(x%get_state())
call y%set_dupl(x%get_dupl())
call y%set_ncfs(x%get_ncfs())
if (allocated(x%iv)) y%iv = x%iv
end subroutine s_base_cpy
!
! Size info.

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

@ -64,6 +64,8 @@ module psb_s_vect_mod
procedure, pass(x) :: asb => s_vect_asb
procedure, pass(x) :: set_dupl => s_vect_set_dupl
procedure, pass(x) :: get_dupl => s_vect_get_dupl
procedure, pass(x) :: set_ncfs => s_vect_set_ncfs
procedure, pass(x) :: get_ncfs => s_vect_get_ncfs
procedure, pass(x) :: set_state => s_vect_set_state
procedure, pass(x) :: set_null => s_vect_set_null
procedure, pass(x) :: set_bld => s_vect_set_bld
@ -207,9 +209,9 @@ contains
class(psb_s_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_state()
res = x%v%get_dupl()
else
res = psb_vect_null_
res = psb_dupl_null_
end if
end function s_vect_get_dupl
@ -227,6 +229,31 @@ contains
end if
end subroutine s_vect_set_dupl
function s_vect_get_ncfs(x) result(res)
implicit none
class(psb_s_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_ncfs()
else
res = 0
end if
end function s_vect_get_ncfs
subroutine s_vect_set_ncfs(x,val)
implicit none
class(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (allocated(x%v)) then
if (present(val)) then
call x%v%set_ncfs(val)
else
call x%v%set_ncfs(0)
end if
end if
end subroutine s_vect_set_ncfs
function s_vect_get_state(x) result(res)
implicit none
class(psb_s_vect_type), intent(in) :: x
@ -318,7 +345,6 @@ contains
x%nrmv = val
end subroutine s_vect_set_nrmv
function s_vect_is_remote_build(x) result(res)
implicit none
@ -625,6 +651,7 @@ contains
if (allocated(x%v)) then
call x%v%asb(n,info,scratch=scratch)
call x%set_asb()
end if
end subroutine s_vect_asb
@ -739,6 +766,7 @@ contains
if (allocated(x%v%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%base_cpy(tmp)
call x%v%free(info)
endif
end if

29
base/modules/serial/psb_z_base_vect_mod.F90
Unescape Escape View File

@ -115,6 +115,7 @@ module psb_z_base_vect_mod
procedure, pass(x) :: is_bld => z_base_is_bld
procedure, pass(x) :: is_upd => z_base_is_upd
procedure, pass(x) :: is_asb => z_base_is_asb
procedure, pass(x) :: base_cpy => z_base_cpy
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
@ -686,7 +687,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -700,7 +701,9 @@ contains
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine z_base_asb_m
@ -767,7 +770,7 @@ contains
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.scratch_) then
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
@ -782,6 +785,8 @@ contains
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end if
call x%set_host()
call x%set_asb()
call x%sync()
end subroutine z_base_asb_e
@ -1063,6 +1068,24 @@ contains
res = .true.
end function z_base_is_sync
!> Function base_cpy:
!! \memberof psb_d_base_vect_type
!! \brief base_cpy: copy base contents
!! \param y returned variable
!!
subroutine z_base_cpy(x, y)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(in) :: x
class(psb_z_base_vect_type), intent(out) :: y
if (allocated(x%v)) call y%bld(x%v)
call y%set_state(x%get_state())
call y%set_dupl(x%get_dupl())
call y%set_ncfs(x%get_ncfs())
if (allocated(x%iv)) y%iv = x%iv
end subroutine z_base_cpy
!
! Size info.

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

@ -64,6 +64,8 @@ module psb_z_vect_mod
procedure, pass(x) :: asb => z_vect_asb
procedure, pass(x) :: set_dupl => z_vect_set_dupl
procedure, pass(x) :: get_dupl => z_vect_get_dupl
procedure, pass(x) :: set_ncfs => z_vect_set_ncfs
procedure, pass(x) :: get_ncfs => z_vect_get_ncfs
procedure, pass(x) :: set_state => z_vect_set_state
procedure, pass(x) :: set_null => z_vect_set_null
procedure, pass(x) :: set_bld => z_vect_set_bld
@ -200,9 +202,9 @@ contains
class(psb_z_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_state()
res = x%v%get_dupl()
else
res = psb_vect_null_
res = psb_dupl_null_
end if
end function z_vect_get_dupl
@ -220,6 +222,31 @@ contains
end if
end subroutine z_vect_set_dupl
function z_vect_get_ncfs(x) result(res)
implicit none
class(psb_z_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%get_ncfs()
else
res = 0
end if
end function z_vect_get_ncfs
subroutine z_vect_set_ncfs(x,val)
implicit none
class(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in), optional :: val
if (allocated(x%v)) then
if (present(val)) then
call x%v%set_ncfs(val)
else
call x%v%set_ncfs(0)
end if
end if
end subroutine z_vect_set_ncfs
function z_vect_get_state(x) result(res)
implicit none
class(psb_z_vect_type), intent(in) :: x
@ -311,7 +338,6 @@ contains
x%nrmv = val
end subroutine z_vect_set_nrmv
function z_vect_is_remote_build(x) result(res)
implicit none
@ -618,6 +644,7 @@ contains
if (allocated(x%v)) then
call x%v%asb(n,info,scratch=scratch)
call x%set_asb()
end if
end subroutine z_vect_asb
@ -732,6 +759,7 @@ contains
if (allocated(x%v%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%base_cpy(tmp)
call x%v%free(info)
endif
end if

3
base/tools/psb_callc.f90
Unescape Escape View File

@ -95,8 +95,7 @@ subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode)
goto 9999
endif
allocate(psb_c_base_vect_type :: x%v, stat=info)
if (info == 0) call x%all(nr,info)
call x%all(nr,info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')

3
base/tools/psb_dallc.f90
Unescape Escape View File

@ -95,8 +95,7 @@ subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
goto 9999
endif
allocate(psb_d_base_vect_type :: x%v, stat=info)
if (info == 0) call x%all(nr,info)
call x%all(nr,info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')

3
base/tools/psb_iallc.f90
Unescape Escape View File

@ -95,8 +95,7 @@ subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode)
goto 9999
endif
allocate(psb_i_base_vect_type :: x%v, stat=info)
if (info == 0) call x%all(nr,info)
call x%all(nr,info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')

3
base/tools/psb_lallc.f90
Unescape Escape View File

@ -95,8 +95,7 @@ subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode)
goto 9999
endif
allocate(psb_l_base_vect_type :: x%v, stat=info)
if (info == 0) call x%all(nr,info)
call x%all(nr,info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')

3
base/tools/psb_sallc.f90
Unescape Escape View File

@ -95,8 +95,7 @@ subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode)
goto 9999
endif
allocate(psb_s_base_vect_type :: x%v, stat=info)
if (info == 0) call x%all(nr,info)
call x%all(nr,info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')

3
base/tools/psb_zallc.f90
Unescape Escape View File

@ -95,8 +95,7 @@ subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode)
goto 9999
endif
allocate(psb_z_base_vect_type :: x%v, stat=info)
if (info == 0) call x%all(nr,info)
call x%all(nr,info)
if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')

Write Preview
Loading…
Cancel
Save