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

Fixes for final release on 2.1

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent bbfc2b8971
commit 205bf658b0
7 changed files with 113 additions and 183 deletions
Show Stats Download Patch File Download Diff File

49
test/fileread/df_sample.f90
Unescape Escape View File

@ -37,16 +37,13 @@ program df_sample
implicit none
! input parameters
character*40 :: cmethd, mtrx_file, rhs_file
character*80 :: charbuf
character(len=40) :: cmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_dspmat_type) :: a, aux_a
! preconditioner data
type(psb_dprec_type) :: pre
integer :: igsmth, matop, novr
type(psb_dprec_type) :: prec
! dense matrices
real(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
@ -63,7 +60,7 @@ program df_sample
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, iprec, ml,amatsize,precsize,descsize
& methd, istopc, irst,amatsize,precsize,descsize
real(kind(1.d0)) :: err, eps
character(len=5) :: afmt
@ -98,8 +95,8 @@ program df_sample
!
! get parameters
!
call get_parms(ictxt,mtrx_file,rhs_file,cmethd,&
& ipart,afmt,istopc,itmax,itrace,ml,iprec,eps)
call get_parms(ictxt,mtrx_file,rhs_file,cmethd,ptype,&
& ipart,afmt,istopc,itmax,itrace,irst,eps)
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -193,28 +190,13 @@ program df_sample
write(*,'(" ")')
end if
!
! prepare the preconditioning matrix. note the availability
! of optional parameters
!
! zero initial guess.
matop=1
igsmth=-1
select case(iprec)
case(noprec_)
call psb_precinit(pre,'noprec',info)
case(diag_)
call psb_precinit(pre,'diag',info)
case(bjac_)
call psb_precinit(pre,'bjac',info)
case default
call psb_precinit(pre,'bjac',info)
end select
call psb_precinit(prec,ptype,info)
! building the preconditioner
t1 = psb_wtime()
call psb_precbld(a,desc_a,pre,info)
call psb_precbld(a,desc_a,prec,info)
tprec = psb_wtime()-t1
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_precbld')
@ -232,10 +214,11 @@ program df_sample
iparm = 0
call psb_barrier(ictxt)
t1 = psb_wtime()
call psb_krylov(cmethd,a,pre,b_col,x_col,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=ml)
call psb_krylov(cmethd,a,prec,b_col,x_col,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
call psb_geaxpby(done,b_col,dzero,r_col,desc_a,info)
call psb_spmm(-done,a,x_col,done,r_col,desc_a,info)
@ -244,12 +227,12 @@ program df_sample
amatsize = psb_sizeof(a)
descsize = psb_sizeof(desc_a)
precsize = psb_sizeof(pre)
precsize = psb_sizeof(prec)
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (amroot) then
call psb_prec_descr(6,pre)
call psb_prec_descr(6,prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence: ",i6)')iter
@ -262,15 +245,15 @@ program df_sample
write(*,'("Residual norm inf = ",es10.4)')resmxp
write(*,'("Total memory occupation for A: ",i10)')amatsize
write(*,'("Total memory occupation for DESC_A: ",i10)')descsize
write(*,'("Total memory occupation for PRE: ",i10)')precsize
write(*,'("Total memory occupation for PREC: ",i10)')precsize
end if
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)
if (ierr.ne.0) then
write(0,*) 'allocation error: no data collection'
else
call psb_gather(x_col_glob,x_col,desc_a,info,iroot=0)
call psb_gather(r_col_glob,r_col,desc_a,info,iroot=0)
call psb_gather(x_col_glob,x_col,desc_a,info,root=0)
call psb_gather(r_col_glob,r_col,desc_a,info,root=0)
if (amroot) then
write(0,'(" ")')
write(0,'("Saving x on file")')
@ -293,7 +276,7 @@ program df_sample
call psb_gefree(b_col, desc_a,info)
call psb_gefree(x_col, desc_a,info)
call psb_spfree(a, desc_a,info)
call psb_precfree(pre,info)
call psb_precfree(prec,info)
call psb_cdfree(desc_a,info)
9999 continue

81
test/fileread/getp.f90
Unescape Escape View File

@ -29,20 +29,19 @@
!!$
!!$
Module getp
use psb_base_mod
public get_parms
public pr_usage
contains
!
! Get iteration parameters from the command line
!
subroutine get_parms(ictxt,mtrx_file,rhs_file,cmethd,ipart,&
& afmt,istopc,itmax,itrace,ml,iprec,eps)
subroutine get_parms(ictxt,mtrx_file,rhs_file,cmethd,ptype,ipart,&
& afmt,istopc,itmax,itrace,irst,eps)
use psb_base_mod
integer :: ictxt
character*40 :: cmethd, mtrx_file, rhs_file
integer :: iret, istopc,itmax,itrace,ipart,iprec,ml
character*40 :: charbuf
character(len=40) :: cmethd, mtrx_file, rhs_file, ptype
integer :: iret, istopc,itmax,itrace,ipart,irst
character(len=40) :: charbuf
real(kind(1.d0)) :: eps
character :: afmt*5
integer :: np, iam
@ -52,45 +51,42 @@ contains
if (iam==0) then
! Read Input Parameters
read(*,*) ip
if (ip >= 3) then
if (ip >= 5) then
read(*,*) mtrx_file
read(*,*) rhs_file
read(*,*) cmethd
read(*,*) ptype
read(*,*) afmt
call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,cmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt)
read(*,*) ipart
if (ip >= 5) then
if (ip >= 7) then
read(*,*) istopc
else
istopc=1
endif
if (ip >= 6) then
if (ip >= 8) then
read(*,*) itmax
else
itmax=500
endif
if (ip >= 7) then
if (ip >= 9) then
read(*,*) itrace
else
itrace=-1
endif
if (ip >= 8) then
read(*,*) iprec
else
iprec=0
endif
if (ip >= 9) then
read(*,*) ml
if (ip >= 10) then
read(*,*) irst
else
ml = 1
irst = 1
endif
if (ip >= 10) then
if (ip >= 11) then
read(*,*) eps
else
eps=1.d-6
@ -99,22 +95,21 @@ contains
inparms(2) = istopc
inparms(3) = itmax
inparms(4) = itrace
inparms(5) = iprec
inparms(6) = ml
call psb_bcast(ictxt,inparms(1:6))
inparms(5) = irst
call psb_bcast(ictxt,inparms(1:5))
call psb_bcast(ictxt,eps)
write(*,'("Solving matrix : ",a40)') mtrx_file
write(*,'("Number of processors : ",i3)') np
write(*,'("Data distribution : ",i2)') ipart
write(*,'("Preconditioner : ",i2)') iprec
write(*,'("Restart parameter : ",i2)') ml
write(*,'("Iterative method : ",a40)') cmethd
write(*,'("Storage format : ",a3)') afmt(1:3)
write(*,'("Solving matrix : ",a)') mtrx_file
write(*,'("Number of processors : ",i3)') np
write(*,'("Data distribution : ",i2)') ipart
write(*,'("Iterative method : ",a)') cmethd
write(*,'("Preconditioner : ",a)') ptype
write(*,'("Restart parameter : ",i2)') irst
write(*,'("Storage format : ",a)') afmt(1:3)
write(*,'(" ")')
else
call pr_usage(0)
call psb_exit(ictxt)
write(0,*) 'Wrong format for input file'
call psb_abort(ictxt)
stop 1
end if
else
@ -122,35 +117,19 @@ contains
call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,cmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt)
call psb_bcast(ictxt,inparms(1:6))
call psb_bcast(ictxt,inparms(1:5))
ipart = inparms(1)
istopc = inparms(2)
itmax = inparms(3)
itrace = inparms(4)
iprec = inparms(5)
ml = inparms(6)
irst = inparms(5)
call psb_bcast(ictxt,eps)
end if
end subroutine get_parms
subroutine pr_usage(iout)
integer iout
write(iout, *) ' Number of parameters is incorrect!'
write(iout, *) ' Use: hb_sample mtrx_file methd prec [ptype &
&itmax istopc itrace]'
write(iout, *) ' Where:'
write(iout, *) ' mtrx_file is stored in HB format'
write(iout, *) ' methd may be: CGSTAB '
write(iout, *) ' ptype Partition strategy default 0'
write(iout, *) ' 0: BLOCK partition '
write(iout, *) ' itmax Max iterations [500] '
write(iout, *) ' istopc Stopping criterion [1] '
write(iout, *) ' itrace 0 (no tracing, default) or '
write(iout, *) ' >= 0 do tracing every ITRACE'
write(iout, *) ' iterations '
end subroutine pr_usage
end module getp

