diff --git a/base/modules/psb_base_mat_mod.f90 b/base/modules/psb_base_mat_mod.f90 index e1933acc..409b47c9 100644 --- a/base/modules/psb_base_mat_mod.f90 +++ b/base/modules/psb_base_mat_mod.f90 @@ -140,6 +140,7 @@ module psb_base_mat_mod procedure, pass(a) :: get_state => psb_base_get_state procedure, pass(a) :: get_dupl => psb_base_get_dupl procedure, nopass :: get_fmt => psb_base_get_fmt + procedure, nopass :: has_update => psb_base_has_update procedure, pass(a) :: is_null => psb_base_is_null procedure, pass(a) :: is_bld => psb_base_is_bld procedure, pass(a) :: is_upd => psb_base_is_upd @@ -436,6 +437,16 @@ contains character(len=5) :: res res = 'NULL' end function psb_base_get_fmt + ! + !> Function has_update + !! \memberof psb_base_sparse_mat + !! \brief Does the forma have the UPDATE functionality? + ! + function psb_base_has_update() result(res) + implicit none + logical :: res + res = .true. + end function psb_base_has_update ! ! Standard getter functions: self-explaining. diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index ce293ccb..6964a99b 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -76,6 +76,21 @@ module psb_d_base_mat_mod procedure, pass(a) :: mold => psb_d_base_mold procedure, pass(a) :: clone => psb_d_base_clone procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit + procedure, pass(a) :: asb => d_base_mat_asb + ! Sync: centerpiece of handling of external storage. + ! Any derived class having extra storage upon sync + ! will guarantee that both fortran/host side and + ! external side contain the same data. The base + ! version is only a placeholder. + ! + procedure, pass(a) :: sync => d_base_mat_sync + procedure, pass(a) :: is_host => d_base_mat_is_host + procedure, pass(a) :: is_dev => d_base_mat_is_dev + procedure, pass(a) :: is_sync => d_base_mat_is_sync + procedure, pass(a) :: set_host => d_base_mat_set_host + procedure, pass(a) :: set_dev => d_base_mat_set_dev + procedure, pass(a) :: set_sync => d_base_mat_set_sync + ! ! Transpose methods: defined here but not implemented. @@ -112,6 +127,10 @@ module psb_d_base_mat_mod procedure, pass(a) :: aclsum => psb_d_base_aclsum end type psb_d_base_sparse_mat + private :: d_base_mat_sync, d_base_mat_is_host, d_base_mat_is_dev, & + & d_base_mat_is_sync, d_base_mat_set_host, d_base_mat_set_dev,& + & d_base_mat_set_sync, d_base_mat_asb + !> \namespace psb_base_mod \class psb_d_coo_sparse_mat !! \extends psb_d_base_mat_mod::psb_d_base_sparse_mat !! @@ -1901,6 +1920,115 @@ contains end subroutine d_coo_transc_1mat + ! + !> Function base_asb: + !! \memberof psb_d_base_sparse_mat + !! \brief Sync: base version calls sync and the set_asb. + !! + ! + subroutine d_base_mat_asb(a) + implicit none + class(psb_d_base_sparse_mat), intent(inout) :: a + + call a%sync() + call a%set_asb() + end subroutine d_base_mat_asb + ! + ! The base version of SYNC & friends does nothing, it's just + ! a placeholder. + ! + ! + !> Function base_sync: + !! \memberof psb_d_base_sparse_mat + !! \brief Sync: base version is a no-op. + !! + ! + subroutine d_base_mat_sync(a) + implicit none + class(psb_d_base_sparse_mat), intent(inout) :: a + + end subroutine d_base_mat_sync + + ! + !> Function base_set_host: + !! \memberof psb_d_base_sparse_mat + !! \brief Set_host: base version is a no-op. + !! + ! + subroutine d_base_mat_set_host(a) + implicit none + class(psb_d_base_sparse_mat), intent(inout) :: a + + end subroutine d_base_mat_set_host + + ! + !> Function base_set_dev: + !! \memberof psb_d_base_sparse_mat + !! \brief Set_dev: base version is a no-op. + !! + ! + subroutine d_base_mat_set_dev(a) + implicit none + class(psb_d_base_sparse_mat), intent(inout) :: a + + end subroutine d_base_mat_set_dev + + ! + !> Function base_set_sync: + !! \memberof psb_d_base_sparse_mat + !! \brief Set_sync: base version is a no-op. + !! + ! + subroutine d_base_mat_set_sync(a) + implicit none + class(psb_d_base_sparse_mat), intent(inout) :: a + + end subroutine d_base_mat_set_sync + + ! + !> Function base_is_dev: + !! \memberof psb_d_base_sparse_mat + !! \brief Is vector on eaternal device . + !! + ! + function d_base_mat_is_dev(a) result(res) + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + logical :: res + + res = .false. + end function d_base_mat_is_dev + + ! + !> Function base_is_host + !! \memberof psb_d_base_sparse_mat + !! \brief Is vector on standard memory . + !! + ! + function d_base_mat_is_host(a) result(res) + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + logical :: res + + res = .true. + end function d_base_mat_is_host + + ! + !> Function base_is_sync + !! \memberof psb_d_base_sparse_mat + !! \brief Is vector on sync . + !! + ! + function d_base_mat_is_sync(a) result(res) + implicit none + class(psb_d_base_sparse_mat), intent(in) :: a + logical :: res + + res = .true. + end function d_base_mat_is_sync + + + end module psb_d_base_mat_mod diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 536cef23..5369f2c9 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -136,6 +136,7 @@ module psb_d_mat_mod procedure, pass(a) :: print_n => psb_d_n_sparse_print generic, public :: print => print_i, print_n procedure, pass(a) :: mold => psb_d_mold + procedure, pass(a) :: asb => psb_d_asb procedure, pass(a) :: transp_1mat => psb_d_transp_1mat procedure, pass(a) :: transp_2mat => psb_d_transp_2mat generic, public :: transp => transp_1mat, transp_2mat @@ -493,6 +494,13 @@ module psb_d_mat_mod end subroutine psb_d_mold end interface + interface + subroutine psb_d_asb(a) + import :: psb_ipk_, psb_dspmat_type + class(psb_dspmat_type), intent(inout) :: a + end subroutine psb_d_asb + end interface + interface subroutine psb_d_transp_1mat(a) import :: psb_ipk_, psb_dspmat_type diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 3beaa9f3..5e2812ca 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1244,8 +1244,8 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl) end if call move_alloc(altmp,b%a) - call b%set_asb() call b%trim() + call b%asb() call psb_erractionrestore(err_act) return @@ -1300,58 +1300,59 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl) call psb_errpush(info,name,a_err='TYPE, MOLD') goto 9999 end if - - if (present(mold)) then + if (a%is_bld()) then + if (present(mold)) then #if defined(HAVE_MOLD) - allocate(altmp, mold=mold,stat=info) + allocate(altmp, mold=mold,stat=info) #else - call mold%mold(altmp,info) + call mold%mold(altmp,info) #endif - else if (present(type)) then - - select case (psb_toupper(type)) - case ('CSR') - allocate(psb_d_csr_sparse_mat :: altmp, stat=info) - case ('COO') - allocate(psb_d_coo_sparse_mat :: altmp, stat=info) - case ('CSC') - allocate(psb_d_csc_sparse_mat :: altmp, stat=info) - case default - info = psb_err_format_unknown_ - call psb_errpush(info,name,a_err=type) - goto 9999 - end select - else + else if (present(type)) then + + select case (psb_toupper(type)) + case ('CSR') + allocate(psb_d_csr_sparse_mat :: altmp, stat=info) + case ('COO') + allocate(psb_d_coo_sparse_mat :: altmp, stat=info) + case ('CSC') + allocate(psb_d_csc_sparse_mat :: altmp, stat=info) + case default + info = psb_err_format_unknown_ + call psb_errpush(info,name,a_err=type) + goto 9999 + end select + else #if defined(HAVE_MOLD) - allocate(altmp, mold=psb_get_mat_default(a),stat=info) + allocate(altmp, mold=psb_get_mat_default(a),stat=info) #else - mld = psb_get_mat_default(a) - call mld%mold(altmp,info) + mld = psb_get_mat_default(a) + call mld%mold(altmp,info) #endif - end if + end if - if (info /= psb_success_) then - info = psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - end if + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if - if (debug) write(psb_err_unit,*) 'Converting in-place from ',& - & a%get_fmt(),' to ',altmp%get_fmt() + if (debug) write(psb_err_unit,*) 'Converting in-place from ',& + & a%get_fmt(),' to ',altmp%get_fmt() - call altmp%mv_from_fmt(a%a, info) + call altmp%mv_from_fmt(a%a, info) - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info,name,a_err="mv_from") - goto 9999 - end if + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err="mv_from") + goto 9999 + end if - call move_alloc(altmp,a%a) - call a%set_asb() + call move_alloc(altmp,a%a) + end if call a%trim() + call a%asb() call psb_erractionrestore(err_act) return @@ -1869,7 +1870,36 @@ subroutine psb_d_transc_2mat(a,b) end subroutine psb_d_transc_2mat +subroutine psb_d_asb(a) + use psb_d_mat_mod, psb_protect_name => psb_d_asb + use psb_error_mod + implicit none + + class(psb_dspmat_type), intent(inout) :: a + integer(psb_ipk_) :: err_act, info + character(len=20) :: name='reinit' + call psb_erractionsave(err_act) + if (a%is_null()) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + + call a%a%asb() + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + +end subroutine psb_d_asb subroutine psb_d_reinit(a,clear) @@ -1889,7 +1919,13 @@ subroutine psb_d_reinit(a,clear) goto 9999 endif - call a%a%reinit(clear) + if (a%a%has_update()) then + call a%a%reinit(clear) + else + info = psb_err_missing_override_method_ + call psb_errpush(info,name) + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index 41020e89..1a8722e1 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -1,6 +1,6 @@ 7 Number of entries below this BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES -DIAG Preconditioner NONE DIAG BJAC +BJAC Preconditioner NONE DIAG BJAC CSR Storage format for matrix A: CSR COO JAD 050 Domain size (acutal system is this**3) 2 Stopping criterion