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

First steps in defining new mat asb procedures.

Browse Source
psblas-3.3.1-1
Salvatore Filippone 11 years ago
parent 62502546b1
commit f29189b92c
5 changed files with 224 additions and 41 deletions
Show Stats Download Patch File Download Diff File

11
base/modules/psb_base_mat_mod.f90
Unescape Escape View File

@ -140,6 +140,7 @@ module psb_base_mat_mod
procedure, pass(a) :: get_state => psb_base_get_state procedure, pass(a) :: get_state => psb_base_get_state
procedure, pass(a) :: get_dupl => psb_base_get_dupl procedure, pass(a) :: get_dupl => psb_base_get_dupl
procedure, nopass :: get_fmt => psb_base_get_fmt 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_null => psb_base_is_null
procedure, pass(a) :: is_bld => psb_base_is_bld procedure, pass(a) :: is_bld => psb_base_is_bld
procedure, pass(a) :: is_upd => psb_base_is_upd procedure, pass(a) :: is_upd => psb_base_is_upd
@ -436,6 +437,16 @@ contains
character(len=5) :: res character(len=5) :: res
res = 'NULL' res = 'NULL'
end function psb_base_get_fmt 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. ! Standard getter functions: self-explaining.

128
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -76,6 +76,21 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mold => psb_d_base_mold procedure, pass(a) :: mold => psb_d_base_mold
procedure, pass(a) :: clone => psb_d_base_clone procedure, pass(a) :: clone => psb_d_base_clone
procedure, pass(a) :: make_nonunit => psb_d_base_make_nonunit 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. ! 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 procedure, pass(a) :: aclsum => psb_d_base_aclsum
end type psb_d_base_sparse_mat 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 !> \namespace psb_base_mod \class psb_d_coo_sparse_mat
!! \extends psb_d_base_mat_mod::psb_d_base_sparse_mat !! \extends psb_d_base_mat_mod::psb_d_base_sparse_mat
!! !!
@ -1901,6 +1920,115 @@ contains
end subroutine d_coo_transc_1mat 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 end module psb_d_base_mat_mod

8
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -136,6 +136,7 @@ module psb_d_mat_mod
procedure, pass(a) :: print_n => psb_d_n_sparse_print procedure, pass(a) :: print_n => psb_d_n_sparse_print
generic, public :: print => print_i, print_n generic, public :: print => print_i, print_n
procedure, pass(a) :: mold => psb_d_mold 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_1mat => psb_d_transp_1mat
procedure, pass(a) :: transp_2mat => psb_d_transp_2mat procedure, pass(a) :: transp_2mat => psb_d_transp_2mat
generic, public :: transp => transp_1mat, transp_2mat generic, public :: transp => transp_1mat, transp_2mat
@ -493,6 +494,13 @@ module psb_d_mat_mod
end subroutine psb_d_mold end subroutine psb_d_mold
end interface 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 interface
subroutine psb_d_transp_1mat(a) subroutine psb_d_transp_1mat(a)
import :: psb_ipk_, psb_dspmat_type import :: psb_ipk_, psb_dspmat_type

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

@ -1244,8 +1244,8 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
end if end if
call move_alloc(altmp,b%a) call move_alloc(altmp,b%a)
call b%set_asb()
call b%trim() call b%trim()
call b%asb()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1300,58 +1300,59 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
call psb_errpush(info,name,a_err='TYPE, MOLD') call psb_errpush(info,name,a_err='TYPE, MOLD')
goto 9999 goto 9999
end if end if
if (a%is_bld()) then
if (present(mold)) then if (present(mold)) then
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(altmp, mold=mold,stat=info) allocate(altmp, mold=mold,stat=info)
#else #else
call mold%mold(altmp,info) call mold%mold(altmp,info)
#endif #endif
else if (present(type)) then else if (present(type)) then
select case (psb_toupper(type)) select case (psb_toupper(type))
case ('CSR') case ('CSR')
allocate(psb_d_csr_sparse_mat :: altmp, stat=info) allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
case ('COO') case ('COO')
allocate(psb_d_coo_sparse_mat :: altmp, stat=info) allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
case ('CSC') case ('CSC')
allocate(psb_d_csc_sparse_mat :: altmp, stat=info) allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
case default case default
info = psb_err_format_unknown_ info = psb_err_format_unknown_
call psb_errpush(info,name,a_err=type) call psb_errpush(info,name,a_err=type)
goto 9999 goto 9999
end select end select
else else
#if defined(HAVE_MOLD) #if defined(HAVE_MOLD)
allocate(altmp, mold=psb_get_mat_default(a),stat=info) allocate(altmp, mold=psb_get_mat_default(a),stat=info)
#else #else
mld = psb_get_mat_default(a) mld = psb_get_mat_default(a)
call mld%mold(altmp,info) call mld%mold(altmp,info)
#endif #endif
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
if (debug) write(psb_err_unit,*) 'Converting in-place from ',& if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt() & 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 if (info /= psb_success_) then
info = psb_err_from_subroutine_ info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="mv_from") call psb_errpush(info,name,a_err="mv_from")
goto 9999 goto 9999
end if end if
call move_alloc(altmp,a%a) call move_alloc(altmp,a%a)
call a%set_asb() end if
call a%trim() call a%trim()
call a%asb()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1869,7 +1870,36 @@ subroutine psb_d_transc_2mat(a,b)
end subroutine psb_d_transc_2mat 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) subroutine psb_d_reinit(a,clear)
@ -1889,7 +1919,13 @@ subroutine psb_d_reinit(a,clear)
goto 9999 goto 9999
endif 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) call psb_erractionrestore(err_act)
return return

2
test/pargen/runs/ppde.inp
Unescape Escape View File

@ -1,6 +1,6 @@
7 Number of entries below this 7 Number of entries below this
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES 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 CSR Storage format for matrix A: CSR COO JAD
050 Domain size (acutal system is this**3) 050 Domain size (acutal system is this**3)
2 Stopping criterion 2 Stopping criterion

Write Preview
Loading…
Cancel
Save