mld2p4/test/fileread:
Salvatore Filippone
17 years ago
parent
1584f7d8a8
commit
0baffd3e6d
@ -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);
|
|
||||||
}
|
|
||||||
@ -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
|
|
||||||
@ -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
|
|
||||||
Loading…
Reference in New Issue