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_const_mod.f90
 base/modules/psb_spmat_type.f03
 base/newserial/psbn_base_mat_mod.f03
 krylov/psb_dcgstab.F90
 prec/psb_dilu_fct.f90
 test/pargen/Makefile
 test/pargen/ppde.f90
 test/pargen/runs/ppde.inp

Preparing for switchover to psb_
psblas3-type-indexed
Salvatore Filippone 16 years ago
parent 0863bc05b9
commit 9d8d8d7ad3
8 changed files with 135 additions and 145 deletions
Show Stats Download Patch File Download Diff File

44
base/modules/psb_const_mod.f90
Unescape Escape View File

@ -57,5 +57,49 @@ module psb_const_mod
real(psb_dpk_), parameter :: epstol=1.d-32, psb_percent_=0.7 real(psb_dpk_), parameter :: epstol=1.d-32, psb_percent_=0.7
real(psb_spk_), parameter :: s_epstol=1.e-16 ! How to choose this? real(psb_spk_), parameter :: s_epstol=1.e-16 ! How to choose this?
character, parameter :: psb_all_='A', psb_topdef_=' ' character, parameter :: psb_all_='A', psb_topdef_=' '
!
! Sparse matrix constants
!
!
!
! Queries into spmat%info
!
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
integer, parameter :: psb_nzsizereq_=3
!
! Entries and values for spmat%info
!
integer, parameter :: psb_nnz_=1
integer, parameter :: psb_del_bnd_=7, psb_srtd_=8
integer, parameter :: psb_state_=9
integer, parameter :: psb_upd_pnt_=10
integer, parameter :: psb_dupl_=11, psb_upd_=12
integer, parameter :: psb_ifasize_=16
!
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
integer, parameter :: psb_iflag_=2, psb_ichk_=3
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
! Duplicate coefficients handling
! These are usually set while calling spcnv as one of its
! optional arugments.
integer, parameter :: psb_dupl_ovwrt_ = 0
integer, parameter :: psb_dupl_add_ = 1
integer, parameter :: psb_dupl_err_ = 2
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
! Matrix update mode
integer, parameter :: psb_upd_srch_ = 98764
integer, parameter :: psb_upd_perm_ = 98765
integer, parameter :: psb_upd_dflt_ = psb_upd_srch_
! Mark a COO matrix with sorted entries.
integer, parameter :: psb_isrtdcoo_ = 98761
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
integer, parameter :: psb_dbleint_=2
character(len=5) :: psb_fidef_='CSR'
end module psb_const_mod end module psb_const_mod

39
base/modules/psb_spmat_type.f03
Unescape Escape View File

@ -39,21 +39,6 @@ module psb_spmat_type
use psb_const_mod use psb_const_mod
implicit none implicit none
! !
!
! Queries into spmat%info
!
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
integer, parameter :: psb_nzsizereq_=3
!
! Entries and values for spmat%info
!
integer, parameter :: psb_nnz_=1
integer, parameter :: psb_del_bnd_=7, psb_srtd_=8
integer, parameter :: psb_state_=9
integer, parameter :: psb_upd_pnt_=10
integer, parameter :: psb_dupl_=11, psb_upd_=12
integer, parameter :: psb_ifasize_=16
!
! Types: psb_dspmat_type, psb_zspmat_type ! Types: psb_dspmat_type, psb_zspmat_type
! !
!| type psb_dspmat_type !| type psb_dspmat_type
@ -95,30 +80,6 @@ module psb_spmat_type
! in the second variant, the IN state applies to A and ! in the second variant, the IN state applies to A and
! the OUT state applies to B. ! the OUT state applies to B.
! !
!
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
integer, parameter :: psb_iflag_=2, psb_ichk_=3
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
! Duplicate coefficients handling
! These are usually set while calling spcnv as one of its
! optional arugments.
integer, parameter :: psb_dupl_ovwrt_ = 0
integer, parameter :: psb_dupl_add_ = 1
integer, parameter :: psb_dupl_err_ = 2
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
! Matrix update mode
integer, parameter :: psb_upd_srch_ = 98764
integer, parameter :: psb_upd_perm_ = 98765
integer, parameter :: psb_upd_dflt_ = psb_upd_srch_
! Mark a COO matrix with sorted entries.
integer, parameter :: psb_isrtdcoo_ = 98761
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
integer, parameter :: psb_dbleint_=2
character(len=5) :: psb_fidef_='CSR'
type psb_base_spmat_type type psb_base_spmat_type
integer :: m, k integer :: m, k

