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

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

@ -29,20 +29,19 @@
!!$ !!$
!!$ !!$
Module getp Module getp
use psb_base_mod
public get_parms public get_parms
public pr_usage
contains contains
! !
! Get iteration parameters from the command line ! Get iteration parameters from the command line
! !
subroutine get_parms(ictxt,mtrx_file,rhs_file,cmethd,ipart,& subroutine get_parms(ictxt,mtrx_file,rhs_file,cmethd,ptype,ipart,&
& afmt,istopc,itmax,itrace,ml,iprec,eps) & afmt,istopc,itmax,itrace,irst,eps)
use psb_base_mod
integer :: ictxt integer :: ictxt
character*40 :: cmethd, mtrx_file, rhs_file character(len=40) :: cmethd, mtrx_file, rhs_file, ptype
integer :: iret, istopc,itmax,itrace,ipart,iprec,ml integer :: iret, istopc,itmax,itrace,ipart,irst
character*40 :: charbuf character(len=40) :: charbuf
real(kind(1.d0)) :: eps real(kind(1.d0)) :: eps
character :: afmt*5 character :: afmt*5
integer :: np, iam integer :: np, iam
@ -52,45 +51,42 @@ contains
if (iam==0) then if (iam==0) then
! Read Input Parameters ! Read Input Parameters
read(*,*) ip read(*,*) ip
if (ip >= 3) then if (ip >= 5) then
read(*,*) mtrx_file read(*,*) mtrx_file
read(*,*) rhs_file read(*,*) rhs_file
read(*,*) cmethd read(*,*) cmethd
read(*,*) ptype
read(*,*) afmt read(*,*) afmt
call psb_bcast(ictxt,mtrx_file) call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file) call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,cmethd) call psb_bcast(ictxt,cmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt) call psb_bcast(ictxt,afmt)
read(*,*) ipart read(*,*) ipart
if (ip >= 5) then if (ip >= 7) then
read(*,*) istopc read(*,*) istopc
else else
istopc=1 istopc=1
endif endif
if (ip >= 6) then if (ip >= 8) then
read(*,*) itmax read(*,*) itmax
else else
itmax=500 itmax=500
endif endif
if (ip >= 7) then if (ip >= 9) then
read(*,*) itrace read(*,*) itrace
else else
itrace=-1 itrace=-1
endif endif
if (ip >= 8) then if (ip >= 10) then
read(*,*) iprec read(*,*) irst
else
iprec=0
endif
if (ip >= 9) then
read(*,*) ml
else else
ml = 1 irst = 1
endif endif
if (ip >= 10) then if (ip >= 11) then
read(*,*) eps read(*,*) eps
else else
eps=1.d-6 eps=1.d-6
@ -99,22 +95,21 @@ contains
inparms(2) = istopc inparms(2) = istopc
inparms(3) = itmax inparms(3) = itmax
inparms(4) = itrace inparms(4) = itrace
inparms(5) = iprec inparms(5) = irst
inparms(6) = ml call psb_bcast(ictxt,inparms(1:5))
call psb_bcast(ictxt,inparms(1:6))
call psb_bcast(ictxt,eps) call psb_bcast(ictxt,eps)
write(*,'("Solving matrix : ",a40)') mtrx_file write(*,'("Solving matrix : ",a)') mtrx_file
write(*,'("Number of processors : ",i3)') np write(*,'("Number of processors : ",i3)') np
write(*,'("Data distribution : ",i2)') ipart write(*,'("Data distribution : ",i2)') ipart
write(*,'("Preconditioner : ",i2)') iprec write(*,'("Iterative method : ",a)') cmethd
write(*,'("Restart parameter : ",i2)') ml write(*,'("Preconditioner : ",a)') ptype
write(*,'("Iterative method : ",a40)') cmethd write(*,'("Restart parameter : ",i2)') irst
write(*,'("Storage format : ",a3)') afmt(1:3) write(*,'("Storage format : ",a)') afmt(1:3)
write(*,'(" ")') write(*,'(" ")')
else else
call pr_usage(0) write(0,*) 'Wrong format for input file'
call psb_exit(ictxt) call psb_abort(ictxt)
stop 1 stop 1
end if end if
else else
@ -122,35 +117,19 @@ contains
call psb_bcast(ictxt,mtrx_file) call psb_bcast(ictxt,mtrx_file)
call psb_bcast(ictxt,rhs_file) call psb_bcast(ictxt,rhs_file)
call psb_bcast(ictxt,cmethd) call psb_bcast(ictxt,cmethd)
call psb_bcast(ictxt,ptype)
call psb_bcast(ictxt,afmt) call psb_bcast(ictxt,afmt)
call psb_bcast(ictxt,inparms(1:6)) call psb_bcast(ictxt,inparms(1:5))
ipart = inparms(1) ipart = inparms(1)
istopc = inparms(2) istopc = inparms(2)
itmax = inparms(3) itmax = inparms(3)
itrace = inparms(4) itrace = inparms(4)
iprec = inparms(5) irst = inparms(5)
ml = inparms(6)
call psb_bcast(ictxt,eps) call psb_bcast(ictxt,eps)
end if end if
end subroutine get_parms 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 end module getp

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

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

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

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

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

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

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

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

Write Preview
Loading…
Cancel
Save