fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4/test/fileread:

Browse Source 
Makefile
 df_bench.f90
 enablecore.c
 getp.f90
 precdata.f90
 zf_bench.f90

Made Xf_bench self contained, taking out getp/precdata.
This commit is contained in:
Salvatore Filippone
2008-03-05 16:51:53 +00:00
parent 1584f7d8a8
commit 0baffd3e6d
6 changed files with 486 additions and 298 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/fileread/Makefile
+2 -5
View File
@@ -6,16 +6,13 @@ MLD_LIB=-L$(MLDLIBDIR) -lmld_krylov -lmld_prec
PSBLAS_LIB= -L$(PSBDIR) -lpsb_util -lpsb_base
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDLIBDIR) $(FMFLAG)$(PSBDIR) $(FIFLAG).
DFOBJS=precdata.o getp.o df_bench.o enablecore.o
ZFOBJS=precdata.o getp.o zf_bench.o enablecore.o
DFOBJS=df_bench.o
ZFOBJS=zf_bench.o
EXEDIR=./runs
all: df_bench zf_bench
df_bench.o zf_bench.o: getp.o
getp.o: precdata.o
df_bench: $(DFOBJS)
$(F90LINK) $(LINKOPT) $(DFOBJS) -o df_bench \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
test/fileread/df_bench.f90
+242 -7
View File
@@ -1,6 +1,4 @@
program df_bench
use getp
use precd
use psb_base_mod
use psb_util_mod
use mld_prec_mod
@@ -11,6 +9,28 @@ program df_bench
character(len=20) :: kmethd
character(len=80) :: outf1, outf2, outf3
character(len=20), allocatable :: mtrx(:),rhs(:)
type precdata
character(len=10) :: lv1, lv2 ! First and second level prec type
integer :: nlev !
integer :: novr ! number of overlapping levels
integer :: restr ! restriction over application of as
integer :: prol ! prolongation over application of as
integer :: ftype1 ! Factorization type: ILU, SuperLU, UMFPACK.
integer :: fill1 ! Fill-in for factorization 1
real(psb_dpk_) :: thr1 ! Threshold for fact. 1 ILU(T)
integer :: mltype ! additive or multiplicative 2nd level prec
integer :: aggr ! local or global aggregation
integer :: smthkind ! smoothing type
integer :: cmat ! coarse mat
integer :: smthpos ! pre, post, both smoothing
integer :: glbsmth ! global smoothing
integer :: ftype2 ! Factorization type: ILU, SuperLU, UMFPACK.
integer :: fill2 ! Fill-in for factorization 1
real(psb_dpk_) :: thr2 ! Threshold for fact. 1 ILU(T)
integer :: jswp ! Jacobi sweeps
real(psb_dpk_) :: omega ! smoother omega
character(len=40) :: descr ! verbose description of the prec
end type precdata
type(precdata), allocatable :: precs(:)
! sparse matrices
@@ -60,15 +80,12 @@ program df_bench
stop
endif
call enablecore()
name='df_sample'
name='df_bench'
if(psb_get_errstatus() /= 0) goto 9999
info=0
call psb_set_errverbosity(2)
!!$ call psb_cd_set_large_threshold(512)
!!$ call psb_cd_set_large_threshold(2)
!!$ write(0,*) iam,'Main: large threshold ',psb_cd_get_large_threshold()
!
! get parameters
!
@@ -400,6 +417,224 @@ program df_bench
call psb_exit(ictxt)
stop
contains
!
! get iteration parameters from standard input
!
subroutine get_parms(icontxt,irst,irnum,ntry,nmat,mtrx,rhs,kmethd,nprecs,precs,ipart,&
& afmt,istopc,itmax,itrace,eps,outf1,outf2)
use psb_base_mod
implicit none
integer :: icontxt
character(len=20) :: kmethd
character(len=80) :: outf1, outf2
character(len=20),allocatable :: mtrx(:), rhs(:)
type(precdata),allocatable :: precs(:)
integer :: iret, istopc,itmax,itrace,ipart,nmat,nprecs,irst,irnum,ntry
character(len=1024) :: charbuf
real(psb_dpk_) :: eps, omega,thr1,thr2
character :: afmt*5, lv1*10, lv2*10, pdescr*40
integer :: iam, nm, np, i, idx
integer, parameter :: npparms=14
integer :: inparms(40), ip, pparms(npparms)
call psb_info(icontxt,iam,np)
if (iam==psb_root_) then
! read input parameters
read(*,*) outf1
read(*,*) outf2
read(*,*) kmethd
read(*,*) eps
read(*,*) afmt
call psb_bcast(icontxt,kmethd)
call psb_bcast(icontxt,eps,0)
call psb_bcast(icontxt,afmt)
read(*,*) ipart
read(*,*) itmax
read(*,*) itrace
read(*,*) istopc
read(*,*) irst
read(*,*) irnum
read(*,*) ntry
read(*,*) nprecs
! broadcast parameters to all processors
inparms(1) = ipart
inparms(2) = itmax
inparms(3) = itrace
inparms(4) = istopc
inparms(5) = irst
inparms(6) = irnum
inparms(7) = ntry
call psb_bcast(icontxt,inparms(1:7))
call psb_bcast(icontxt,nprecs)
allocate(precs(nprecs))
do np=1,nprecs
read(*,'(a)')charbuf
charbuf = adjustl(charbuf)
idx=index(charbuf," ")
read(charbuf(1:idx-1),'(a)')lv1
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx-1),'(a)')lv2
charbuf=adjustl(charbuf(idx:))
do i=1, npparms
idx=index(charbuf," ")
read(charbuf(1:idx),*) pparms(i)
charbuf=adjustl(charbuf(idx:))
end do
idx=index(charbuf," ")
read(charbuf(1:idx),*) omega
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx),*) thr1
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx),*) thr2
charbuf=adjustl(charbuf(idx:))
read(charbuf,'(a)') pdescr
call psb_bcast(icontxt,pdescr)
precs(np)%descr=pdescr
call psb_bcast(icontxt,lv1)
call psb_bcast(icontxt,lv2)
call psb_bcast(icontxt,pparms(1:npparms))
call psb_bcast(icontxt,omega)
call psb_bcast(icontxt,thr1)
call psb_bcast(icontxt,thr2)
precs(np)%lv1 = lv1
precs(np)%lv2 = lv2
precs(np)%novr = pparms(1)
precs(np)%restr = pparms(2)
precs(np)%prol = pparms(3)
precs(np)%ftype1 = pparms(4)
precs(np)%fill1 = pparms(5)
precs(np)%mltype = pparms(6)
precs(np)%aggr = pparms(7)
precs(np)%smthkind = pparms(8)
precs(np)%cmat = pparms(9)
precs(np)%smthpos = pparms(10)
precs(np)%ftype2 = pparms(11)
precs(np)%fill2 = pparms(12)
precs(np)%jswp = pparms(13)
precs(np)%nlev = pparms(14)
precs(np)%omega = omega
precs(np)%thr1 = thr1
precs(np)%thr2 = thr2
end do
read(*,*) nmat
call psb_bcast(icontxt,nmat)
allocate(mtrx(nmat),rhs(nmat))
do nm=1, nmat
read(*,'(a)') charbuf
charbuf=adjustl(charbuf)
idx=index(charbuf," ")
mtrx(nm)=charbuf(1:idx-1)
rhs(nm)=adjustl(charbuf(idx+1:))
call psb_bcast(icontxt,mtrx(nm))
call psb_bcast(icontxt,rhs(nm))
end do
else
! receive parameters
call psb_bcast(icontxt,kmethd)
call psb_bcast(icontxt,eps)
call psb_bcast(icontxt,afmt)
call psb_bcast(icontxt,inparms(1:7))
ipart = inparms(1)
itmax = inparms(2)
itrace = inparms(3)
istopc = inparms(4)
irst = inparms(5)
irnum = inparms(6)
ntry = inparms(7)
call psb_bcast(icontxt,nprecs)
allocate(precs(nprecs))
do np=1,nprecs
call psb_bcast(icontxt,pdescr)
precs(np)%descr=pdescr
call psb_bcast(icontxt,lv1)
call psb_bcast(icontxt,lv2)
call psb_bcast(icontxt,pparms(1:npparms))
call psb_bcast(icontxt,omega)
call psb_bcast(icontxt,thr1)
call psb_bcast(icontxt,thr2)
precs(np)%lv1 = lv1
precs(np)%lv2 = lv2
precs(np)%novr = pparms(1)
precs(np)%restr = pparms(2)
precs(np)%prol = pparms(3)
precs(np)%ftype1 = pparms(4)
precs(np)%fill1 = pparms(5)
precs(np)%mltype = pparms(6)
precs(np)%aggr = pparms(7)
precs(np)%smthkind = pparms(8)
precs(np)%cmat = pparms(9)
precs(np)%smthpos = pparms(10)
precs(np)%ftype2 = pparms(11)
precs(np)%fill2 = pparms(12)
precs(np)%jswp = pparms(13)
precs(np)%nlev = pparms(14)
precs(np)%omega = omega
precs(np)%thr1 = thr1
precs(np)%thr2 = thr2
end do
call psb_bcast(icontxt,nmat)
allocate(mtrx(nmat),rhs(nmat))
do nm=1,nmat
call psb_bcast(icontxt,mtrx(nm))
call psb_bcast(icontxt,rhs(nm))
end do
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, *) ' 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 '
write(iout, *) ' prec may be: ilu diagsc none'
write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition '
end subroutine pr_usage
end program df_bench
test/fileread/enablecore.c
-32
View File
@@ -1,32 +0,0 @@
#include <sys/resource.h>
#include <unistd.h>
#include <signal.h>
#ifdef LowerUnderscore
#define enablecore enablecore_
#endif
#ifdef LowerDoubleUnderscore
#define enablecore enablecore_
#endif
#ifdef LowerCase
#define enablecore enablecore
#endif
#ifdef UpperUnderscore
#define enablecore ENABLECORE_
#endif
#ifdef UpperDoubleUnderscore
#define enablecore ENABLECORE_
#endif
#ifdef UpperCase
#define enablecore ENABLECORE
#endif
void enablecore()
{
struct rlimit rlim;
getrlimit(RLIMIT_CORE, &rlim);
rlim.rlim_cur = RLIM_INFINITY;
setrlimit(RLIMIT_CORE, &rlim);
signal(SIGSEGV, SIG_DFL);
}
test/fileread/getp.f90
-223
View File
@@ -1,223 +0,0 @@
module getp
public get_parms
public pr_usage
contains
!
! get iteration parameters from standard input
!
subroutine get_parms(icontxt,irst,irnum,ntry,nmat,mtrx,rhs,kmethd,nprecs,precs,ipart,&
& afmt,istopc,itmax,itrace,eps,outf1,outf2)
use psb_base_mod
use precd
implicit none
integer :: icontxt
character(len=20) :: kmethd
character(len=80) :: outf1, outf2
character(len=20),allocatable :: mtrx(:), rhs(:)
type(precdata),allocatable :: precs(:)
integer :: iret, istopc,itmax,itrace,ipart,nmat,nprecs,irst,irnum,ntry
character(len=1024) :: charbuf
real(psb_dpk_) :: eps, omega,thr1,thr2
character :: afmt*5, lv1*10, lv2*10, pdescr*40
integer :: iam, nm, np, i, idx
integer, parameter :: npparms=14
integer :: inparms(40), ip, pparms(npparms)
call psb_info(icontxt,iam,np)
if (iam==psb_root_) then
! read input parameters
read(*,*) outf1
read(*,*) outf2
read(*,*) kmethd
read(*,*) eps
read(*,*) afmt
call psb_bcast(icontxt,kmethd)
call psb_bcast(icontxt,eps,0)
call psb_bcast(icontxt,afmt)
read(*,*) ipart
read(*,*) itmax
read(*,*) itrace
read(*,*) istopc
read(*,*) irst
read(*,*) irnum
read(*,*) ntry
read(*,*) nprecs
! broadcast parameters to all processors
inparms(1) = ipart
inparms(2) = itmax
inparms(3) = itrace
inparms(4) = istopc
inparms(5) = irst
inparms(6) = irnum
inparms(7) = ntry
call psb_bcast(icontxt,inparms(1:7))
call psb_bcast(icontxt,nprecs)
allocate(precs(nprecs))
do np=1,nprecs
read(*,'(a)')charbuf
charbuf = adjustl(charbuf)
idx=index(charbuf," ")
read(charbuf(1:idx-1),'(a)')lv1
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx-1),'(a)')lv2
charbuf=adjustl(charbuf(idx:))
do i=1, npparms
idx=index(charbuf," ")
read(charbuf(1:idx),*) pparms(i)
charbuf=adjustl(charbuf(idx:))
end do
idx=index(charbuf," ")
read(charbuf(1:idx),*) omega
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx),*) thr1
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx),*) thr2
charbuf=adjustl(charbuf(idx:))
read(charbuf,'(a)') pdescr
call psb_bcast(icontxt,pdescr)
precs(np)%descr=pdescr
call psb_bcast(icontxt,lv1)
call psb_bcast(icontxt,lv2)
call psb_bcast(icontxt,pparms(1:npparms))
call psb_bcast(icontxt,omega)
call psb_bcast(icontxt,thr1)
call psb_bcast(icontxt,thr2)
precs(np)%lv1 = lv1
precs(np)%lv2 = lv2
precs(np)%novr = pparms(1)
precs(np)%restr = pparms(2)
precs(np)%prol = pparms(3)
precs(np)%ftype1 = pparms(4)
precs(np)%fill1 = pparms(5)
precs(np)%mltype = pparms(6)
precs(np)%aggr = pparms(7)
precs(np)%smthkind = pparms(8)
precs(np)%cmat = pparms(9)
precs(np)%smthpos = pparms(10)
precs(np)%ftype2 = pparms(11)
precs(np)%fill2 = pparms(12)
precs(np)%jswp = pparms(13)
precs(np)%nlev = pparms(14)
precs(np)%omega = omega
precs(np)%thr1 = thr1
precs(np)%thr2 = thr2
end do
read(*,*) nmat
call psb_bcast(icontxt,nmat)
allocate(mtrx(nmat),rhs(nmat))
do nm=1, nmat
read(*,'(a)') charbuf
charbuf=adjustl(charbuf)
idx=index(charbuf," ")
mtrx(nm)=charbuf(1:idx-1)
rhs(nm)=adjustl(charbuf(idx+1:))
call psb_bcast(icontxt,mtrx(nm))
call psb_bcast(icontxt,rhs(nm))
end do
else
! receive parameters
call psb_bcast(icontxt,kmethd)
call psb_bcast(icontxt,eps)
call psb_bcast(icontxt,afmt)
call psb_bcast(icontxt,inparms(1:7))
ipart = inparms(1)
itmax = inparms(2)
itrace = inparms(3)
istopc = inparms(4)
irst = inparms(5)
irnum = inparms(6)
ntry = inparms(7)
call psb_bcast(icontxt,nprecs)
allocate(precs(nprecs))
do np=1,nprecs
call psb_bcast(icontxt,pdescr)
precs(np)%descr=pdescr
call psb_bcast(icontxt,lv1)
call psb_bcast(icontxt,lv2)
call psb_bcast(icontxt,pparms(1:npparms))
call psb_bcast(icontxt,omega)
call psb_bcast(icontxt,thr1)
call psb_bcast(icontxt,thr2)
precs(np)%lv1 = lv1
precs(np)%lv2 = lv2
precs(np)%novr = pparms(1)
precs(np)%restr = pparms(2)
precs(np)%prol = pparms(3)
precs(np)%ftype1 = pparms(4)
precs(np)%fill1 = pparms(5)
precs(np)%mltype = pparms(6)
precs(np)%aggr = pparms(7)
precs(np)%smthkind = pparms(8)
precs(np)%cmat = pparms(9)
precs(np)%smthpos = pparms(10)
precs(np)%ftype2 = pparms(11)
precs(np)%fill2 = pparms(12)
precs(np)%jswp = pparms(13)
precs(np)%nlev = pparms(14)
precs(np)%omega = omega
precs(np)%thr1 = thr1
precs(np)%thr2 = thr2
end do
call psb_bcast(icontxt,nmat)
allocate(mtrx(nmat),rhs(nmat))
do nm=1,nmat
call psb_bcast(icontxt,mtrx(nm))
call psb_bcast(icontxt,rhs(nm))
end do
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, *) ' 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 '
write(iout, *) ' prec may be: ilu diagsc none'
write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition '
end subroutine pr_usage
end module getp
test/fileread/precdata.f90
-26
View File
@@ -1,26 +0,0 @@
module precd
use psb_base_mod, only : psb_dpk_
type precdata
character(len=10) :: lv1, lv2 ! First and second level prec type
integer :: nlev !
integer :: novr ! number of overlapping levels
integer :: restr ! restriction over application of as
integer :: prol ! prolongation over application of as
integer :: ftype1 ! Factorization type: ILU, SuperLU, UMFPACK.
integer :: fill1 ! Fill-in for factorization 1
real(psb_dpk_) :: thr1 ! Threshold for fact. 1 ILU(T)
integer :: mltype ! additive or multiplicative 2nd level prec
integer :: aggr ! local or global aggregation
integer :: smthkind ! smoothing type
integer :: cmat ! coarse mat
integer :: smthpos ! pre, post, both smoothing
integer :: glbsmth ! global smoothing
integer :: ftype2 ! Factorization type: ILU, SuperLU, UMFPACK.
integer :: fill2 ! Fill-in for factorization 1
real(psb_dpk_) :: thr2 ! Threshold for fact. 1 ILU(T)
integer :: jswp ! Jacobi sweeps
real(psb_dpk_) :: omega ! smoother omega
character(len=40) :: descr ! verbose description of the prec
end type precdata
end module precd
test/fileread/zf_bench.f90
+242 -5
View File
@@ -1,6 +1,4 @@
program zf_bench
use precd
use getp
use psb_base_mod
use psb_util_mod
use mld_prec_mod
@@ -11,6 +9,28 @@ program zf_bench
character(len=20) :: kmethd
character(len=80) :: outf1, outf2, outf3
character(len=20), allocatable :: mtrx(:),rhs(:)
type precdata
character(len=10) :: lv1, lv2 ! First and second level prec type
integer :: nlev !
integer :: novr ! number of overlapping levels
integer :: restr ! restriction over application of as
integer :: prol ! prolongation over application of as
integer :: ftype1 ! Factorization type: ILU, SuperLU, UMFPACK.
integer :: fill1 ! Fill-in for factorization 1
real(psb_dpk_) :: thr1 ! Threshold for fact. 1 ILU(T)
integer :: mltype ! additive or multiplicative 2nd level prec
integer :: aggr ! local or global aggregation
integer :: smthkind ! smoothing type
integer :: cmat ! coarse mat
integer :: smthpos ! pre, post, both smoothing
integer :: glbsmth ! global smoothing
integer :: ftype2 ! Factorization type: ILU, SuperLU, UMFPACK.
integer :: fill2 ! Fill-in for factorization 1
real(psb_dpk_) :: thr2 ! Threshold for fact. 1 ILU(T)
integer :: jswp ! Jacobi sweeps
real(psb_dpk_) :: omega ! smoother omega
character(len=40) :: descr ! verbose description of the prec
end type precdata
type(precdata), allocatable :: precs(:)
@@ -61,9 +81,7 @@ program zf_bench
stop
endif
call enablecore()
name='df_sample'
name='zf_bench'
if(psb_get_errstatus() /= 0) goto 9999
info=0
call psb_set_errverbosity(2)
@@ -344,6 +362,225 @@ program zf_bench
call psb_exit(ictxt)
stop
contains
!
! get iteration parameters from standard input
!
subroutine get_parms(icontxt,irst,irnum,ntry,nmat,mtrx,rhs,kmethd,nprecs,precs,ipart,&
& afmt,istopc,itmax,itrace,eps,outf1,outf2)
use psb_base_mod
implicit none
integer :: icontxt
character(len=20) :: kmethd
character(len=80) :: outf1, outf2
character(len=20),allocatable :: mtrx(:), rhs(:)
type(precdata),allocatable :: precs(:)
integer :: iret, istopc,itmax,itrace,ipart,nmat,nprecs,irst,irnum,ntry
character(len=1024) :: charbuf
real(psb_dpk_) :: eps, omega,thr1,thr2
character :: afmt*5, lv1*10, lv2*10, pdescr*40
integer :: iam, nm, np, i, idx
integer, parameter :: npparms=14
integer :: inparms(40), ip, pparms(npparms)
call psb_info(icontxt,iam,np)
if (iam==psb_root_) then
! read input parameters
read(*,*) outf1
read(*,*) outf2
read(*,*) kmethd
read(*,*) eps
read(*,*) afmt
call psb_bcast(icontxt,kmethd)
call psb_bcast(icontxt,eps,0)
call psb_bcast(icontxt,afmt)
read(*,*) ipart
read(*,*) itmax
read(*,*) itrace
read(*,*) istopc
read(*,*) irst
read(*,*) irnum
read(*,*) ntry
read(*,*) nprecs
! broadcast parameters to all processors
inparms(1) = ipart
inparms(2) = itmax
inparms(3) = itrace
inparms(4) = istopc
inparms(5) = irst
inparms(6) = irnum
inparms(7) = ntry
call psb_bcast(icontxt,inparms(1:7))
call psb_bcast(icontxt,nprecs)
allocate(precs(nprecs))
do np=1,nprecs
read(*,'(a)')charbuf
charbuf = adjustl(charbuf)
idx=index(charbuf," ")
read(charbuf(1:idx-1),'(a)')lv1
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx-1),'(a)')lv2
charbuf=adjustl(charbuf(idx:))
do i=1, npparms
idx=index(charbuf," ")
read(charbuf(1:idx),*) pparms(i)
charbuf=adjustl(charbuf(idx:))
end do
idx=index(charbuf," ")
read(charbuf(1:idx),*) omega
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx),*) thr1
charbuf=adjustl(charbuf(idx:))
idx=index(charbuf," ")
read(charbuf(1:idx),*) thr2
charbuf=adjustl(charbuf(idx:))
read(charbuf,'(a)') pdescr
call psb_bcast(icontxt,pdescr)
precs(np)%descr=pdescr
call psb_bcast(icontxt,lv1)
call psb_bcast(icontxt,lv2)
call psb_bcast(icontxt,pparms(1:npparms))
call psb_bcast(icontxt,omega)
call psb_bcast(icontxt,thr1)
call psb_bcast(icontxt,thr2)
precs(np)%lv1 = lv1
precs(np)%lv2 = lv2
precs(np)%novr = pparms(1)
precs(np)%restr = pparms(2)
precs(np)%prol = pparms(3)
precs(np)%ftype1 = pparms(4)
precs(np)%fill1 = pparms(5)
precs(np)%mltype = pparms(6)
precs(np)%aggr = pparms(7)
precs(np)%smthkind = pparms(8)
precs(np)%cmat = pparms(9)
precs(np)%smthpos = pparms(10)
precs(np)%ftype2 = pparms(11)
precs(np)%fill2 = pparms(12)
precs(np)%jswp = pparms(13)
precs(np)%nlev = pparms(14)
precs(np)%omega = omega
precs(np)%thr1 = thr1
precs(np)%thr2 = thr2
end do
read(*,*) nmat
call psb_bcast(icontxt,nmat)
allocate(mtrx(nmat),rhs(nmat))
do nm=1, nmat
read(*,'(a)') charbuf
charbuf=adjustl(charbuf)
idx=index(charbuf," ")
mtrx(nm)=charbuf(1:idx-1)
rhs(nm)=adjustl(charbuf(idx+1:))
call psb_bcast(icontxt,mtrx(nm))
call psb_bcast(icontxt,rhs(nm))
end do
else
! receive parameters
call psb_bcast(icontxt,kmethd)
call psb_bcast(icontxt,eps)
call psb_bcast(icontxt,afmt)
call psb_bcast(icontxt,inparms(1:7))
ipart = inparms(1)
itmax = inparms(2)
itrace = inparms(3)
istopc = inparms(4)
irst = inparms(5)
irnum = inparms(6)
ntry = inparms(7)
call psb_bcast(icontxt,nprecs)
allocate(precs(nprecs))
do np=1,nprecs
call psb_bcast(icontxt,pdescr)
precs(np)%descr=pdescr
call psb_bcast(icontxt,lv1)
call psb_bcast(icontxt,lv2)
call psb_bcast(icontxt,pparms(1:npparms))
call psb_bcast(icontxt,omega)
call psb_bcast(icontxt,thr1)
call psb_bcast(icontxt,thr2)
precs(np)%lv1 = lv1
precs(np)%lv2 = lv2
precs(np)%novr = pparms(1)
precs(np)%restr = pparms(2)
precs(np)%prol = pparms(3)
precs(np)%ftype1 = pparms(4)
precs(np)%fill1 = pparms(5)
precs(np)%mltype = pparms(6)
precs(np)%aggr = pparms(7)
precs(np)%smthkind = pparms(8)
precs(np)%cmat = pparms(9)
precs(np)%smthpos = pparms(10)
precs(np)%ftype2 = pparms(11)
precs(np)%fill2 = pparms(12)
precs(np)%jswp = pparms(13)
precs(np)%nlev = pparms(14)
precs(np)%omega = omega
precs(np)%thr1 = thr1
precs(np)%thr2 = thr2
end do
call psb_bcast(icontxt,nmat)
allocate(mtrx(nmat),rhs(nmat))
do nm=1,nmat
call psb_bcast(icontxt,mtrx(nm))
call psb_bcast(icontxt,rhs(nm))
end do
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, *) ' 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 '
write(iout, *) ' prec may be: ilu diagsc none'
write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition '
end subroutine pr_usage
end program zf_bench