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

psblas3:

Browse Source 
base/modules/psb_c_mat_mod.f90
 base/modules/psb_c_tools_mod.f90
 base/modules/psb_s_mat_mod.f90
 base/modules/psb_s_tools_mod.f90
 base/modules/psb_z_mat_mod.f90
 base/modules/psb_z_tools_mod.f90
 base/tools/psb_casb.f90
 base/tools/psb_sasb.f90
 base/tools/psb_zasb.f90
 krylov/psb_dcgstab.F90
 test/kernel/runs/spmv.inp
 test/pargen/runs/ppde.inp

Defined asb(scratch) for all variants; used in dcgstab.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 3d6e8bc1a7
commit db5fa89381
12 changed files with 189 additions and 125 deletions
Show Stats Download Patch File Download Diff File

1
base/modules/psb_c_mat_mod.f90
Unescape Escape View File

@ -109,6 +109,7 @@ module psb_c_mat_mod
procedure, pass(a) :: c_cscnv_ip => psb_c_cscnv_ip
procedure, pass(a) :: c_cscnv_base => psb_c_cscnv_base
generic, public :: cscnv => c_cscnv, c_cscnv_ip, c_cscnv_base
procedure, pass(a) :: clone => psb_cspmat_type_clone
procedure, pass(a) :: reinit => psb_c_reinit
procedure, pass(a) :: print_i => psb_c_sparse_print
procedure, pass(a) :: print_n => psb_c_n_sparse_print

14
base/modules/psb_c_tools_mod.f90
Unescape Escape View File

@ -80,21 +80,23 @@ Module psb_c_tools_mod
complex(psb_spk_), allocatable, intent(inout) :: x(:)
integer, intent(out) :: info
end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info,mold)
subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_c_vect_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_casb_vect
subroutine psb_casb_vect_r2(x, desc_a, info,mold)
subroutine psb_casb_vect_r2(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_c_vect_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_casb_vect_r2
end interface

1
base/modules/psb_s_mat_mod.f90
Unescape Escape View File

@ -109,6 +109,7 @@ module psb_s_mat_mod
procedure, pass(a) :: s_cscnv_ip => psb_s_cscnv_ip
procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base
generic, public :: cscnv => s_cscnv, s_cscnv_ip, s_cscnv_base
procedure, pass(a) :: clone => psb_sspmat_type_clone
procedure, pass(a) :: reinit => psb_s_reinit
procedure, pass(a) :: print_i => psb_s_sparse_print
procedure, pass(a) :: print_n => psb_s_n_sparse_print

14
base/modules/psb_s_tools_mod.f90
Unescape Escape View File

@ -80,21 +80,23 @@ Module psb_s_tools_mod
real(psb_spk_), allocatable, intent(inout) :: x(:)
integer, intent(out) :: info
end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info,mold)
subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_s_vect_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_sasb_vect
subroutine psb_sasb_vect_r2(x, desc_a, info,mold)
subroutine psb_sasb_vect_r2(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_spk_
use psb_s_vect_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_sasb_vect_r2
end interface

1
base/modules/psb_z_mat_mod.f90
Unescape Escape View File

@ -109,6 +109,7 @@ module psb_z_mat_mod
procedure, pass(a) :: z_cscnv_ip => psb_z_cscnv_ip
procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base
generic, public :: cscnv => z_cscnv, z_cscnv_ip, z_cscnv_base
procedure, pass(a) :: clone => psb_zspmat_type_clone
procedure, pass(a) :: reinit => psb_z_reinit
procedure, pass(a) :: print_i => psb_z_sparse_print
procedure, pass(a) :: print_n => psb_z_n_sparse_print

14
base/modules/psb_z_tools_mod.f90
Unescape Escape View File

@ -79,21 +79,23 @@ Module psb_z_tools_mod
complex(psb_dpk_), allocatable, intent(inout) :: x(:)
integer, intent(out) :: info
end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info,mold)
subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_dpk_
use psb_z_vect_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_zasb_vect
subroutine psb_zasb_vect_r2(x, desc_a, info,mold)
subroutine psb_zasb_vect_r2(x, desc_a, info,mold, scratch)
use psb_descriptor_type, only : psb_desc_type, psb_dpk_
use psb_z_vect_mod
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
end subroutine psb_zasb_vect_r2
end interface

80
base/tools/psb_casb.f90
Unescape Escape View File

