Added test directory, populated with benchmark code.
Salvatore Filippone
18 years ago
parent
6742f1e24b
commit
6cb0e5cbfa
@ -0,0 +1,52 @@
|
|||||||
|
#PSBLAS_DIR=../psblas2-dev
|
||||||
|
#include $(PSBLAS_DIR)/Make.inc
|
||||||
|
#
|
||||||
|
# Libraries used
|
||||||
|
#
|
||||||
|
#LIBDIR=$(PSBLAS_DIR)/lib/
|
||||||
|
MLDDIR=../..
|
||||||
|
include $(MLDDIR)/Make.inc
|
||||||
|
PSBDIR=$(PSBLASDIR)/lib/
|
||||||
|
MLDLIBDIR=$(MLDDIR)/lib
|
||||||
|
MLD_LIB=-L$(MLDLIBDIR) -lmld_krylov -lmld_prec
|
||||||
|
PSBLAS_LIB= -L$(PSBDIR) -lpsb_util -lpsb_base
|
||||||
|
|
||||||
|
INCDIRS=-I$(MLDLIBDIR) -I$(PSBDIR)
|
||||||
|
|
||||||
|
DFOBJS=precdata.o getp.o df_bench.o enablecore.o
|
||||||
|
ZFOBJS=precdata.o getp.o zf_bench.o enablecore.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)
|
||||||
|
/bin/mv df_bench $(EXEDIR)
|
||||||
|
|
||||||
|
zf_bench: $(ZFOBJS)
|
||||||
|
$(F90LINK) $(LINKOPT) $(ZFOBJS) -o zf_bench \
|
||||||
|
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
|
||||||
|
/bin/mv zf_bench $(EXEDIR)
|
||||||
|
|
||||||
|
|
||||||
|
.f90.o:
|
||||||
|
$(MPF90) $(F90COPT) $(INCDIRS) -c $<
|
||||||
|
#mmio.o: mmio.f90
|
||||||
|
# $(MPF90) -O0 $(INCDIRS) -c $<
|
||||||
|
|
||||||
|
|
||||||
|
#$(DFLOBJS) $(ZFOBJS) $(DFOBJS):$(MODS)
|
||||||
|
|
||||||
|
clean:
|
||||||
|
/bin/rm -f $(DFOBJS) $(ZFOBJS) \
|
||||||
|
*$(.mod) $(EXEDIR)/df_bench $(EXEDIR)/zf_bench
|
||||||
|
|
||||||
|
lib:
|
||||||
|
(cd ../../; make library)
|
||||||
|
verycleanlib:
|
||||||
|
(cd ../../; make veryclean)
|
||||||
|
|
||||||
@ -0,0 +1,411 @@
|
|||||||
|
program df_bench
|
||||||
|
use getp
|
||||||
|
use precd
|
||||||
|
use psb_base_mod
|
||||||
|
use psb_util_mod
|
||||||
|
use mld_prec_mod
|
||||||
|
use psb_krylov_mod
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! input parameters
|
||||||
|
character(len=20) :: cmethd
|
||||||
|
character(len=80) :: outf1, outf2, outf3
|
||||||
|
character(len=20), allocatable :: mtrx(:),rhs(:)
|
||||||
|
type(precdata), allocatable :: precs(:)
|
||||||
|
|
||||||
|
! sparse matrices
|
||||||
|
type(psb_dspmat_type) :: a, aux_a
|
||||||
|
|
||||||
|
! preconditioner data
|
||||||
|
type(mld_dprec_type) :: pre
|
||||||
|
integer :: igsmth, matop, novr
|
||||||
|
|
||||||
|
|
||||||
|
! dense matrices
|
||||||
|
real(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
|
||||||
|
real(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||||
|
& x_col_glob(:), r_col_glob(:)
|
||||||
|
real(kind(1.d0)), pointer :: b_col_glob(:)
|
||||||
|
! communications data structure
|
||||||
|
type(psb_desc_type):: desc_a
|
||||||
|
|
||||||
|
! blacs variables
|
||||||
|
integer :: ictxt, iam, np, root
|
||||||
|
logical :: amroot, out1, out2
|
||||||
|
|
||||||
|
! solver paramters
|
||||||
|
integer :: iter, itmax, ierr, itrace, ircode, ipart,nlev,&
|
||||||
|
& methd, istopc, iprec, ml, irnum, irst, ntry, nmat, ilev,ipsize,asize,cdsize
|
||||||
|
real(kind(1.d0)) :: err, eps
|
||||||
|
|
||||||
|
character(len=5) :: afmt
|
||||||
|
character(len=20) :: name
|
||||||
|
integer :: iparm(20)
|
||||||
|
|
||||||
|
! other variables
|
||||||
|
integer :: i,info,j,m_problem, nm, nt
|
||||||
|
integer :: internal, m,ii,nnzero, nprecs, pp
|
||||||
|
real(kind(1.d0)) :: t1, t2, tprec, r_amax, b_amax,&
|
||||||
|
&scale,resmx,resmxp, mttot, mtslv, mtprec
|
||||||
|
integer :: nrhs, nrow, n_row, dim, nv, ne
|
||||||
|
integer, allocatable :: ipv(:), neigh(:), ivg(:)
|
||||||
|
|
||||||
|
|
||||||
|
call psb_init(ictxt)
|
||||||
|
call psb_info(ictxt,iam,np)
|
||||||
|
|
||||||
|
if (iam < 0) then
|
||||||
|
! This should not happen, but just in case
|
||||||
|
call psb_exit(ictxt)
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
call enablecore()
|
||||||
|
|
||||||
|
root = 0
|
||||||
|
amroot = (iam==root)
|
||||||
|
|
||||||
|
name='df_sample'
|
||||||
|
if(psb_get_errstatus() /= 0) goto 9999
|
||||||
|
info=0
|
||||||
|
call psb_set_errverbosity(2)
|
||||||
|
call psb_set_erraction(psb_act_abort_)
|
||||||
|
!!$ 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
|
||||||
|
!
|
||||||
|
call get_parms(ictxt,irst,irnum,ntry,nmat,mtrx,rhs,cmethd,nprecs,precs,&
|
||||||
|
& ipart,afmt,istopc,itmax,itrace,eps,outf1,outf2)
|
||||||
|
|
||||||
|
if(amroot) then
|
||||||
|
if(outf1 /= 'NONE') then
|
||||||
|
open(8,file=outf1,action='write')
|
||||||
|
out1=.true.
|
||||||
|
else
|
||||||
|
out1=.false.
|
||||||
|
end if
|
||||||
|
|
||||||
|
if(outf2 /= 'NONE') then
|
||||||
|
open(10,file=outf2,action='write')
|
||||||
|
out2=.true.
|
||||||
|
else
|
||||||
|
out2=.false.
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
|
||||||
|
do nm=1, nmat
|
||||||
|
|
||||||
|
if(amroot) write(*,'(25("=")," ",a20," ",25("="))')mtrx(nm)
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t1 = psb_wtime()
|
||||||
|
! read the input matrix to be processed and (possibly) the rhs
|
||||||
|
nrhs = 1
|
||||||
|
|
||||||
|
if (amroot) then
|
||||||
|
call read_mat(mtrx(nm), aux_a, ictxt)
|
||||||
|
|
||||||
|
m_problem = aux_a%m
|
||||||
|
call psb_bcast(ictxt,m_problem,root)
|
||||||
|
|
||||||
|
if(rhs(nm) /= 'none') then
|
||||||
|
! reading an rhs
|
||||||
|
call read_rhs(rhs(nm),aux_b,ictxt)
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (allocated(aux_b).and.size(aux_b,1)==m_problem) then
|
||||||
|
! if any rhs were present, broadcast the first one
|
||||||
|
b_col_glob =>aux_b(:,1)
|
||||||
|
else
|
||||||
|
allocate(aux_b(m_problem,1), stat=ircode)
|
||||||
|
if (ircode /= 0) then
|
||||||
|
call psb_errpush(4000,name)
|
||||||
|
goto 9999
|
||||||
|
endif
|
||||||
|
|
||||||
|
b_col_glob => aux_b(:,1)
|
||||||
|
do i=1, m_problem
|
||||||
|
b_col_glob(i) = 1.d0
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
call psb_bcast(ictxt,b_col_glob(1:m_problem),root)
|
||||||
|
else
|
||||||
|
call psb_bcast(ictxt,m_problem,root)
|
||||||
|
allocate(aux_b(m_problem,1), stat=ircode)
|
||||||
|
if (ircode /= 0) then
|
||||||
|
call psb_errpush(4000,name)
|
||||||
|
goto 9999
|
||||||
|
endif
|
||||||
|
b_col_glob =>aux_b(:,1)
|
||||||
|
call psb_bcast(ictxt,b_col_glob(1:m_problem),root)
|
||||||
|
end if
|
||||||
|
|
||||||
|
|
||||||
|
! switch over different partition types
|
||||||
|
if (ipart == 0) then
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
! if (amroot) write(*,'("Partition type: block")')
|
||||||
|
allocate(ivg(m_problem),ipv(np))
|
||||||
|
if (.true.) then
|
||||||
|
do i=1,m_problem
|
||||||
|
call part_block(i,m_problem,np,ipv,nv)
|
||||||
|
ivg(i) = ipv(1)
|
||||||
|
enddo
|
||||||
|
call psb_matdist(aux_a, a, ivg, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
else
|
||||||
|
call psb_matdist(aux_a, a, part_block, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
end if
|
||||||
|
else if (ipart == 2) then
|
||||||
|
if (amroot) then
|
||||||
|
call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
|
||||||
|
endif
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
call distr_mtpart(0,ictxt)
|
||||||
|
call getv_mtpart(ivg)
|
||||||
|
call psb_matdist(aux_a, a, ivg, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
call free_part(info)
|
||||||
|
else
|
||||||
|
call psb_matdist(aux_a, a, part_block, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
end if
|
||||||
|
!!$ open(20+iam)
|
||||||
|
!!$ call psb_cdprt(20+iam,desc_a,short=.false.)
|
||||||
|
!!$ close(20+iam)
|
||||||
|
!!$ write(0,*) iam,'After CDPRT '
|
||||||
|
!!$ call flush(0)
|
||||||
|
!!$ call flush(6)
|
||||||
|
!!$ call psb_barrier(ictxt)
|
||||||
|
|
||||||
|
call psb_geall(x_col,desc_a,info)
|
||||||
|
x_col(:) =0.0
|
||||||
|
call psb_geasb(x_col,desc_a,info)
|
||||||
|
call psb_geall(r_col,desc_a,info)
|
||||||
|
r_col(:) =0.0
|
||||||
|
call psb_geasb(r_col,desc_a,info)
|
||||||
|
t2 = psb_wtime() - t1
|
||||||
|
|
||||||
|
!!$ call psb_csprt(10+iam,a,head='% (A)')
|
||||||
|
call psb_sp_free(aux_a,info)
|
||||||
|
|
||||||
|
call psb_amx(ictxt, t2)
|
||||||
|
|
||||||
|
!!$ call psb_csprt(20+iam,a,head='% (A)')
|
||||||
|
!
|
||||||
|
! prepare the preconditioning matrix. note the availability
|
||||||
|
! of optional parameters
|
||||||
|
!
|
||||||
|
|
||||||
|
|
||||||
|
do pp=1, nprecs
|
||||||
|
|
||||||
|
mttot=1.d300
|
||||||
|
|
||||||
|
do nt=1,ntry
|
||||||
|
|
||||||
|
if (precs(pp)%lv2(1:2) == 'ml') then
|
||||||
|
if (precs(pp)%nlev < 2) then
|
||||||
|
write(0,*) 'Inconsistent number of levels ',precs(pp)%nlev,&
|
||||||
|
& ' forcing 2'
|
||||||
|
precs(pp)%nlev = 2
|
||||||
|
end if
|
||||||
|
nlev = precs(pp)%nlev
|
||||||
|
call mld_precinit(pre,precs(pp)%lv2,info,nlev=nlev)
|
||||||
|
! Defaults are OK for all intermediate levels. Only fix last level.
|
||||||
|
if (precs(pp)%omega>=0.0) then
|
||||||
|
call mld_precset(pre,aggr_damp_,precs(pp)%omega,info,ilev=nlev)
|
||||||
|
end if
|
||||||
|
call mld_precset(pre,ml_type_, precs(pp)%mltype, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,aggr_alg_, precs(pp)%aggr, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,coarse_mat_, precs(pp)%cmat, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,smooth_pos_, precs(pp)%smthpos, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,sub_solve_, precs(pp)%ftype2, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,aggr_kind_, precs(pp)%smthkind,info,ilev=nlev)
|
||||||
|
else
|
||||||
|
call mld_precinit(pre,precs(pp)%lv1,info)
|
||||||
|
end if
|
||||||
|
call mld_precset(pre,n_ovr_, precs(pp)%novr,info ,ilev=1)
|
||||||
|
call mld_precset(pre,sub_restr_, precs(pp)%restr,info ,ilev=1)
|
||||||
|
call mld_precset(pre,sub_prol_, precs(pp)%prol,info ,ilev=1)
|
||||||
|
call mld_precset(pre,sub_solve_, precs(pp)%ftype1,info ,ilev=1)
|
||||||
|
|
||||||
|
|
||||||
|
! setting initial guess to zero
|
||||||
|
call psb_geaxpby(dzero,b_col,dzero,x_col,desc_a,info)
|
||||||
|
|
||||||
|
! building the preconditioner
|
||||||
|
!!$ write(0,*) 'Check in main program on hasv in:',allocated(desc_a%hashv)
|
||||||
|
!!$ call flush(0)
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t1 = psb_wtime()
|
||||||
|
call mld_precbld(a,desc_a,pre,info)
|
||||||
|
tprec = psb_wtime()-t1
|
||||||
|
if (info /= 0) then
|
||||||
|
write(0,*) 'INFO from precbld ',info
|
||||||
|
call psb_error()
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
if (psb_get_errstatus() /= 0) then
|
||||||
|
write(0,*) 'INFO from precbld ',info
|
||||||
|
call psb_error()
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
!!$ write(0,*) 'Check in main program on hasv out:',allocated(desc_a%hashv)
|
||||||
|
!!$ call flush(0)
|
||||||
|
call psb_amx(ictxt,tprec)
|
||||||
|
!!$ call psb_csprt(40+iam,a,head='% (A)')
|
||||||
|
!!$ if (amroot) then
|
||||||
|
!!$ write(*,'("Matrix : ",a)') mtrx(nm)
|
||||||
|
!!$ write(*,'("RHS : ",a)') rhs(nm)
|
||||||
|
!!$ write(*,'("Method : ",a)') cmethd
|
||||||
|
!!$ write(*,'("Preconditioner : ",a)') precs(pp)%descr
|
||||||
|
!!$ call mld_prec_descr(6,pre)
|
||||||
|
!!$ call flush(6)
|
||||||
|
!!$ end if
|
||||||
|
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,&
|
||||||
|
& irst=irst,istop=istopc)
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t2 = psb_wtime() - t1
|
||||||
|
call psb_amx(ictxt,t2)
|
||||||
|
if (info/=0) then
|
||||||
|
write(0,*) 'INFO from solver ',info
|
||||||
|
call psb_errpush(4010,name,a_err='psb_SOLVER')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
!!$ write(0,*) iam,'Done Solver'
|
||||||
|
!!$ call flush(0)
|
||||||
|
!!$ call flush(6)
|
||||||
|
!!$ call psb_barrier(ictxt)
|
||||||
|
if(amroot.and.out2) &
|
||||||
|
& write(10,'(a20,2(1x,i3),1x,i5,3(1x,g9.4),1x,a8,1x,a)') &
|
||||||
|
& mtrx(nm),np,precs(pp)%novr,iter,tprec,t2,t2+tprec,&
|
||||||
|
& trim(cmethd),trim(precs(pp)%descr)
|
||||||
|
if(amroot) &
|
||||||
|
& write(0,'(a20,2(1x,i3),1x,i5,3(1x,g9.4),1x,a8,1x,a)') &
|
||||||
|
& mtrx(nm),np,precs(pp)%novr,iter,tprec,t2,t2+tprec,&
|
||||||
|
& trim(cmethd),trim(precs(pp)%descr)
|
||||||
|
call flush(0)
|
||||||
|
if (nt.lt.ntry) call mld_precfree(pre,info)
|
||||||
|
if((t2+tprec).lt.mttot) then
|
||||||
|
mtslv=t2
|
||||||
|
mtprec=tprec
|
||||||
|
mttot=t2+tprec
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
!!$ call psb_csprt(50+iam,a,head='% (A)')
|
||||||
|
!!$ write(0,*) 'Check hashv after precfree:',allocated(desc_a%hashv)
|
||||||
|
!!$ call flush(0)
|
||||||
|
|
||||||
|
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_genrm2s(resmx,r_col,desc_a,info)
|
||||||
|
call psb_geamaxs(resmxp,r_col,desc_a,info)
|
||||||
|
|
||||||
|
ipsize = mld_sizeof(pre)
|
||||||
|
asize = psb_sizeof(a)
|
||||||
|
cdsize = psb_sizeof(desc_a)
|
||||||
|
call psb_sum(ictxt,ipsize)
|
||||||
|
call psb_sum(ictxt,asize)
|
||||||
|
call psb_sum(ictxt,cdsize)
|
||||||
|
|
||||||
|
if (amroot) then
|
||||||
|
write(*,'("Matrix : ",a)') mtrx(nm)
|
||||||
|
write(*,'("RHS : ",a)') rhs(nm)
|
||||||
|
write(*,'("Method : ",a)') cmethd
|
||||||
|
write(*,'("Preconditioner : ",a)') precs(pp)%descr
|
||||||
|
call mld_prec_descr(pre)
|
||||||
|
write(*,'("Computed solution on ",i4," processors")')np
|
||||||
|
write(*,'(" ")')
|
||||||
|
write(*,'("Iterations to convergence: ",i6)') iter
|
||||||
|
write(*,'("Error indicator on exit : ",g9.4)') err
|
||||||
|
write(*,'("Time to buil prec. : ",es10.4)')mtprec
|
||||||
|
write(*,'("Time to solve matrix : ",es10.4)')mtslv
|
||||||
|
write(*,'("Time per iteration : ",es10.4)')mtslv/(iter)
|
||||||
|
write(*,'("Total time : ",es10.4)')mttot
|
||||||
|
write(*,'("Residual norm 2 : ",es10.4)')resmx
|
||||||
|
write(*,'("Residual norm inf : ",es10.4)')resmxp
|
||||||
|
write(*,'("Total memory occupation for A: ",i10)')asize
|
||||||
|
write(*,'("Total memory occupation for DESC_A: ",i10)')cdsize
|
||||||
|
write(*,'("Total memory occupation for PRE: ",i10)')ipsize
|
||||||
|
|
||||||
|
write(*,'(72("="))')
|
||||||
|
write(*,'(" ")')
|
||||||
|
write(*,'(" ")')
|
||||||
|
write(*,'(" ")')
|
||||||
|
|
||||||
|
if(out1) write(8,'(a20,2(1x,i3),1x,i5,5(1x,g9.4),1x,a8,1x,a)') mtrx(nm),&
|
||||||
|
& np,precs(pp)%novr,&
|
||||||
|
& iter,mtprec,mtslv,mttot,resmx,resmxp,&
|
||||||
|
& trim(cmethd),trim(precs(pp)%descr)
|
||||||
|
end if
|
||||||
|
|
||||||
|
call mld_precfree(pre,info)
|
||||||
|
|
||||||
|
if (.false.) then
|
||||||
|
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,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")')
|
||||||
|
write(outf3,'(a,a,a)')trim(mtrx(nm)),'.psb_sol.',&
|
||||||
|
& tolower(trim(precs(pp)%descr))
|
||||||
|
open(20,file=outf3)
|
||||||
|
write(20,*) 'matrix: ',mtrx(nm)
|
||||||
|
write(20,*) 'computed solution on ',np,' processors.'
|
||||||
|
write(20,*) 'iterations to convergence: ',iter
|
||||||
|
write(20,*) 'error indicator (infinity norm) on exit:', &
|
||||||
|
& ' ||r||/(||a||||x||+||b||) = ',err
|
||||||
|
write(20,*) 'max residual = ',resmx, resmxp
|
||||||
|
do i=1,m_problem
|
||||||
|
write(20,998) i,x_col_glob(i),b_col_glob(i)
|
||||||
|
enddo
|
||||||
|
close(20)
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
998 format(i8,4(2x,g20.14))
|
||||||
|
993 format(i6,4(1x,e12.6))
|
||||||
|
|
||||||
|
|
||||||
|
!!$ if (pp == 1) call psb_csprt(40+iam,a,head='% (A)')
|
||||||
|
end do
|
||||||
|
|
||||||
|
call psb_gefree(b_col, desc_a,info)
|
||||||
|
call psb_gefree(x_col, desc_a,info)
|
||||||
|
call psb_spfree(a, desc_a,info)
|
||||||
|
write(0,*) 'Final cdfree'
|
||||||
|
call flush(0)
|
||||||
|
call psb_cdfree(desc_a,info)
|
||||||
|
deallocate(r_col,stat=info)
|
||||||
|
deallocate(aux_b,stat=info)
|
||||||
|
if (ipart==0) then
|
||||||
|
deallocate(ivg,ipv,stat=info)
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
|
||||||
|
9999 continue
|
||||||
|
if(info /= 0) then
|
||||||
|
call psb_error(ictxt)
|
||||||
|
end if
|
||||||
|
call psb_exit(ictxt)
|
||||||
|
stop
|
||||||
|
|
||||||
|
end program df_bench
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,23 @@
|
|||||||
|
#include <sys/resource.h>
|
||||||
|
#include <unistd.h>
|
||||||
|
#include <signal.h>
|
||||||
|
|
||||||
|
#ifdef Add_
|
||||||
|
#define enablecore enablecore_
|
||||||
|
#endif
|
||||||
|
#ifdef AddDouble_
|
||||||
|
#define enablecore enablecore_
|
||||||
|
#endif
|
||||||
|
#ifdef UpCase
|
||||||
|
#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);
|
||||||
|
}
|
||||||
@ -0,0 +1,206 @@
|
|||||||
|
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,cmethd,nprecs,precs,ipart,&
|
||||||
|
& afmt,istopc,itmax,itrace,eps,outf1,outf2)
|
||||||
|
|
||||||
|
use psb_base_mod
|
||||||
|
use precd
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: icontxt
|
||||||
|
character(len=20) :: cmethd
|
||||||
|
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(kind(1.d0)) :: eps, omega
|
||||||
|
character :: afmt*5, lv1*10, lv2*10, pdescr*40
|
||||||
|
integer :: iam, nm, np, i, idx
|
||||||
|
integer, parameter :: npparms=12
|
||||||
|
integer :: inparms(40), ip, pparms(npparms)
|
||||||
|
|
||||||
|
call psb_info(icontxt,iam,np)
|
||||||
|
|
||||||
|
if (iam==0) then
|
||||||
|
! read input parameters
|
||||||
|
read(*,*) outf1
|
||||||
|
read(*,*) outf2
|
||||||
|
read(*,*) cmethd
|
||||||
|
read(*,*) eps
|
||||||
|
read(*,*) afmt
|
||||||
|
|
||||||
|
call psb_bcast(icontxt,cmethd)
|
||||||
|
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),0)
|
||||||
|
|
||||||
|
call psb_bcast(icontxt,nprecs,0)
|
||||||
|
|
||||||
|
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:))
|
||||||
|
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),0)
|
||||||
|
call psb_bcast(icontxt,omega,0)
|
||||||
|
|
||||||
|
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)%mltype = pparms(5)
|
||||||
|
precs(np)%aggr = pparms(6)
|
||||||
|
precs(np)%smthkind = pparms(7)
|
||||||
|
precs(np)%cmat = pparms(8)
|
||||||
|
precs(np)%smthpos = pparms(9)
|
||||||
|
precs(np)%ftype2 = pparms(10)
|
||||||
|
precs(np)%jswp = pparms(11)
|
||||||
|
precs(np)%nlev = pparms(12)
|
||||||
|
precs(np)%omega = omega
|
||||||
|
end do
|
||||||
|
|
||||||
|
read(*,*) nmat
|
||||||
|
call psb_bcast(icontxt,nmat,0)
|
||||||
|
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,cmethd)
|
||||||
|
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)
|
||||||
|
|
||||||
|
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)%mltype = pparms(5)
|
||||||
|
precs(np)%aggr = pparms(6)
|
||||||
|
precs(np)%smthkind = pparms(7)
|
||||||
|
precs(np)%cmat = pparms(8)
|
||||||
|
precs(np)%smthpos = pparms(9)
|
||||||
|
precs(np)%ftype2 = pparms(10)
|
||||||
|
precs(np)%jswp = pparms(11)
|
||||||
|
precs(np)%nlev = pparms(12)
|
||||||
|
precs(np)%omega = omega
|
||||||
|
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, *) ' prec may be: ilu diagsc none'
|
||||||
|
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
|
||||||
@ -0,0 +1,22 @@
|
|||||||
|
module precd
|
||||||
|
|
||||||
|
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 :: 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 :: jswp ! jacobi sweeps
|
||||||
|
real(kind(1.d0)) :: omega ! smoother omega
|
||||||
|
character(len=40) :: descr ! verbose description of the prec
|
||||||
|
end type precdata
|
||||||
|
|
||||||
|
end module precd
|
||||||
@ -0,0 +1,84 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
#
|
||||||
|
#
|
||||||
|
# NUmber of attempts for each configuration
|
||||||
|
ntry=1
|
||||||
|
|
||||||
|
|
||||||
|
date=`date +%Y%m%d%H%M%S`
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
for np in $*
|
||||||
|
do
|
||||||
|
|
||||||
|
# 3rd batch: 14bis,64bis 4 sweeps
|
||||||
|
echo "mpirun -np $np -machinefile locm df_bench >>log.part$part.ren$renum.${np}p"
|
||||||
|
#/usr/local/mpich-gcc42/bin/mpirun -np $np -machinefile locm df_bench <<EOF
|
||||||
|
/usr/local/mpich-gcc42/bin/mpirun -np $np -machinefile locm df_bench >>run.gfc.kiva.log.${np}p.$date 2>err.gfc.kiva.log.${np}p.$date <<EOF
|
||||||
|
out.${np}p.$date Out file 1: summary
|
||||||
|
stat.${np}p.$date Out file 2: detailed for statistics
|
||||||
|
BICGSTAB iterative method to use
|
||||||
|
1.D-6 EPS
|
||||||
|
CSR Matrix format
|
||||||
|
0 IPART: Partition method: 0: BLOCK 1: BLK2 2:GRAPH
|
||||||
|
00250 ITMAX
|
||||||
|
-1 ITRACE
|
||||||
|
2 ISTOPC 1: NBE Infty 2: |r|2/|b|2
|
||||||
|
30 IRST Restart parameter for GMRES and BiCGSTAB(L)
|
||||||
|
0 RENUM: 0: none 1: global indices (2: GPS band reduction)
|
||||||
|
$ntry NTRY for each comb. print out best timings
|
||||||
|
30 NPRCS/nov rstr prol fty1 mlty agg smth cm smp fty2 jswp nl omg
|
||||||
|
noprec none 0 0 0 0 0 0 0 0 0 0 0 1 -1.0 NOPREC
|
||||||
|
diag none 0 0 0 1 2 0 1 0 2 1 4 1 -1.0 DIAG
|
||||||
|
bjac none 0 0 0 1 2 0 1 0 2 1 4 1 -1.0 BJAC
|
||||||
|
as none 0 1 0 1 2 0 1 0 2 1 4 1 -1.0 RAS
|
||||||
|
as none 1 1 0 1 2 0 1 0 2 1 4 1 -1.0 RAS
|
||||||
|
as none 2 1 0 1 2 0 1 0 2 1 4 1 -1.0 RAS
|
||||||
|
as ml 0 1 0 1 2 0 1 0 2 1 4 2 -1.0 2L-M-RAS-I-D4
|
||||||
|
as ml 1 1 0 1 2 0 1 0 2 1 4 2 -1.0 2L-M-RAS-I-D4
|
||||||
|
as ml 2 1 0 1 2 0 1 0 2 1 4 2 -1.0 2L-M-RAS-I-D4
|
||||||
|
as ml 0 1 0 1 2 0 1 0 2 5 4 2 -1.0 2L-M-RAS-U-D4
|
||||||
|
as ml 1 1 0 1 2 0 1 0 2 5 4 2 -1.0 2L-M-RAS-U-D4
|
||||||
|
as ml 2 1 0 1 2 0 1 0 2 5 4 2 -1.0 2L-M-RAS-U-D4
|
||||||
|
as ml 0 1 0 1 2 0 1 0 2 1 4 3 -1.0 3L-M-RAS-I-D4
|
||||||
|
as ml 1 1 0 1 2 0 1 0 2 1 4 3 -1.0 3L-M-RAS-I-D4
|
||||||
|
as ml 2 1 0 1 2 0 1 0 2 1 4 3 -1.0 3L-M-RAS-I-D4
|
||||||
|
as ml 0 1 0 1 2 0 1 0 2 5 4 3 -1.0 3L-M-RAS-U-D4
|
||||||
|
as ml 1 1 0 1 2 0 1 0 2 5 4 3 -1.0 3L-M-RAS-U-D4
|
||||||
|
as ml 2 1 0 1 2 0 1 0 2 5 4 3 -1.0 3L-M-RAS-U-D4
|
||||||
|
as ml 0 1 0 1 2 0 1 1 2 1 1 2 -1.0 2L-M-RAS-I-R
|
||||||
|
as ml 1 1 0 1 2 0 1 1 2 1 1 2 -1.0 2L-M-RAS-I-R
|
||||||
|
as ml 2 1 0 1 2 0 1 1 2 1 1 2 -1.0 2L-M-RAS-I-R
|
||||||
|
as ml 0 1 0 1 2 0 1 1 2 5 1 2 -1.0 2L-M-RAS-U-R
|
||||||
|
as ml 1 1 0 1 2 0 1 1 2 5 1 2 -1.0 2L-M-RAS-U-R
|
||||||
|
as ml 2 1 0 1 2 0 1 1 2 5 1 2 -1.0 2L-M-RAS-U-R
|
||||||
|
as ml 0 1 0 1 2 0 1 1 2 1 1 3 -1.0 3L-M-RAS-I-R
|
||||||
|
as ml 1 1 0 1 2 0 1 1 2 1 1 3 -1.0 3L-M-RAS-I-R
|
||||||
|
as ml 2 1 0 1 2 0 1 1 2 1 1 3 -1.0 3L-M-RAS-I-R
|
||||||
|
as ml 0 1 0 1 2 0 1 1 2 5 1 3 -1.0 3L-M-RAS-U-R
|
||||||
|
as ml 1 1 0 1 2 0 1 1 2 5 1 3 -1.0 3L-M-RAS-U-R
|
||||||
|
as ml 2 1 0 1 2 0 1 1 2 5 1 3 -1.0 3L-M-RAS-U-R
|
||||||
|
2 Number of matrices
|
||||||
|
thm50x30.mtx none
|
||||||
|
thm200x120.mtx none
|
||||||
|
thm1000x600.mtx none
|
||||||
|
a400x400.mtx b400.mtx
|
||||||
|
kivap004.mtx none
|
||||||
|
kivap001.mtx none
|
||||||
|
kivap007.mtx none
|
||||||
|
!!! preconditioner templates
|
||||||
|
bja none 0 0 0 0 0 0 0 0 0 0 0 0.0 Block Jacobi
|
||||||
|
none none 0 0 0 0 0 0 0 0 0 0 0 0.1 No preconditioner
|
||||||
|
diagsc none 0 0 0 0 0 0 0 0 0 0 0 0.0 Diagonal scaling
|
||||||
|
as none 1 4 1 0 0 0 0 0 0 0 0 0.0 Additive Schwarz 1 overlap
|
||||||
|
as none 1 4 0 0 0 0 0 0 0 0 0 0.0 Restricted Additive Schwarz 1 overlap
|
||||||
|
EOF
|
||||||
|
|
||||||
|
cat out.${np}p.$date >>dat.out.kiva.$date
|
||||||
|
cat stat.${np}p.$date >>dat.stat.kiva.$date
|
||||||
|
|
||||||
|
done
|
||||||
|
|
||||||
|
|
||||||
@ -0,0 +1,342 @@
|
|||||||
|
program zf_bench
|
||||||
|
use precd
|
||||||
|
use getp
|
||||||
|
use psb_base_mod
|
||||||
|
use psb_util_mod
|
||||||
|
use mld_prec_mod
|
||||||
|
use psb_krylov_mod
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
! input parameters
|
||||||
|
character(len=20) :: cmethd
|
||||||
|
character(len=80) :: outf1, outf2, outf3
|
||||||
|
character(len=20), allocatable :: mtrx(:),rhs(:)
|
||||||
|
type(precdata), allocatable :: precs(:)
|
||||||
|
|
||||||
|
|
||||||
|
! sparse matrices
|
||||||
|
type(psb_zspmat_type) :: a, aux_a
|
||||||
|
|
||||||
|
! preconditioner data
|
||||||
|
type(mld_zprec_type) :: pre
|
||||||
|
integer :: igsmth, matop, novr
|
||||||
|
|
||||||
|
! dense matrices
|
||||||
|
complex(kind(1.d0)), allocatable, target :: aux_b(:,:), d(:)
|
||||||
|
complex(kind(1.d0)), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||||
|
& x_col_glob(:), r_col_glob(:)
|
||||||
|
complex(kind(1.d0)), pointer :: b_col_glob(:)
|
||||||
|
|
||||||
|
! communications data structure
|
||||||
|
type(psb_desc_type):: desc_a
|
||||||
|
|
||||||
|
! blacs variables
|
||||||
|
integer :: ictxt, iam, np, root
|
||||||
|
logical :: amroot, out1, out2
|
||||||
|
|
||||||
|
! solver paramters
|
||||||
|
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
|
||||||
|
& methd, istopc, iprec, ml, irnum, irst, ntry, nmat, ilev,nlev
|
||||||
|
real(kind(1.d0)) :: err, eps
|
||||||
|
|
||||||
|
character(len=5) :: afmt
|
||||||
|
character(len=20) :: name
|
||||||
|
integer :: iparm(20)
|
||||||
|
|
||||||
|
! other variables
|
||||||
|
integer :: i,info,j,m_problem, nm, nt
|
||||||
|
integer :: internal, m,ii,nnzero, nprecs, pp
|
||||||
|
real(kind(1.d0)) :: t1, t2, tprec, r_amax, b_amax,&
|
||||||
|
&scale,resmx,resmxp, mttot, mtslv, mtprec
|
||||||
|
integer :: nrhs, nrow, n_row, dim, nv, ne
|
||||||
|
integer, allocatable :: ipv(:), neigh(:), ivg(:)
|
||||||
|
|
||||||
|
|
||||||
|
call psb_init(ictxt)
|
||||||
|
call psb_info(ictxt,iam,np)
|
||||||
|
|
||||||
|
if (iam < 0) then
|
||||||
|
! This should not happen, but just in case
|
||||||
|
call psb_exit(ictxt)
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
|
||||||
|
call enablecore()
|
||||||
|
|
||||||
|
root = 0
|
||||||
|
amroot = (iam==root)
|
||||||
|
|
||||||
|
name='df_sample'
|
||||||
|
if(psb_get_errstatus() /= 0) goto 9999
|
||||||
|
info=0
|
||||||
|
call psb_set_errverbosity(2)
|
||||||
|
call psb_set_erraction(psb_act_abort_)
|
||||||
|
!
|
||||||
|
! get parameters
|
||||||
|
!
|
||||||
|
call get_parms(ictxt,irst,irnum,ntry,nmat,mtrx,rhs,cmethd,nprecs,precs,&
|
||||||
|
& ipart,afmt,istopc,itmax,itrace,eps,outf1,outf2)
|
||||||
|
|
||||||
|
if(amroot) then
|
||||||
|
if(outf1 /= 'NONE') then
|
||||||
|
open(8,file=outf1,action='write')
|
||||||
|
out1=.true.
|
||||||
|
else
|
||||||
|
out1=.false.
|
||||||
|
end if
|
||||||
|
|
||||||
|
if(outf2 /= 'NONE') then
|
||||||
|
open(10,file=outf2,action='write')
|
||||||
|
out2=.true.
|
||||||
|
else
|
||||||
|
out2=.false.
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
|
||||||
|
do nm=1, nmat
|
||||||
|
|
||||||
|
if(amroot) write(*,'(25("=")," ",a20," ",25("="))')mtrx(nm)
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t1 = psb_wtime()
|
||||||
|
! read the input matrix to be processed and (possibly) the rhs
|
||||||
|
nrhs = 1
|
||||||
|
|
||||||
|
if (amroot) then
|
||||||
|
call read_mat(mtrx(nm), aux_a, ictxt)
|
||||||
|
|
||||||
|
m_problem = aux_a%m
|
||||||
|
call psb_bcast(ictxt,m_problem,root)
|
||||||
|
|
||||||
|
if(rhs(nm) /= 'none') then
|
||||||
|
! reading an rhs
|
||||||
|
call read_rhs(rhs(nm),aux_b,ictxt)
|
||||||
|
end if
|
||||||
|
|
||||||
|
if (allocated(aux_b).and.size(aux_b,1)==m_problem) then
|
||||||
|
! if any rhs were present, broadcast the first one
|
||||||
|
b_col_glob =>aux_b(:,1)
|
||||||
|
else
|
||||||
|
allocate(aux_b(m_problem,1), stat=ircode)
|
||||||
|
if (ircode /= 0) then
|
||||||
|
call psb_errpush(4000,name)
|
||||||
|
goto 9999
|
||||||
|
endif
|
||||||
|
|
||||||
|
b_col_glob => aux_b(:,1)
|
||||||
|
do i=1, m_problem
|
||||||
|
b_col_glob(i) = 1.d0
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
call psb_bcast(ictxt,b_col_glob(1:m_problem),root)
|
||||||
|
else
|
||||||
|
call psb_bcast(ictxt,m_problem,root)
|
||||||
|
allocate(aux_b(m_problem,1), stat=ircode)
|
||||||
|
if (ircode /= 0) then
|
||||||
|
call psb_errpush(4000,name)
|
||||||
|
goto 9999
|
||||||
|
endif
|
||||||
|
b_col_glob =>aux_b(:,1)
|
||||||
|
call psb_bcast(ictxt,b_col_glob(1:m_problem),root)
|
||||||
|
end if
|
||||||
|
|
||||||
|
! switch over different partition types
|
||||||
|
if (ipart == 0) then
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
! if (amroot) write(*,'("Partition type: block")')
|
||||||
|
allocate(ivg(m_problem),ipv(np))
|
||||||
|
do i=1,m_problem
|
||||||
|
call part_block(i,m_problem,np,ipv,nv)
|
||||||
|
ivg(i) = ipv(1)
|
||||||
|
enddo
|
||||||
|
call psb_matdist(aux_a, a, ivg, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
else if (ipart == 2) then
|
||||||
|
if (amroot) then
|
||||||
|
call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
|
||||||
|
endif
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
call distr_mtpart(0,ictxt)
|
||||||
|
call getv_mtpart(ivg)
|
||||||
|
call psb_matdist(aux_a, a, ivg, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
call free_part(info)
|
||||||
|
else
|
||||||
|
call psb_matdist(aux_a, a, part_block, ictxt, &
|
||||||
|
& desc_a,b_col_glob,b_col,info,fmt=afmt)
|
||||||
|
end if
|
||||||
|
|
||||||
|
call psb_geall(x_col,desc_a,info)
|
||||||
|
x_col(:) =0.0
|
||||||
|
call psb_geasb(x_col,desc_a,info)
|
||||||
|
call psb_geall(r_col,desc_a,info)
|
||||||
|
r_col(:) =0.0
|
||||||
|
call psb_geasb(r_col,desc_a,info)
|
||||||
|
t2 = psb_wtime() - t1
|
||||||
|
|
||||||
|
!!$ call psb_csprt(10+iam,a,head='% (A)')
|
||||||
|
call psb_sp_free(aux_a,info)
|
||||||
|
|
||||||
|
call psb_amx(ictxt, t2)
|
||||||
|
|
||||||
|
!!$ call psb_csprt(20+iam,a,head='% (A)')
|
||||||
|
!
|
||||||
|
! prepare the preconditioning matrix. note the availability
|
||||||
|
! of optional parameters
|
||||||
|
!
|
||||||
|
|
||||||
|
|
||||||
|
do pp=1, nprecs
|
||||||
|
|
||||||
|
mttot=1.d300
|
||||||
|
|
||||||
|
do nt=1,ntry
|
||||||
|
|
||||||
|
if (precs(pp)%lv2(1:2) == 'ml') then
|
||||||
|
if (precs(pp)%nlev < 2) then
|
||||||
|
write(0,*) 'Inconsistent number of levels ',precs(pp)%nlev,&
|
||||||
|
& ' forcing 2'
|
||||||
|
precs(pp)%nlev = 2
|
||||||
|
end if
|
||||||
|
nlev = precs(pp)%nlev
|
||||||
|
call mld_precinit(pre,precs(pp)%lv2,info,nlev=nlev)
|
||||||
|
! Defaults are OK for all intermediate levels. Only fix last level.
|
||||||
|
if (precs(pp)%omega>=0.0) then
|
||||||
|
call mld_precset(pre,aggr_damp_,precs(pp)%omega,info,ilev=nlev)
|
||||||
|
end if
|
||||||
|
call mld_precset(pre,ml_type_, precs(pp)%mltype, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,aggr_alg_, precs(pp)%aggr, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,coarse_mat_, precs(pp)%cmat, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,smooth_pos_, precs(pp)%smthpos, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,sub_solve_, precs(pp)%ftype2, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
|
||||||
|
call mld_precset(pre,aggr_kind_, precs(pp)%smthkind,info,ilev=nlev)
|
||||||
|
else
|
||||||
|
call mld_precinit(pre,precs(pp)%lv1,info)
|
||||||
|
end if
|
||||||
|
call mld_precset(pre,n_ovr_, precs(pp)%novr,info ,ilev=1)
|
||||||
|
call mld_precset(pre,sub_restr_, precs(pp)%restr,info ,ilev=1)
|
||||||
|
call mld_precset(pre,sub_prol_, precs(pp)%prol,info ,ilev=1)
|
||||||
|
call mld_precset(pre,sub_solve_, precs(pp)%ftype1,info ,ilev=1)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
! setting initial guess to zero
|
||||||
|
call psb_geaxpby(zzero,b_col,zzero,x_col,desc_a,info)
|
||||||
|
|
||||||
|
! building the preconditioner
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t1 = psb_wtime()
|
||||||
|
call mld_precbld(a,desc_a,pre,info)
|
||||||
|
tprec = psb_wtime()-t1
|
||||||
|
if (info /= 0) then
|
||||||
|
write(0,*) 'INFO from precbld ',info
|
||||||
|
call psb_error()
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
|
||||||
|
|
||||||
|
call psb_amx(ictxt,tprec)
|
||||||
|
!!$ call psb_csprt(40+iam,a,head='% (A)')
|
||||||
|
!!$ if (amroot) then
|
||||||
|
!!$ write(*,'("Matrix : ",a)') mtrx(nm)
|
||||||
|
!!$ write(*,'("RHS : ",a)') rhs(nm)
|
||||||
|
!!$ write(*,'("Method : ",a)') cmethd
|
||||||
|
!!$ write(*,'("Preconditioner : ",a)') precs(pp)%descr
|
||||||
|
!!$ call mld_prec_descr(6,pre)
|
||||||
|
!!$ end if
|
||||||
|
iparm = 0
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t1 = psb_wtime()
|
||||||
|
call psb_krylov(cmethd,a,pre,b_col,x_col,eps,desc_a,info,&
|
||||||
|
& itmax,iter,err,itrace,irst=ml,istop=istopc)
|
||||||
|
|
||||||
|
call psb_barrier(ictxt)
|
||||||
|
t2 = psb_wtime() - t1
|
||||||
|
call psb_amx(ictxt,t2)
|
||||||
|
if (info/=0) then
|
||||||
|
write(0,*) 'INFO from solver ',info
|
||||||
|
call psb_errpush(4010,name,a_err='psb_SOLVER')
|
||||||
|
goto 9999
|
||||||
|
end if
|
||||||
|
!!$ write(0,*) iam,'Done Solver'
|
||||||
|
!!$ call flush(0)
|
||||||
|
!!$ call flush(6)
|
||||||
|
!!$ call psb_barrier(ictxt)
|
||||||
|
if(amroot.and.out2) &
|
||||||
|
& write(10,'(a20,2(1x,i3),1x,i5,3(1x,g9.4),1x,a)') &
|
||||||
|
& mtrx(nm),np,precs(pp)%novr,iter,tprec,t2,t2+tprec,&
|
||||||
|
& trim(precs(pp)%descr)
|
||||||
|
if(amroot) &
|
||||||
|
& write(0,'(a20,2(1x,i3),1x,i5,3(1x,g9.4),1x,a)') &
|
||||||
|
& mtrx(nm),np,precs(pp)%novr,iter,tprec,t2,t2+tprec,&
|
||||||
|
& trim(precs(pp)%descr)
|
||||||
|
|
||||||
|
if(nt.lt.ntry) call mld_precfree(pre,info)
|
||||||
|
if((t2+tprec).lt.mttot) then
|
||||||
|
mtslv=t2
|
||||||
|
mtprec=tprec
|
||||||
|
mttot=t2+tprec
|
||||||
|
end if
|
||||||
|
|
||||||
|
end do
|
||||||
|
!!$ call psb_csprt(50+iam,a,head='% (A)')
|
||||||
|
|
||||||
|
call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info)
|
||||||
|
call psb_spmm(-zone,a,x_col,zone,r_col,desc_a,info)
|
||||||
|
call psb_genrm2s(resmx,r_col,desc_a,info)
|
||||||
|
call psb_geamaxs(resmxp,r_col,desc_a,info)
|
||||||
|
|
||||||
|
if (amroot) then
|
||||||
|
write(*,'("Matrix : ",a)') mtrx(nm)
|
||||||
|
write(*,'("RHS : ",a)') rhs(nm)
|
||||||
|
write(*,'("Method : ",a)') cmethd
|
||||||
|
write(*,'("Preconditioner : ",a)') precs(pp)%descr
|
||||||
|
call mld_prec_descr(pre)
|
||||||
|
write(*,'("Computed solution on ",i4," processors")')np
|
||||||
|
write(*,'(" ")')
|
||||||
|
write(*,'("Iterations to convergence: ",i6)') iter
|
||||||
|
write(*,'("Error indicator on exit : ",g9.4)') err
|
||||||
|
write(*,'("Time to buil prec. : ",es10.4)')mtprec
|
||||||
|
write(*,'("Time to solve matrix : ",es10.4)')mtslv
|
||||||
|
write(*,'("Time per iteration : ",es10.4)')mtslv/(iter)
|
||||||
|
write(*,'("Total time : ",es10.4)')mttot
|
||||||
|
write(*,'("Residual norm 2 : ",es10.4)')resmx
|
||||||
|
write(*,'("Residual norm inf : ",es10.4)')resmxp
|
||||||
|
write(*,'(72("="))')
|
||||||
|
write(*,'(" ")')
|
||||||
|
write(*,'(" ")')
|
||||||
|
write(*,'(" ")')
|
||||||
|
|
||||||
|
if(out1) write(8,'(a20,2(1x,i3),1x,i5,5(1x,g9.4),1x,a)') mtrx(nm),&
|
||||||
|
& np,precs(pp)%novr,&
|
||||||
|
& iter,mtprec,mtslv,mttot,resmx,resmxp,trim(precs(pp)%descr)
|
||||||
|
end if
|
||||||
|
|
||||||
|
call mld_precfree(pre,info)
|
||||||
|
|
||||||
|
end do
|
||||||
|
|
||||||
|
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_cdfree(desc_a,info)
|
||||||
|
deallocate(r_col,stat=info)
|
||||||
|
deallocate(aux_b,stat=info)
|
||||||
|
if (ipart==0) then
|
||||||
|
deallocate(ivg,ipv,stat=info)
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
|
||||||
|
9999 continue
|
||||||
|
if(info /= 0) then
|
||||||
|
call psb_error(ictxt)
|
||||||
|
end if
|
||||||
|
call psb_exit(ictxt)
|
||||||
|
stop
|
||||||
|
|
||||||
|
end program zf_bench
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Loading…
Reference in New Issue