41
base/newserial/psbn_base_mat_mod.f03
Unescape Escape View File

@ -2,27 +2,26 @@ module psbn_base_mat_mod
use psb_const_mod use psb_const_mod
integer, parameter :: psbn_invalid_ = -1 !!$ integer, parameter :: psbn_invalid_ = -1
integer, parameter :: psbn_spmat_null_=0, psbn_spmat_bld_=1 !!$ integer, parameter :: psbn_spmat_null_=0, psbn_spmat_bld_=1
integer, parameter :: psbn_spmat_asb_=2, psbn_spmat_upd_=4 !!$ integer, parameter :: psbn_spmat_asb_=2, psbn_spmat_upd_=4
!!$
integer, parameter :: psbn_ireg_flgs_=10, psbn_ip2_=0 !!$ integer, parameter :: psbn_ireg_flgs_=10, psbn_ip2_=0
integer, parameter :: psbn_iflag_=2, psbn_ichk_=3 !!$ integer, parameter :: psbn_iflag_=2, psbn_ichk_=3
integer, parameter :: psbn_nnzt_=4, psbn_zero_=5,psbn_ipc_=6 !!$ integer, parameter :: psbn_nnzt_=4, psbn_zero_=5,psbn_ipc_=6
! Duplicate coefficients handling !!$ ! Duplicate coefficients handling
! These are usually set while calling spcnv as one of its !!$ ! These are usually set while calling spcnv as one of its
! optional arugments. !!$ ! optional arugments.
integer, parameter :: psbn_dupl_ovwrt_ = 0 !!$ integer, parameter :: psbn_dupl_ovwrt_ = 0
integer, parameter :: psbn_dupl_add_ = 1 !!$ integer, parameter :: psbn_dupl_add_ = 1
integer, parameter :: psbn_dupl_err_ = 2 !!$ integer, parameter :: psbn_dupl_err_ = 2
integer, parameter :: psbn_dupl_def_ = psbn_dupl_ovwrt_ !!$ integer, parameter :: psbn_dupl_def_ = psbn_dupl_ovwrt_
! Matrix update mode !!$ ! Matrix update mode
integer, parameter :: psbn_upd_srch_ = 98764 !!$ integer, parameter :: psbn_upd_srch_ = 98764
integer, parameter :: psbn_upd_perm_ = 98765 !!$ integer, parameter :: psbn_upd_perm_ = 98765
integer, parameter :: psbn_upd_dflt_ = psbn_upd_srch_ !!$ integer, parameter :: psbn_upd_dflt_ = psbn_upd_srch_
integer, parameter :: psbn_maxjdrows_=8, psbn_minjdrows_=4 !!$ integer, parameter :: psbn_maxjdrows_=8, psbn_minjdrows_=4
integer, parameter :: psbn_dbleint_=2 !!$ integer, parameter :: psbn_dbleint_=2
character(len=5) :: psbn_fidef_='CSR'
type :: psbn_base_sparse_mat type :: psbn_base_sparse_mat

2
krylov/psb_dcgstab.F90
Unescape Escape View File

@ -123,7 +123,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop)
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False. Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
Integer, Parameter :: irmax = 8 Integer, Parameter :: irmax = 8
Integer :: itx, isvch, ictxt, err_act Integer :: itx, isvch, ictxt, err_act, i
Integer :: istop_ Integer :: istop_
Real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau Real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma, omega, tau
type(psb_itconv_type) :: stopdat type(psb_itconv_type) :: stopdat

138
prec/psb_dilu_fct.f90
Unescape Escape View File