@ -250,18 +250,20 @@ subroutine psb_casbv(x, desc_a, info)
end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info, mold)
subroutine psb_casb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_casb_vect
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables
integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -275,6 +277,8 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -293,16 +297,21 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (present(mold)) then
call x%cnv(mold)
if (scratch_) then
call x%free(info)
call x%bld(ncol,mold=mold)
else
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (present(mold)) then
call x%cnv(mold)
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -321,18 +330,20 @@ subroutine psb_casb_vect(x, desc_a, info, mold)
end subroutine psb_casb_vect
subroutine psb_casb_vect_r2(x, desc_a, info, mold)
subroutine psb_casb_vect_r2(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_casb_vect_r2
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_c_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_c_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables
integer :: ictxt,np,me, i, n
integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -346,6 +357,8 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -365,20 +378,29 @@ subroutine psb_casb_vect_r2(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
call psb_halo(x(i),desc_a,info)
if (info /= 0) exit
if (present(mold)) then
call x(i)%cnv(mold)
if (scratch_) then
do i=1,n
call x(i)%free(info)
call x(i)%bld(ncol,mold=mold)
end do
else
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
call psb_halo(x(i),desc_a,info)
if (info /= 0) exit
if (present(mold)) then
call x(i)%cnv(mold)
end if
end do
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
end do
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

79
base/tools/psb_sasb.f90
Unescape Escape View File

@ -250,18 +250,20 @@ subroutine psb_sasbv(x, desc_a, info)
end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info, mold)
subroutine psb_sasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_sasb_vect
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables
integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -275,6 +277,8 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -293,16 +297,21 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (present(mold)) then
call x%cnv(mold)
if (scratch_) then
call x%free(info)
call x%bld(ncol,mold=mold)
else
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (present(mold)) then
call x%cnv(mold)
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -321,18 +330,20 @@ subroutine psb_sasb_vect(x, desc_a, info, mold)
end subroutine psb_sasb_vect
subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
subroutine psb_sasb_vect_r2(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_sasb_vect_r2
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_s_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_s_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables
integer :: ictxt,np,me, i, n
integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -346,6 +357,8 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -365,20 +378,28 @@ subroutine psb_sasb_vect_r2(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
call psb_halo(x(i),desc_a,info)
if (info /= 0) exit
if (present(mold)) then
call x(i)%cnv(mold)
if (scratch_) then
do i=1,n
call x(i)%free(info)
call x(i)%bld(ncol,mold=mold)
end do
else
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
call psb_halo(x(i),desc_a,info)
if (info /= 0) exit
if (present(mold)) then
call x(i)%cnv(mold)
end if
end do
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
end do
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

79
base/tools/psb_zasb.f90
Unescape Escape View File

@ -250,18 +250,20 @@ subroutine psb_zasbv(x, desc_a, info)
end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info, mold)
subroutine psb_zasb_vect(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_zasb_vect
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables
integer :: ictxt,np,me
integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -275,6 +277,8 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -293,16 +297,21 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (present(mold)) then
call x%cnv(mold)
if (scratch_) then
call x%free(info)
call x%bld(ncol,mold=mold)
else
call x%asb(ncol,info)
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (present(mold)) then
call x%cnv(mold)
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -321,18 +330,20 @@ subroutine psb_zasb_vect(x, desc_a, info, mold)
end subroutine psb_zasb_vect
subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
subroutine psb_zasb_vect_r2(x, desc_a, info, mold, scratch)
use psb_base_mod, psb_protect_name => psb_zasb_vect_r2
implicit none
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(in) :: desc_a
type(psb_z_vect_type), intent(inout) :: x(:)
integer, intent(out) :: info
integer, intent(out) :: info
class(psb_z_base_vect_type), intent(in), optional :: mold
logical, intent(in), optional :: scratch
! local variables
integer :: ictxt,np,me, i, n
integer :: int_err(5), i1sz,nrow,ncol, err_act
logical :: scratch_
integer :: debug_level, debug_unit
character(len=20) :: name,ch_err
@ -346,6 +357,8 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
! ....verify blacs grid correctness..
@ -365,20 +378,28 @@ subroutine psb_zasb_vect_r2(x, desc_a, info, mold)
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': sizes: ',nrow,ncol
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
call psb_halo(x(i),desc_a,info)
if (info /= 0) exit
if (present(mold)) then
call x(i)%cnv(mold)
if (scratch_) then
do i=1,n
call x(i)%free(info)
call x(i)%bld(ncol,mold=mold)
end do
else
do i=1, n
call x(i)%asb(ncol,info)
if (info /= 0) exit
! ..update halo elements..
call psb_halo(x(i),desc_a,info)
if (info /= 0) exit
if (present(mold)) then
call x(i)%cnv(mold)
end if
end do
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
end do
if(info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_halo')
goto 9999
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

27
krylov/psb_dcgstab.F90
Unescape Escape View File

@ -442,8 +442,6 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
Real(psb_dpk_), Optional, Intent(out) :: err
!!$ Local data
Real(psb_dpk_), allocatable, target :: aux(:),wwrk(:,:)
!!$ Real(psb_dpk_), Pointer :: q(:),&
!!$ & r(:), p(:), v(:), s(:), t(:), z(:), f(:)
type(psb_d_vect_type) :: q, r, p, v, s, t, z, f
Integer :: itmax_, naux, mglob, it,itrace_,&
@ -518,23 +516,14 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
End If
call psb_geall(q,desc_a,info)
call psb_geall(r,desc_a,info)
call psb_geall(p,desc_a,info)
call psb_geall(v,desc_a,info)
call psb_geall(s,desc_a,info)
call psb_geall(t,desc_a,info)
call psb_geall(z,desc_a,info)
call psb_geall(f,desc_a,info)
call psb_geasb(q,desc_a,info,mold=x%v)
call psb_geasb(r,desc_a,info,mold=x%v)
call psb_geasb(p,desc_a,info,mold=x%v)
call psb_geasb(v,desc_a,info,mold=x%v)
call psb_geasb(s,desc_a,info,mold=x%v)
call psb_geasb(t,desc_a,info,mold=x%v)
call psb_geasb(z,desc_a,info,mold=x%v)
call psb_geasb(f,desc_a,info,mold=x%v)
call psb_geasb(q,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(r,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(p,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(v,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(s,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(t,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(z,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(f,desc_a,info,mold=x%v,scratch=.true.)
if (psb_errstatus_fatal()) then

2
test/kernel/runs/spmv.inp
Unescape Escape View File

@ -1,3 +1,5 @@
ASIC_100ks.mtx
MM
0

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

@ -1,5 +1,5 @@
7 Number of entries below this
BICGSTABL Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO JAD
040 Domain size (acutal system is this**3)

Write Preview
Loading…
Cancel
Save