20
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -1,12 +1,12 @@
10 Number of inputs
lapl600x600.mtx young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB
CSR
2 IPART: Partition method 0: BLK 1: blk2 2: graph
1 ISTOPC
00800 ITMAX
11 Number of inputs
young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
2 ISTOPC
01000 ITMAX
-1 ITRACE
2 IPREC 0:NONE 1:DIAGSC 2:ILU
1 ML
30 IRST (restart for RGMRES and BiCGSTABL)
1.d-6 EPS

18
test/fileread/runs/zfs.inp
Unescape Escape View File

@ -1,12 +1,12 @@
10 Number of inputs
11 Number of inputs
waveguide3D.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB
CSR
0 IPART: Partition method 0: BLK 1: blk2 2: graph
1 ISTOPC
00800 ITMAX
06 ITRACE
4 IPREC 0:NONE 1:DIAGSC 2:ILU 3: AS 4: RAS 5: ASH 6: RASH
1 ML
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
2 ISTOPC
01000 ITMAX
-1 ITRACE
30 IRST (restart for RGMRES and BiCGSTABL)
1.d-7 EPS

50
test/fileread/zf_sample.f90
Unescape Escape View File

@ -37,15 +37,13 @@ program zf_sample
implicit none
! input parameters
character*40 :: cmethd, mtrx_file, rhs_file
character*80 :: charbuf
character(len=40) :: cmethd, ptype, mtrx_file, rhs_file
! sparse matrices
type(psb_zspmat_type) :: a, aux_a
! preconditioner data
type(psb_zprec_type) :: pre
integer :: igsmth, matop, novr
type(psb_zprec_type) :: prec
! dense matrices
complex(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
@ -62,7 +60,7 @@ program zf_sample
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, iprec, ml,amatsize,precsize,descsize
& methd, istopc, irst,amatsize,precsize,descsize
real(kind(1.d0)) :: err, eps
character(len=5) :: afmt
@ -78,7 +76,6 @@ program zf_sample
integer, allocatable :: ivg(:), ipv(:)
call psb_init(ictxt)
call psb_info(ictxt,iam,np)
@ -98,8 +95,8 @@ program zf_sample
!
! get parameters
!
call get_parms(ictxt,mtrx_file,rhs_file,cmethd,&
& ipart,afmt,istopc,itmax,itrace,ml,iprec,eps)
call get_parms(ictxt,mtrx_file,rhs_file,cmethd,ptype,&
& ipart,afmt,istopc,itmax,itrace,irst,eps)
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -193,28 +190,13 @@ program zf_sample
write(*,'(" ")')
end if
!
! prepare the preconditioning matrix. note the availability
! of optional parameters
!
! zero initial guess.
matop=1
igsmth=-1
select case(iprec)
case(noprec_)
call psb_precinit(pre,'noprec',info)
case(diag_)
call psb_precinit(pre,'diag',info)
case(bjac_)
call psb_precinit(pre,'bjac',info)
case default
call psb_precinit(pre,'bjac',info)
end select
call psb_precinit(prec,ptype,info)
! building the preconditioner
t1 = psb_wtime()
call psb_precbld(a,desc_a,pre,info)
call psb_precbld(a,desc_a,prec,info)
tprec = psb_wtime()-t1
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_precbld')
@ -232,8 +214,8 @@ program zf_sample
iparm = 0
call psb_barrier(ictxt)
t1 = psb_wtime()
call psb_krylov(cmethd,a,pre,b_col,x_col,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=ml)
call psb_krylov(cmethd,a,prec,b_col,x_col,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
@ -244,12 +226,12 @@ program zf_sample
amatsize = psb_sizeof(a)
descsize = psb_sizeof(desc_a)
precsize = psb_sizeof(pre)
precsize = psb_sizeof(prec)
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (amroot) then
call psb_prec_descr(6,pre)
call psb_prec_descr(6,prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence: ",i6)')iter
@ -262,15 +244,15 @@ program zf_sample
write(*,'("Residual norm inf = ",es10.4)')resmxp
write(*,'("Total memory occupation for A: ",i10)')amatsize
write(*,'("Total memory occupation for DESC_A: ",i10)')descsize
write(*,'("Total memory occupation for PRE: ",i10)')precsize
write(*,'("Total memory occupation for PREC: ",i10)')precsize
end if
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)
if (ierr.ne.0) then
write(0,*) 'allocation error: no data collection'
else
call psb_gather(x_col_glob,x_col,desc_a,info,iroot=0)
call psb_gather(r_col_glob,r_col,desc_a,info,iroot=0)
call psb_gather(x_col_glob,x_col,desc_a,info,root=0)
call psb_gather(r_col_glob,r_col,desc_a,info,root=0)
if (amroot) then
write(0,'(" ")')
write(0,'("Saving x on file")')
@ -286,14 +268,14 @@ program zf_sample
enddo
end if
end if
998 format(i8,4(2x,g20.14))
998 format(i8,6(1x,g11.5))
993 format(i6,4(1x,e12.6))
call psb_gefree(b_col, desc_a,info)
call psb_gefree(x_col, desc_a,info)
call psb_spfree(a, desc_a,info)
call psb_precfree(pre,info)
call psb_precfree(prec,info)
call psb_cdfree(desc_a,info)
9999 continue

63
test/pargen/ppde90.f90
Unescape Escape View File

@ -78,7 +78,7 @@ program pde90
implicit none
! input parameters
character :: cmethd*10, prec*10, afmt*5
character :: cmethd*10, ptype*10, afmt*5
integer :: idim, iret
! miscellaneous
@ -88,7 +88,7 @@ program pde90
! sparse matrix and preconditioner
type(psb_dspmat_type) :: a, l, u, h
type(psb_dprec_type) :: pre
type(psb_dprec_type) :: prec
! descriptor
type(psb_desc_type) :: desc_a, desc_a_out
! dense matrices
@ -98,14 +98,13 @@ program pde90
integer :: ictxt, iam, np
! solver parameters
integer :: iter, itmax,ierr,itrace, methd,iprec, istopc,&
& iparm(20), irst, novr
integer :: iter, itmax,ierr,itrace, methd, istopc,&
& iparm(20), irst
real(kind(1.d0)) :: err, eps, rparm(20)
! other variables
integer :: i,info
integer :: internal, m,ii
character(len=10) :: ptype
character(len=20) :: name,ch_err
if(psb_get_errstatus().ne.0) goto 9999
@ -127,7 +126,7 @@ program pde90
!
! get parameters
!
call get_parms(ictxt,cmethd,iprec,novr,afmt,idim,istopc,itmax,itrace,irst)
call get_parms(ictxt,cmethd,ptype,afmt,idim,istopc,itmax,itrace,irst)
!
! allocate and fill in the coefficient matrix, rhs and initial guess
@ -151,21 +150,12 @@ program pde90
! prepare the preconditioner.
!
if(iam == psb_root_) write(0,'("Setting preconditioner to : ",a)')pr_to_str(iprec)
select case(iprec)
case(noprec_)
call psb_precinit(pre,'noprec',info)
case(diag_)
call psb_precinit(pre,'diag',info)
case(bjac_)
call psb_precinit(pre,'bjac',info)
case default
call psb_precinit(pre,'bjac',info)
end select
if(iam == psb_root_) write(0,'("Setting preconditioner to : ",a)')ptype
call psb_precinit(prec,ptype,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call psb_precbld(a,desc_a,pre,info)
call psb_precbld(a,desc_a,prec,info)
if(info.ne.0) then
info=4010
ch_err='psb_precbld'
@ -187,7 +177,7 @@ program pde90
call psb_barrier(ictxt)
t1 = psb_wtime()
eps = 1.d-9
call psb_krylov(cmethd,a,pre,b,x,eps,desc_a,info,&
call psb_krylov(cmethd,a,prec,b,x,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
if(info.ne.0) then
@ -216,7 +206,7 @@ program pde90
call psb_gefree(b,desc_a,info)
call psb_gefree(x,desc_a,info)
call psb_spfree(a,desc_a,info)
call psb_precfree(pre,info)
call psb_precfree(prec,info)
call psb_cdfree(desc_a,info)
if(info.ne.0) then
info=4010
@ -236,11 +226,12 @@ contains
!
! get iteration parameters from the command line
!
subroutine get_parms(ictxt,cmethd,iprec,novr,afmt,idim,istopc,itmax,itrace,irst)
subroutine get_parms(ictxt,cmethd,ptype,afmt,idim,istopc,itmax,itrace,irst)
integer :: ictxt
character :: cmethd*10, afmt*5
integer :: idim, iret, istopc,itmax,itrace,irst, iprec, novr
character*40 :: charbuf
character(len=10) :: cmethd, ptype
character(len=5) :: afmt
integer :: idim, iret, istopc,itmax,itrace,irst
character(len=40) :: charbuf
integer :: iargc, np, iam
external iargc
integer :: intbuf(10), ip
@ -251,15 +242,13 @@ contains
read(*,*) ip
if (ip.ge.3) then
read(*,*) cmethd
read(*,*) iprec
read(*,*) novr
read(*,*) ptype
read(*,*) afmt
! broadcast parameters to all processors
call psb_bcast(ictxt,cmethd)
call psb_bcast(ictxt,afmt)
call psb_bcast(ictxt,iprec)
call psb_bcast(ictxt,novr)
call psb_bcast(ictxt,ptype)
read(*,*) idim
@ -296,9 +285,8 @@ contains
write(*,'("Grid dimensions : ",i4,"x",i4,"x",i4)')idim,idim,idim
write(*,'("Number of processors : ",i0)')np
write(*,'("Data distribution : BLOCK")')
write(*,'("Preconditioner : ",a)')pr_to_str(iprec)
if(iprec.gt.2) write(*,'("Overlapping levels : ",i0)')novr
write(*,'("Iterative method : ",a)')cmethd
write(*,'("Preconditioner : ",a)') ptype
write(*,'("Iterative method : ",a)') cmethd
write(*,'(" ")')
else
! wrong number of parameter, print an error message and exit
@ -309,8 +297,7 @@ contains
else
call psb_bcast(ictxt,cmethd)
call psb_bcast(ictxt,afmt)
call psb_bcast(ictxt,iprec)
call psb_bcast(ictxt,novr)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,intbuf(1:5))
idim = intbuf(1)
istopc = intbuf(2)
@ -330,15 +317,15 @@ contains
write(iout,*)' usage: pde90 methd prec dim &
&[istop itmax itrace]'
write(iout,*)' where:'
write(iout,*)' methd: cgstab tfqmr cgs'
write(iout,*)' prec : ilu diagsc none'
write(iout,*)' methd: cgstab cgs rgmres bicgstabl'
write(iout,*)' prec : bjac diag none'
write(iout,*)' dim number of points along each axis'
write(iout,*)' the size of the resulting linear '
write(iout,*)' system is dim**3'
write(iout,*)' istop stopping criterion 1, 2 or 3 [1] '
write(iout,*)' istop stopping criterion 1, 2 '
write(iout,*)' itmax maximum number of iterations [500] '
write(iout,*)' itrace 0 (no tracing, default) or '
write(iout,*)' >= 0 do tracing every itrace'
write(iout,*)' itrace <=0 (no tracing, default) or '
write(iout,*)' >= 1 do tracing every itrace'
write(iout,*)' iterations '
end subroutine pr_usage

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

@ -1,12 +1,11 @@
7 Number of entries below this
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL
2 Preconditioner 2=ILU 1=DIAGSC 0=NONE
2 Number ov overlapping levels
COO A Storage format CSR COO JAD
20 Domain size (acutal sistem is this**3)
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC
CSR A Storage format CSR COO JAD
20 Domain size (acutal system is this**3)
1 Stopping criterion
80 MAXIT
00 ITRACE
02 ML
02 IRST restart for RGMRES and BiCGSTABL

Write Preview
Loading…
Cancel
Save