@ -124,6 +124,8 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
contains contains
subroutine psb_dilu_fctint(m,ma,a,mb,b,& subroutine psb_dilu_fctint(m,ma,a,mb,b,&
& d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info)
use psbn_d_base_mat_mod
implicit none implicit none
type(psbn_d_sparse_mat) :: a type(psbn_d_sparse_mat) :: a
@ -134,24 +136,20 @@ contains
integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act, nz integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act, nz
real(psb_dpk_) :: dia,temp real(psb_dpk_) :: dia,temp
integer, parameter :: nrb=16 integer, parameter :: nrb=60
type(psb_dspmat_type) :: trw type(psbn_d_coo_sparse_mat) :: trw
integer, allocatable :: irow(:), icol(:) integer, allocatable :: irow(:), icol(:)
real(psb_dpk_), allocatable :: val(:) real(psb_dpk_), allocatable :: val(:)
integer :: int_err(5) integer :: int_err(5)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dilu_fctint' name='psb_dilu_fctint'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_nullify_sp(trw) call trw%allocate(0,0,info)
trw%m=0
trw%k=0
call psb_sp_all(trw,1,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
@ -167,25 +165,38 @@ contains
do i = 1, ma do i = 1, ma
d(i) = dzero d(i) = dzero
! !
! !
call a%csget(i,i,nz,irow,icol,val,info) if ((mod(i,nrb) == 1).or.(nrb==1)) then
do j=1, nz irb = min(ma-i+1,nrb)
k = icol(j) call a%a%csget(i,i+irb-1,trw,info)
! write(0,*)'KKKKK',k if(info /= 0) then
info=4010
ch_err='a%csget'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nz = trw%get_nzeros()
ktrw=1
end if
do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then if ((k < i).and.(k >= 1)) then
l1 = l1 + 1 l1 = l1 + 1
laspk(l1) = val(j) laspk(l1) = trw%val(ktrw)
lia1(l1) = k lia1(l1) = k
else if (k == i) then else if (k == i) then
d(i) = val(j) d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then else if ((k > i).and.(k <= m)) then
l2 = l2 + 1 l2 = l2 + 1
uaspk(l2) = val(j) uaspk(l2) = trw%val(ktrw)
uia1(l2) = k uia1(l2) = k
end if end if
end do ktrw = ktrw + 1
enddo
!!$ !!$
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -273,61 +284,36 @@ contains
do i = ma+1, m do i = ma+1, m
d(i) = dzero d(i) = dzero
!!$ if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (b%fida=='CSR') then !!$ irb = min(ma-i+1,nrb)
!!$ call b%csget(i-ma,i-ma+irb-1,trw,info)
do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1 !!$ nz = trw%get_nzeros()
k = b%ia1(j) !!$ if(info /= 0) then
! if (me == 2) write(0,*)'ecco k=',k !!$ info=4010
if ((k < i).and.(k >= 1)) then !!$ ch_err='a%csget'
l1 = l1 + 1 !!$ call psb_errpush(info,name,a_err=ch_err)
laspk(l1) = b%aspk(j) !!$ goto 9999
lia1(l1) = k !!$ end if
! if(me == 2) write(0,*)'scrivo l' !!$ ktrw=1
else if (k == i) then !!$ end if
d(i) = b%aspk(j) !!$
else if ((k > i).and.(k <= m)) then !!$ do
l2 = l2 + 1 !!$ if (ktrw > nz ) exit
uaspk(l2) = b%aspk(j) !!$ if (trw%ia(ktrw) > i) exit
! write(0,*)'KKKKK',k !!$ k = trw%ja(ktrw)
uia1(l2) = k !!$ if ((k < i).and.(k >= 1)) then
end if !!$ l1 = l1 + 1
enddo !!$ laspk(l1) = trw%val(ktrw)
!!$ lia1(l1) = k
else !!$ else if (k == i) then
!!$ d(i) = trw%val(ktrw)
if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then !!$ else if ((k > i).and.(k <= m)) then
irb = min(m-i+1,nrb) !!$ l2 = l2 + 1
call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1) !!$ uaspk(l2) = trw%val(ktrw)
if(info /= 0) then !!$ uia1(l2) = k
info=4010 !!$ end if
ch_err='psb_sp_getblk' !!$ ktrw = ktrw + 1
call psb_errpush(info,name,a_err=ch_err) !!$ enddo
goto 9999
end if
ktrw=1
end if
do
if (ktrw > trw%infoa(psb_nnz_)) exit
if (trw%ia1(ktrw) > i) exit
k = trw%ia2(ktrw)
! write(0,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%aspk(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%aspk(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%aspk(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
endif
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -409,13 +395,7 @@ contains
enddo enddo
enddo enddo
call psb_sp_free(trw,info) call trw%free()
if(info /= 0) then
info=4010
ch_err='psb_sp_free'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

6
test/pargen/Makefile
Unescape Escape View File

@ -16,10 +16,12 @@ EXEDIR=./runs
all: ppde spde all: ppde spde
ppde: ppde.o ppde: ppde.o psbn_d_csc_impl.o psbn_d_csc_mat_mod.o
$(F90LINK) ppde.o -o ppde $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) ppde.o psbn_d_csc_impl.o psbn_d_csc_mat_mod.o -o ppde $(PSBLAS_LIB) $(LDLIBS)
/bin/mv ppde $(EXEDIR) /bin/mv ppde $(EXEDIR)
psbn_d_csc_impl.o ppde.o: psbn_d_csc_mat_mod.o
spde: spde.o spde: spde.o
$(F90LINK) spde.o -o spde $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) spde.o -o spde $(PSBLAS_LIB) $(LDLIBS)
/bin/mv spde $(EXEDIR) /bin/mv spde $(EXEDIR)

8
test/pargen/ppde.f90
Unescape Escape View File

@ -344,6 +344,7 @@ contains
! !
use psb_base_mod use psb_base_mod
use psbn_d_mat_mod use psbn_d_mat_mod
use psbn_d_csc_mat_mod
implicit none implicit none
integer :: idim integer :: idim
integer, parameter :: nb=20 integer, parameter :: nb=20
@ -352,6 +353,9 @@ contains
integer :: ictxt, info integer :: ictxt, info
character :: afmt*5 character :: afmt*5
type(psbn_d_sparse_mat) :: a type(psbn_d_sparse_mat) :: a
type(psbn_d_csc_sparse_mat) :: acsc
type(psbn_d_coo_sparse_mat) :: acoo
type(psbn_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),glob_x,glob_y,glob_z real(psb_dpk_) :: zt(nb),glob_x,glob_y,glob_z
integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k
integer :: x,y,z,ia,indx_owner integer :: x,y,z,ia,indx_owner
@ -589,7 +593,7 @@ contains
t1 = psb_wtime() t1 = psb_wtime()
call psb_cdasb(desc_a,info) call psb_cdasb(desc_a,info)
if (info == 0) & if (info == 0) &
& call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) & call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=acsr)
call psb_barrier(ictxt) call psb_barrier(ictxt)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
@ -608,7 +612,7 @@ contains
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call psb_barrier(ictxt) call psb_barrier(ictxt)
ttot = psb_wtime() - t0 ttot = psb_wtime() - t0
!!$ call a%print(20+iam)
call psb_amx(ictxt,talc) call psb_amx(ictxt,talc)
call psb_amx(ictxt,tgen) call psb_amx(ictxt,tgen)
call psb_amx(ictxt,tasb) call psb_amx(ictxt,tasb)

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

@ -1,7 +1,7 @@
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
BJAC Preconditioner NONE DIAG BJAC BJAC Preconditioner NONE DIAG BJAC
COO Storage format for matrix A: CSR COO JAD CSR Storage format for matrix A: CSR COO JAD
060 Domain size (acutal system is this**3) 060 Domain size (acutal system is this**3)
2 Stopping criterion 2 Stopping criterion
0400 MAXIT 0400 MAXIT

Write Preview
Loading…
Cancel
Save