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_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.

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) :: 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

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
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

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
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

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

@ -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

Write Preview
Loading…
Cancel
Save