mld2p4-2:

tests/fileread/Makefile
 tests/fileread/cf_sample.f90
 tests/fileread/df_sample.f90
 tests/fileread/mld_cf_sample.f90
 tests/fileread/mld_df_sample.f90
 tests/fileread/mld_sf_sample.f90
 tests/fileread/mld_zf_sample.f90
 tests/fileread/runs/dfs.inp
 tests/fileread/sf_sample.f90
 tests/fileread/zf_sample.f90
 tests/pdegen/Makefile
 tests/pdegen/mld_d_pde2d.f90
 tests/pdegen/mld_d_pde3d.f90
 tests/pdegen/mld_s_pde2d.f90
 tests/pdegen/mld_s_pde3d.f90
 tests/pdegen/ppde2d.f90
 tests/pdegen/ppde3d.f90
 tests/pdegen/runs/ppde.inp
 tests/pdegen/spde2d.f90
 tests/pdegen/spde3d.f90

Templated versions of test files.
stopcriterion
Salvatore Filippone 9 years ago
parent 9b78d1b298
commit 0ed50c075b

@ -7,58 +7,46 @@ MLDLIBDIR=$(MLDDIR)/lib
MLD_LIB=-L$(MLDLIBDIR) -lpsb_krylov -lmld_prec -lpsb_prec MLD_LIB=-L$(MLDLIBDIR) -lpsb_krylov -lmld_prec -lpsb_prec
PSBLAS_LIB= -L$(PSBLIBDIR) -lpsb_util -lpsb_base PSBLAS_LIB= -L$(PSBLIBDIR) -lpsb_util -lpsb_base
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDINCDIR) $(FMFLAG)$(PSBINCDIR) $(FIFLAG). FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDINCDIR) $(FMFLAG)$(PSBINCDIR) $(FIFLAG).
DFSAYAOBJS=df-sample_aya.o data_input.o
DFSAOBJS=df_sample_alya.o data_input.o DFSOBJS=mld_df_sample.o data_input.o
DFSOBJS=df_sample.o data_input.o SFSOBJS=mld_sf_sample.o data_input.o
SFSOBJS=sf_sample.o data_input.o CFSOBJS=mld_cf_sample.o data_input.o
CFSOBJS=cf_sample.o data_input.o ZFSOBJS=mld_zf_sample.o data_input.o
ZFSOBJS=zf_sample.o data_input.o
EXEDIR=./runs EXEDIR=./runs
all: sf_sample df_sample cf_sample zf_sample all: mld_sf_sample mld_df_sample mld_cf_sample mld_zf_sample
df-sample_aya: df-sample_aya.o mld_df_sample: $(DFSOBJS)
$(F90LINK) $(LINKOPT) $(DFSAYAOBJS) -o df-sample_aya \ $(F90LINK) $(LINKOPT) $(DFSOBJS) -o mld_df_sample \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv df-sample_aya $(EXEDIR)
df_sample: $(DFSOBJS)
$(F90LINK) $(LINKOPT) $(DFSOBJS) -o df_sample \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv df_sample $(EXEDIR) /bin/mv mld_df_sample $(EXEDIR)
df_sample_alya: $(DFSAOBJS)
$(F90LINK) $(LINKOPT) $(DFSAOBJS) -o df_sample_alya \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv df_sample_alya $(EXEDIR)
sf_sample: $(SFSOBJS) mld_sf_sample: $(SFSOBJS)
$(F90LINK) $(LINKOPT) $(SFSOBJS) -o sf_sample \ $(F90LINK) $(LINKOPT) $(SFSOBJS) -o mld_sf_sample \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv sf_sample $(EXEDIR) /bin/mv mld_sf_sample $(EXEDIR)
cf_sample: $(CFSOBJS) mld_cf_sample: $(CFSOBJS)
$(F90LINK) $(LINKOPT) $(CFSOBJS) -o cf_sample \ $(F90LINK) $(LINKOPT) $(CFSOBJS) -o mld_cf_sample \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv cf_sample $(EXEDIR) /bin/mv mld_cf_sample $(EXEDIR)
zf_sample: $(ZFSOBJS) mld_zf_sample: $(ZFSOBJS)
$(F90LINK) $(LINKOPT) $(ZFSOBJS) -o zf_sample \ $(F90LINK) $(LINKOPT) $(ZFSOBJS) -o mld_zf_sample \
$(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv zf_sample $(EXEDIR) /bin/mv mld_zf_sample $(EXEDIR)
sf_sample.o: data_input.o
df_sample.o: data_input.o
cf_sample.o: data_input.o
zf_sample.o: data_input.o
df-sample_aya.o:data_input.o
df_sample_alya.o: data_input.o mld_sf_sample.o: data_input.o
mld_df_sample.o: data_input.o
mld_cf_sample.o: data_input.o
mld_zf_sample.o: data_input.o
clean: clean:
/bin/rm -f $(DFSOBJS) $(ZFSOBJS) $(SFSOBJS) $(DFSOBJS) \ /bin/rm -f $(DFSOBJS) $(ZFSOBJS) $(SFSOBJS) $(DFSOBJS) \
*$(.mod) $(EXEDIR)/sf_sample $(EXEDIR)/cf_sample \ *$(.mod) $(EXEDIR)/mld_sf_sample $(EXEDIR)/mld_cf_sample \
$(EXEDIR)/df_sample_alya $(EXEDIR)/df_sample $(EXEDIR)/zf_sample $(EXEDIR)/mld_df_sample $(EXEDIR)/mld_zf_sample
lib: lib:
(cd ../../; make library) (cd ../../; make library)

@ -1,10 +1,10 @@
!!$ !!$
!!$ !!$
!!$ MLD2P4 version 2.0 !!$ MLD2P4 version 2.1
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) !!$ based on PSBLAS (Parallel Sparse BLAS version 3.4)
!!$ !!$
!!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ (C) Copyright 2008, 2010, 2012, 2015, 2016
!!$ !!$
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
program cf_sample program mld_cf_sample
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
@ -74,42 +74,42 @@ program cf_sample
real(psb_spk_) :: athres ! smoothed aggregation threshold real(psb_spk_) :: athres ! smoothed aggregation threshold
real(psb_spk_) :: ascale ! smoothed aggregation scale factor real(psb_spk_) :: ascale ! smoothed aggregation scale factor
end type precdata end type precdata
type(precdata) :: prec_choice type(precdata) :: prec_choice
! sparse matrices ! sparse matrices
type(psb_cspmat_type) :: a, aux_a type(psb_cspmat_type) :: a, aux_a
! preconditioner data ! preconditioner data
Type(mld_cprec_type) :: prec type(mld_cprec_type) :: prec
! dense matrices ! dense matrices
complex(psb_spk_), allocatable, target :: aux_b(:,:), d(:) complex(psb_spk_), allocatable, target :: aux_b(:,:), d(:)
complex(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:) complex(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
complex(psb_spk_), pointer :: b_col_glob(:) complex(psb_spk_), pointer :: b_col_glob(:)
type(psb_c_vect_type) :: b_col, x_col, r_col type(psb_c_vect_type) :: b_col, x_col, r_col
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np integer(psb_ipk_) :: ictxt, iam, np
! solver paramters ! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, irst, nlv & methd, istopc, irst, nlv
integer(psb_long_int_k_) :: amatsize, precsize, descsize integer(psb_long_int_k_) :: amatsize, precsize, descsize
real(psb_spk_) :: err, eps real(psb_spk_) :: err, eps
character(len=5) :: afmt character(len=5) :: afmt
character(len=20) :: name character(len=20) :: name, renum
integer(psb_ipk_), parameter :: iunit=12 integer(psb_ipk_), parameter :: iunit=12
integer(psb_ipk_) :: iparm(20) integer(psb_ipk_) :: iparm(20)
character(len=40) :: fprefix
! other variables ! other variables
integer(psb_ipk_) :: i,info,j,m_problem integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_ipk_) :: internal, m,ii,nnzero integer(psb_ipk_) :: internal, m,ii,nnzero
real(psb_dpk_) :: t1, t2, tprec real(psb_spk_) :: t1, t2, tprec, thier, tslv
real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp
integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne
integer(psb_ipk_), allocatable :: ivg(:), ipv(:) integer(psb_ipk_), allocatable :: ivg(:), ipv(:)
call psb_init(ictxt) call psb_init(ictxt)
@ -122,7 +122,7 @@ program cf_sample
endif endif
name='sf_sample' name='mld_cf_sample'
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_ info=psb_success_
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
@ -155,12 +155,12 @@ program cf_sample
call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file) call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file)
end if end if
end if end if
case ('HB') case ('HB')
! For Harwell-Boeing we have a single file which may or may not ! For Harwell-Boeing we have a single file which may or may not
! contain an RHS. ! contain an RHS.
call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file) call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
case default case default
info = -1 info = -1
write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
@ -172,7 +172,7 @@ program cf_sample
m_problem = aux_a%get_nrows() m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem) call psb_bcast(ictxt,m_problem)
! At this point aux_b may still be unallocated ! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=ione) == m_problem) then if (psb_size(aux_b,dim=ione) == m_problem) then
! if any rhs were present, broadcast the first one ! if any rhs were present, broadcast the first one
@ -189,7 +189,7 @@ program cf_sample
b_col_glob => aux_b(:,1) b_col_glob => aux_b(:,1)
do i=1, m_problem do i=1, m_problem
b_col_glob(i) = 1.0 b_col_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
@ -234,10 +234,10 @@ program cf_sample
end if end if
call psb_geall(x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
call x_col%set(czero) call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
call psb_geall(r_col,desc_a,info) call psb_geall(r_col,desc_a,info)
call r_col%set(czero) call r_col%zero()
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -257,6 +257,18 @@ program cf_sample
call mld_precinit(prec,prec_choice%prec, info) call mld_precinit(prec,prec_choice%prec, info)
if (prec_choice%nlev > 0) & if (prec_choice%nlev > 0) &
& call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info) & call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_c_hierarchy_bld(a,desc_a,prec,info)
thier = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
call mld_precset(prec,'smoother_type', prec_choice%smther, info) call mld_precset(prec,'smoother_type', prec_choice%smther, info)
call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info)
call mld_precset(prec,'sub_ovr', prec_choice%novr, info) call mld_precset(prec,'sub_ovr', prec_choice%novr, info)
@ -265,9 +277,6 @@ program cf_sample
call mld_precset(prec,'sub_solve', prec_choice%solve, info) call mld_precset(prec,'sub_solve', prec_choice%solve, info)
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info)
call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info)
call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) call mld_precset(prec,'aggr_scale', prec_choice%ascale, info)
@ -278,6 +287,16 @@ program cf_sample
call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info) call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info) call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info)
call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info) call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info)
! building the preconditioner
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_c_ml_prec_bld(a,desc_a,prec,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prec_choice%prec,info) call mld_precinit(prec,prec_choice%prec,info)
@ -290,20 +309,22 @@ program cf_sample
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
end if end if
end if ! building the preconditioner
! building the preconditioner thier = dzero
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) call mld_precbld(a,desc_a,prec,info)
tprec = psb_wtime()-t1 tprec = psb_wtime()-t1
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld') call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999 goto 9999
end if
end if end if
call psb_amx(ictxt, thier)
call psb_amx(ictxt, tprec) call psb_amx(ictxt, tprec)
if(iam == psb_root_) then if(iam == psb_root_) then
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec write(psb_out_unit,'("Preconditioner time: ",es12.5)')thier+tprec
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
@ -313,14 +334,14 @@ program cf_sample
call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,b_col,x_col,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)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
call psb_geaxpby(cone,b_col,czero,r_col,desc_a,info) call psb_geaxpby(cone,b_col,czero,r_col,desc_a,info)
call psb_spmm(-cone,a,x_col,cone,r_col,desc_a,info) call psb_spmm(-cone,a,x_col,cone,r_col,desc_a,info)
resmx = psb_genrm2(r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info)
resmxp = psb_geamax(r_col,desc_a,info) resmxp = psb_geamax(r_col,desc_a,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
precsize = prec%sizeof() precsize = prec%sizeof()
@ -331,14 +352,17 @@ program cf_sample
call mld_precdescr(prec,info) call mld_precdescr(prec,info)
write(psb_out_unit,'("Matrix: ",a)')mtrx_file write(psb_out_unit,'("Matrix: ",a)')mtrx_file
write(psb_out_unit,'("Computed solution on ",i8," processors")')np write(psb_out_unit,'("Computed solution on ",i8," processors")')np
write(psb_out_unit,'("Iterations to convergence : ",i6)')iter write(psb_out_unit,'("Iterations to convergence : ",i6)')iter
write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err
write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec write(psb_out_unit,'("Number of levels in hierarchy : ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time to solve matrix : ",es12.5)')t2 write(psb_out_unit,'("Time to build hierarchy : ",es12.5)')thier
write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter) write(psb_out_unit,'("Time to build smoothers : ",es12.5)')tprec
write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec write(psb_out_unit,'("Total time for preconditioner : ",es12.5)')tprec+thier
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx write(psb_out_unit,'("Time to solve system : ",es12.5)')tslv
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp write(psb_out_unit,'("Time per iteration : ",es12.5)')tslv/(iter)
write(psb_out_unit,'("Total time : ",es12.5)')tslv+tprec
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize
@ -497,4 +521,4 @@ contains
write(iout, *) ' ptype partition strategy default 0' write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition ' write(iout, *) ' 0: block partition '
end subroutine pr_usage end subroutine pr_usage
end program cf_sample end program mld_cf_sample

@ -1,10 +1,10 @@
!!$ !!$
!!$ !!$
!!$ MLD2P4 version 2.0 !!$ MLD2P4 version 2.1
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) !!$ based on PSBLAS (Parallel Sparse BLAS version 3.4)
!!$ !!$
!!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ (C) Copyright 2008, 2010, 2012, 2015, 2016
!!$ !!$
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
program df_sample program mld_df_sample
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
@ -107,7 +107,7 @@ program df_sample
! other variables ! other variables
integer(psb_ipk_) :: i,info,j,m_problem integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_ipk_) :: internal, m,ii,nnzero integer(psb_ipk_) :: internal, m,ii,nnzero
real(psb_dpk_) :: t1, t2, tprec real(psb_dpk_) :: t1, t2, tprec, thier, tslv
real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp
integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne
integer(psb_ipk_), allocatable :: ivg(:), ipv(:) integer(psb_ipk_), allocatable :: ivg(:), ipv(:)
@ -122,7 +122,7 @@ program df_sample
endif endif
name='df_sample' name='mld_df_sample'
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_ info=psb_success_
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
@ -234,10 +234,10 @@ program df_sample
end if end if
call psb_geall(x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
call x_col%set(dzero) call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
call psb_geall(r_col,desc_a,info) call psb_geall(r_col,desc_a,info)
call r_col%set(dzero) call r_col%zero()
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -257,6 +257,18 @@ program df_sample
call mld_precinit(prec,prec_choice%prec, info) call mld_precinit(prec,prec_choice%prec, info)
if (prec_choice%nlev > 0) & if (prec_choice%nlev > 0) &
& call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info) & call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_d_hierarchy_bld(a,desc_a,prec,info)
thier = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
call mld_precset(prec,'smoother_type', prec_choice%smther, info) call mld_precset(prec,'smoother_type', prec_choice%smther, info)
call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info)
call mld_precset(prec,'sub_ovr', prec_choice%novr, info) call mld_precset(prec,'sub_ovr', prec_choice%novr, info)
@ -265,9 +277,6 @@ program df_sample
call mld_precset(prec,'sub_solve', prec_choice%solve, info) call mld_precset(prec,'sub_solve', prec_choice%solve, info)
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info)
call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info)
call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) call mld_precset(prec,'aggr_scale', prec_choice%ascale, info)
@ -278,6 +287,16 @@ program df_sample
call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info) call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info) call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info)
call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info) call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info)
! building the preconditioner
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_d_ml_prec_bld(a,desc_a,prec,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prec_choice%prec,info) call mld_precinit(prec,prec_choice%prec,info)
@ -290,20 +309,22 @@ program df_sample
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
end if end if
end if ! building the preconditioner
! building the preconditioner thier = dzero
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) call mld_precbld(a,desc_a,prec,info)
tprec = psb_wtime()-t1 tprec = psb_wtime()-t1
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld') call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999 goto 9999
end if
end if end if
call psb_amx(ictxt, thier)
call psb_amx(ictxt, tprec) call psb_amx(ictxt, tprec)
if(iam == psb_root_) then if(iam == psb_root_) then
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec write(psb_out_unit,'("Preconditioner time: ",es12.5)')thier+tprec
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
@ -313,9 +334,9 @@ program df_sample
call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,b_col,x_col,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)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
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)
resmx = psb_genrm2(r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info)
@ -331,14 +352,17 @@ program df_sample
call mld_precdescr(prec,info) call mld_precdescr(prec,info)
write(psb_out_unit,'("Matrix: ",a)')mtrx_file write(psb_out_unit,'("Matrix: ",a)')mtrx_file
write(psb_out_unit,'("Computed solution on ",i8," processors")')np write(psb_out_unit,'("Computed solution on ",i8," processors")')np
write(psb_out_unit,'("Iterations to convergence : ",i6)')iter write(psb_out_unit,'("Iterations to convergence : ",i6)')iter
write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err
write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec write(psb_out_unit,'("Number of levels in hierarchy : ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time to solve matrix : ",es12.5)')t2 write(psb_out_unit,'("Time to build hierarchy : ",es12.5)')thier
write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter) write(psb_out_unit,'("Time to build smoothers : ",es12.5)')tprec
write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec write(psb_out_unit,'("Total time for preconditioner : ",es12.5)')tprec+thier
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx write(psb_out_unit,'("Time to solve system : ",es12.5)')tslv
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp write(psb_out_unit,'("Time per iteration : ",es12.5)')tslv/(iter)
write(psb_out_unit,'("Total time : ",es12.5)')tslv+tprec
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize
@ -497,4 +521,4 @@ contains
write(iout, *) ' ptype partition strategy default 0' write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition ' write(iout, *) ' 0: block partition '
end subroutine pr_usage end subroutine pr_usage
end program df_sample end program mld_df_sample

@ -1,10 +1,10 @@
!!$ !!$
!!$ !!$
!!$ MLD2P4 version 2.0 !!$ MLD2P4 version 2.1
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) !!$ based on PSBLAS (Parallel Sparse BLAS version 3.4)
!!$ !!$
!!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ (C) Copyright 2008, 2010, 2012, 2015, 2016
!!$ !!$
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
program sf_sample program mld_sf_sample
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
@ -81,7 +81,6 @@ program sf_sample
! preconditioner data ! preconditioner data
type(mld_sprec_type) :: prec type(mld_sprec_type) :: prec
! dense matrices ! dense matrices
real(psb_spk_), allocatable, target :: aux_b(:,:), d(:) real(psb_spk_), allocatable, target :: aux_b(:,:), d(:)
real(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:) real(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
@ -91,7 +90,7 @@ program sf_sample
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np integer(psb_ipk_) :: ictxt, iam, np
! solver paramters ! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,&
@ -100,16 +99,17 @@ program sf_sample
real(psb_spk_) :: err, eps real(psb_spk_) :: err, eps
character(len=5) :: afmt character(len=5) :: afmt
character(len=20) :: name character(len=20) :: name, renum
integer(psb_ipk_), parameter :: iunit=12 integer(psb_ipk_), parameter :: iunit=12
integer(psb_ipk_) :: iparm(20) integer(psb_ipk_) :: iparm(20)
character(len=40) :: fprefix
! other variables ! other variables
integer(psb_ipk_) :: i,info,j,m_problem integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_ipk_) :: internal, m,ii,nnzero integer(psb_ipk_) :: internal, m,ii,nnzero
real(psb_dpk_) :: t1, t2, tprec real(psb_spk_) :: t1, t2, tprec, thier, tslv
real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp
integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne
integer(psb_ipk_), allocatable :: ivg(:), ipv(:) integer(psb_ipk_), allocatable :: ivg(:), ipv(:)
call psb_init(ictxt) call psb_init(ictxt)
@ -122,7 +122,7 @@ program sf_sample
endif endif
name='sf_sample' name='mld_sf_sample'
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_ info=psb_success_
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
@ -155,12 +155,12 @@ program sf_sample
call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file) call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file)
end if end if
end if end if
case ('HB') case ('HB')
! For Harwell-Boeing we have a single file which may or may not ! For Harwell-Boeing we have a single file which may or may not
! contain an RHS. ! contain an RHS.
call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file) call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
case default case default
info = -1 info = -1
write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
@ -172,7 +172,7 @@ program sf_sample
m_problem = aux_a%get_nrows() m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem) call psb_bcast(ictxt,m_problem)
! At this point aux_b may still be unallocated ! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=ione) == m_problem) then if (psb_size(aux_b,dim=ione) == m_problem) then
! if any rhs were present, broadcast the first one ! if any rhs were present, broadcast the first one
@ -189,7 +189,7 @@ program sf_sample
b_col_glob => aux_b(:,1) b_col_glob => aux_b(:,1)
do i=1, m_problem do i=1, m_problem
b_col_glob(i) = 1.0 b_col_glob(i) = 1.d0
enddo enddo
endif endif
call psb_bcast(ictxt,b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
@ -234,10 +234,10 @@ program sf_sample
end if end if
call psb_geall(x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
call x_col%set(szero) call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
call psb_geall(r_col,desc_a,info) call psb_geall(r_col,desc_a,info)
call r_col%set(szero) call r_col%zero()
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -257,6 +257,18 @@ program sf_sample
call mld_precinit(prec,prec_choice%prec, info) call mld_precinit(prec,prec_choice%prec, info)
if (prec_choice%nlev > 0) & if (prec_choice%nlev > 0) &
& call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info) & call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_s_hierarchy_bld(a,desc_a,prec,info)
thier = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
call mld_precset(prec,'smoother_type', prec_choice%smther, info) call mld_precset(prec,'smoother_type', prec_choice%smther, info)
call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info)
call mld_precset(prec,'sub_ovr', prec_choice%novr, info) call mld_precset(prec,'sub_ovr', prec_choice%novr, info)
@ -265,9 +277,6 @@ program sf_sample
call mld_precset(prec,'sub_solve', prec_choice%solve, info) call mld_precset(prec,'sub_solve', prec_choice%solve, info)
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info)
call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info)
call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) call mld_precset(prec,'aggr_scale', prec_choice%ascale, info)
@ -278,6 +287,16 @@ program sf_sample
call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info) call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info) call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info)
call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info) call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info)
! building the preconditioner
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_s_ml_prec_bld(a,desc_a,prec,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prec_choice%prec,info) call mld_precinit(prec,prec_choice%prec,info)
@ -290,20 +309,22 @@ program sf_sample
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
end if end if
end if ! building the preconditioner
! building the preconditioner thier = dzero
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) call mld_precbld(a,desc_a,prec,info)
tprec = psb_wtime()-t1 tprec = psb_wtime()-t1
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld') call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999 goto 9999
end if
end if end if
call psb_amx(ictxt, thier)
call psb_amx(ictxt, tprec) call psb_amx(ictxt, tprec)
if(iam == psb_root_) then if(iam == psb_root_) then
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec write(psb_out_unit,'("Preconditioner time: ",es12.5)')thier+tprec
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
@ -313,14 +334,14 @@ program sf_sample
call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,b_col,x_col,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)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
call psb_geaxpby(sone,b_col,szero,r_col,desc_a,info) call psb_geaxpby(sone,b_col,szero,r_col,desc_a,info)
call psb_spmm(-sone,a,x_col,sone,r_col,desc_a,info) call psb_spmm(-sone,a,x_col,sone,r_col,desc_a,info)
resmx = psb_genrm2(r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info)
resmxp = psb_geamax(r_col,desc_a,info) resmxp = psb_geamax(r_col,desc_a,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
precsize = prec%sizeof() precsize = prec%sizeof()
@ -331,14 +352,17 @@ program sf_sample
call mld_precdescr(prec,info) call mld_precdescr(prec,info)
write(psb_out_unit,'("Matrix: ",a)')mtrx_file write(psb_out_unit,'("Matrix: ",a)')mtrx_file
write(psb_out_unit,'("Computed solution on ",i8," processors")')np write(psb_out_unit,'("Computed solution on ",i8," processors")')np
write(psb_out_unit,'("Iterations to convergence : ",i6)')iter write(psb_out_unit,'("Iterations to convergence : ",i6)')iter
write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err
write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec write(psb_out_unit,'("Number of levels in hierarchy : ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time to solve matrix : ",es12.5)')t2 write(psb_out_unit,'("Time to build hierarchy : ",es12.5)')thier
write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter) write(psb_out_unit,'("Time to build smoothers : ",es12.5)')tprec
write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec write(psb_out_unit,'("Total time for preconditioner : ",es12.5)')tprec+thier
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx write(psb_out_unit,'("Time to solve system : ",es12.5)')tslv
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp write(psb_out_unit,'("Time per iteration : ",es12.5)')tslv/(iter)
write(psb_out_unit,'("Total time : ",es12.5)')tslv+tprec
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize
@ -497,4 +521,4 @@ contains
write(iout, *) ' ptype partition strategy default 0' write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition ' write(iout, *) ' 0: block partition '
end subroutine pr_usage end subroutine pr_usage
end program sf_sample end program mld_sf_sample

@ -1,10 +1,10 @@
!!$ !!$
!!$ !!$
!!$ MLD2P4 version 2.0 !!$ MLD2P4 version 2.1
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) !!$ based on PSBLAS (Parallel Sparse BLAS version 3.4)
!!$ !!$
!!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ (C) Copyright 2008, 2010, 2012, 2015, 2016
!!$ !!$
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
@ -36,7 +36,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
program zf_sample program mld_zf_sample
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
@ -81,33 +81,33 @@ program zf_sample
! preconditioner data ! preconditioner data
type(mld_zprec_type) :: prec type(mld_zprec_type) :: prec
! dense matrices ! dense matrices
complex(psb_dpk_), allocatable, target :: aux_b(:,:), d(:) complex(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
complex(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:) complex(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
complex(psb_dpk_), pointer :: b_col_glob(:) complex(psb_dpk_), pointer :: b_col_glob(:)
type(psb_z_vect_type) :: b_col, x_col, r_col type(psb_z_vect_type) :: b_col, x_col, r_col
! communications data structure ! communications data structure
type(psb_desc_type):: desc_a type(psb_desc_type):: desc_a
integer(psb_ipk_) :: ictxt, iam, np integer(psb_ipk_) :: ictxt, iam, np
! solver paramters ! solver paramters
integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,& integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, irst, nlv & methd, istopc, irst, nlv
integer(psb_long_int_k_) :: amatsize, precsize, descsize integer(psb_long_int_k_) :: amatsize, precsize, descsize
real(psb_dpk_) :: err, eps real(psb_dpk_) :: err, eps
character(len=5) :: afmt character(len=5) :: afmt
character(len=20) :: name character(len=20) :: name, renum
integer(psb_ipk_), parameter :: iunit=12 integer(psb_ipk_), parameter :: iunit=12
integer(psb_ipk_) :: iparm(20) integer(psb_ipk_) :: iparm(20)
character(len=40) :: fprefix
! other variables ! other variables
integer(psb_ipk_) :: i,info,j,m_problem integer(psb_ipk_) :: i,info,j,m_problem
integer(psb_ipk_) :: internal, m,ii,nnzero integer(psb_ipk_) :: internal, m,ii,nnzero
real(psb_dpk_) :: t1, t2, tprec real(psb_dpk_) :: t1, t2, tprec, thier, tslv
real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp
integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne integer(psb_ipk_) :: nrhs, nrow, n_row, dim, nv, ne
integer(psb_ipk_), allocatable :: ivg(:), ipv(:) integer(psb_ipk_), allocatable :: ivg(:), ipv(:)
@ -122,7 +122,7 @@ program zf_sample
endif endif
name='df_sample' name='mld_zf_sample'
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
info=psb_success_ info=psb_success_
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
@ -172,7 +172,7 @@ program zf_sample
m_problem = aux_a%get_nrows() m_problem = aux_a%get_nrows()
call psb_bcast(ictxt,m_problem) call psb_bcast(ictxt,m_problem)
! At this point aux_b may still be unallocated ! At this point aux_b may still be unallocated
if (psb_size(aux_b,dim=ione) == m_problem) then if (psb_size(aux_b,dim=ione) == m_problem) then
! if any rhs were present, broadcast the first one ! if any rhs were present, broadcast the first one
@ -234,10 +234,10 @@ program zf_sample
end if end if
call psb_geall(x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
call x_col%set(zzero) call x_col%zero()
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
call psb_geall(r_col,desc_a,info) call psb_geall(r_col,desc_a,info)
call r_col%set(zzero) call r_col%zero()
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
@ -257,6 +257,18 @@ program zf_sample
call mld_precinit(prec,prec_choice%prec, info) call mld_precinit(prec,prec_choice%prec, info)
if (prec_choice%nlev > 0) & if (prec_choice%nlev > 0) &
& call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info) & call mld_precset(prec,'n_prec_levs', prec_choice%nlev, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_z_hierarchy_bld(a,desc_a,prec,info)
thier = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
call mld_precset(prec,'smoother_type', prec_choice%smther, info) call mld_precset(prec,'smoother_type', prec_choice%smther, info)
call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prec_choice%jsweeps, info)
call mld_precset(prec,'sub_ovr', prec_choice%novr, info) call mld_precset(prec,'sub_ovr', prec_choice%novr, info)
@ -265,9 +277,6 @@ program zf_sample
call mld_precset(prec,'sub_solve', prec_choice%solve, info) call mld_precset(prec,'sub_solve', prec_choice%solve, info)
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
call mld_precset(prec,'aggr_kind', prec_choice%aggrkind,info)
call mld_precset(prec,'aggr_alg', prec_choice%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prec_choice%aggr_ord,info)
call mld_precset(prec,'ml_type', prec_choice%mltype, info) call mld_precset(prec,'ml_type', prec_choice%mltype, info)
call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info) call mld_precset(prec,'smoother_pos', prec_choice%smthpos, info)
call mld_precset(prec,'aggr_scale', prec_choice%ascale, info) call mld_precset(prec,'aggr_scale', prec_choice%ascale, info)
@ -278,6 +287,16 @@ program zf_sample
call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info) call mld_precset(prec,'coarse_fillin', prec_choice%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info) call mld_precset(prec,'coarse_iluthrs', prec_choice%cthres, info)
call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info) call mld_precset(prec,'coarse_sweeps', prec_choice%cjswp, info)
! building the preconditioner
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_z_ml_prec_bld(a,desc_a,prec,info)
tprec = psb_wtime()-t1
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999
end if
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prec_choice%prec,info) call mld_precinit(prec,prec_choice%prec,info)
@ -290,20 +309,22 @@ program zf_sample
call mld_precset(prec,'sub_fillin', prec_choice%fill, info) call mld_precset(prec,'sub_fillin', prec_choice%fill, info)
call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info) call mld_precset(prec,'sub_iluthrs', prec_choice%thr, info)
end if end if
end if ! building the preconditioner
! building the preconditioner thier = dzero
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) call mld_precbld(a,desc_a,prec,info)
tprec = psb_wtime()-t1 tprec = psb_wtime()-t1
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld') call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_precbld')
goto 9999 goto 9999
end if
end if end if
call psb_amx(ictxt, thier)
call psb_amx(ictxt, tprec) call psb_amx(ictxt, tprec)
if(iam == psb_root_) then if(iam == psb_root_) then
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec write(psb_out_unit,'("Preconditioner time: ",es12.5)')thier+tprec
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
end if end if
@ -313,14 +334,14 @@ program zf_sample
call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,b_col,x_col,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)
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info) 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_spmm(-zone,a,x_col,zone,r_col,desc_a,info)
resmx = psb_genrm2(r_col,desc_a,info) resmx = psb_genrm2(r_col,desc_a,info)
resmxp = psb_geamax(r_col,desc_a,info) resmxp = psb_geamax(r_col,desc_a,info)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
precsize = prec%sizeof() precsize = prec%sizeof()
@ -331,14 +352,17 @@ program zf_sample
call mld_precdescr(prec,info) call mld_precdescr(prec,info)
write(psb_out_unit,'("Matrix: ",a)')mtrx_file write(psb_out_unit,'("Matrix: ",a)')mtrx_file
write(psb_out_unit,'("Computed solution on ",i8," processors")')np write(psb_out_unit,'("Computed solution on ",i8," processors")')np
write(psb_out_unit,'("Iterations to convergence : ",i6)')iter write(psb_out_unit,'("Iterations to convergence : ",i6)')iter
write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err write(psb_out_unit,'("Error estimate on exit : ",es12.5)')err
write(psb_out_unit,'("Time to buil prec. : ",es12.5)')tprec write(psb_out_unit,'("Number of levels in hierarchy : ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time to solve matrix : ",es12.5)')t2 write(psb_out_unit,'("Time to build hierarchy : ",es12.5)')thier
write(psb_out_unit,'("Time per iteration : ",es12.5)')t2/(iter) write(psb_out_unit,'("Time to build smoothers : ",es12.5)')tprec
write(psb_out_unit,'("Total time : ",es12.5)')t2+tprec write(psb_out_unit,'("Total time for preconditioner : ",es12.5)')tprec+thier
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx write(psb_out_unit,'("Time to solve system : ",es12.5)')tslv
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp write(psb_out_unit,'("Time per iteration : ",es12.5)')tslv/(iter)
write(psb_out_unit,'("Total time : ",es12.5)')tslv+tprec
write(psb_out_unit,'("Residual norm 2 : ",es12.5)')resmx
write(psb_out_unit,'("Residual norm inf : ",es12.5)')resmxp
write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for A : ",i12)')amatsize
write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)')descsize
write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize write(psb_out_unit,'("Total memory occupation for PREC : ",i12)')precsize
@ -497,4 +521,4 @@ contains
write(iout, *) ' ptype partition strategy default 0' write(iout, *) ' ptype partition strategy default 0'
write(iout, *) ' 0: block partition ' write(iout, *) ' 0: block partition '
end subroutine pr_usage end subroutine pr_usage
end program zf_sample end program mld_zf_sample

@ -1,5 +1,5 @@
pressmat.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or pde100.mtx ! This matrix (and others) from: http://math.nist.gov/MatrixMarket/ or
pressrhs.mtx ! rhs | http://www.cise.ufl.edu/research/sparse/matrices/index.html NONE ! rhs | http://www.cise.ufl.edu/research/sparse/matrices/index.html
MM ! MM !
RGMRES ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG RGMRES ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format: CSR COO JAD CSR ! Storage format: CSR COO JAD

@ -11,33 +11,33 @@ FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDINCDIR) $(FMFLAG)$(PSBINCDIR) $(FIFLAG).
EXEDIR=./runs EXEDIR=./runs
all: spde3d ppde3d spde2d ppde2d all: mld_s_pde3d mld_d_pde3d mld_s_pde2d mld_d_pde2d
ppde3d: ppde3d.o data_input.o mld_d_pde3d: mld_d_pde3d.o data_input.o
$(F90LINK) ppde3d.o data_input.o -o ppde3d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) mld_d_pde3d.o data_input.o -o mld_d_pde3d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv ppde3d $(EXEDIR) /bin/mv mld_d_pde3d $(EXEDIR)
spde3d: spde3d.o data_input.o mld_s_pde3d: mld_s_pde3d.o data_input.o
$(F90LINK) spde3d.o data_input.o -o spde3d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) mld_s_pde3d.o data_input.o -o mld_s_pde3d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv spde3d $(EXEDIR) /bin/mv mld_s_pde3d $(EXEDIR)
ppde2d: ppde2d.o data_input.o mld_d_pde2d: mld_d_pde2d.o data_input.o
$(F90LINK) -g ppde2d.o data_input.o -o ppde2d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) -g mld_d_pde2d.o data_input.o -o mld_d_pde2d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv ppde2d $(EXEDIR) /bin/mv mld_d_pde2d $(EXEDIR)
spde2d: spde2d.o data_input.o mld_s_pde2d: mld_s_pde2d.o data_input.o
$(F90LINK) spde2d.o data_input.o -o spde2d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS) $(F90LINK) mld_s_pde2d.o data_input.o -o mld_s_pde2d $(MLD_LIB) $(PSBLAS_LIB) $(LDLIBS)
/bin/mv spde2d $(EXEDIR) /bin/mv mld_s_pde2d $(EXEDIR)
ppde3d.o spde3d.o ppde2d.o spde2d.o: data_input.o mld_d_pde3d.o mld_s_pde3d.o mld_d_pde2d.o mld_s_pde2d.o: data_input.o
check: all check: all
cd runs && ./ppde2d <ppde.inp && ./spde2d<ppde.inp cd runs && ./mld_d_pde2d <mld_d_pde.inp && ./mld_s_pde2d<mld_d_pde.inp
clean: clean:
/bin/rm -f data_input.o ppde3d.o spde3d.o ppde2d.o spde2d.o *$(.mod)\ /bin/rm -f data_input.o mld_d_pde3d.o mld_s_pde3d.o mld_d_pde2d.o mld_s_pde2d.o *$(.mod)\
$(EXEDIR)/ppde3d $(EXEDIR)/spde3d $(EXEDIR)/ppde2d $(EXEDIR)/spde2d $(EXEDIR)/mld_d_pde3d $(EXEDIR)/mld_s_pde3d $(EXEDIR)/mld_d_pde2d $(EXEDIR)/mld_s_pde2d
verycleanlib: verycleanlib:
(cd ../..; make veryclean) (cd ../..; make veryclean)

@ -36,9 +36,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! File: ppde2d.f90 ! File: mld_d_pde2d.f90
! !
! Program: ppde2d ! Program: mld_d_pde2d
! This sample program solves a linear system obtained by discretizing a ! This sample program solves a linear system obtained by discretizing a
! PDE with Dirichlet BCs. ! PDE with Dirichlet BCs.
! !
@ -62,7 +62,7 @@
! then the corresponding vector is distributed according to a BLOCK ! then the corresponding vector is distributed according to a BLOCK
! data distribution. ! data distribution.
! !
module ppde2d_mod module mld_d_pde2d_mod
contains contains
! !
@ -109,15 +109,15 @@ contains
g = exp(-y**2) g = exp(-y**2)
end if end if
end function g end function g
end module ppde2d_mod end module mld_d_pde2d_mod
program ppde2d program mld_d_pde2d
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
use psb_util_mod use psb_util_mod
use data_input use data_input
use ppde2d_mod use mld_d_pde2d_mod
implicit none implicit none
! input parameters ! input parameters
@ -126,8 +126,7 @@ program ppde2d
integer(psb_ipk_) :: idim integer(psb_ipk_) :: idim
! miscellaneous ! miscellaneous
real(psb_dpk_), parameter :: one = 1.d0 real(psb_dpk_) :: t1, t2, tprec, thier, tslv
real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner ! sparse matrix and preconditioner
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
@ -191,7 +190,7 @@ program ppde2d
stop stop
endif endif
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
name='pde2d90' name='mld_d_pde2d'
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
! !
! Hello world ! Hello world
@ -229,8 +228,7 @@ program ppde2d
! !
! prepare the preconditioner. ! prepare the preconditioner.
! !
if (psb_toupper(prectype%prec) == 'ML') then
if (psb_toupper(prectype%prec) == 'ML') then
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
if (prectype%nlevs > 0) then if (prectype%nlevs > 0) then
! Force number of levels, so disregard the other related arguments. ! Force number of levels, so disregard the other related arguments.
@ -245,6 +243,22 @@ program ppde2d
end if end if
if (prectype%athres >= dzero) & if (prectype%athres >= dzero) &
& call mld_precset(prec,'aggr_thresh', prectype%athres, info) & call mld_precset(prec,'aggr_thresh', prectype%athres, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_d_hierarchy_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
thier = psb_wtime()-t1
call mld_precset(prec,'smoother_type', prectype%smther, info) call mld_precset(prec,'smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call mld_precset(prec,'sub_ovr', prectype%novr, info)
@ -254,9 +268,6 @@ program ppde2d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call mld_precset(prec,'ml_type', prectype%mltype, info) call mld_precset(prec,'ml_type', prectype%mltype, info)
call mld_precset(prec,'smoother_pos', prectype%smthpos, info) call mld_precset(prec,'smoother_pos', prectype%smthpos, info)
call mld_precset(prec,'coarse_solve', prectype%csolve, info) call mld_precset(prec,'coarse_solve', prectype%csolve, info)
@ -265,6 +276,18 @@ program ppde2d
call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_d_ml_prec_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tprec = psb_wtime()-t1
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
@ -276,25 +299,26 @@ program ppde2d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
end if call psb_barrier(ictxt)
thier = dzero
call psb_barrier(ictxt) t1 = psb_wtime()
t1 = psb_wtime() call mld_precbld(a,desc_a,prec,info)
call mld_precbld(a,desc_a,prec,info) if(info /= psb_success_) then
if(info /= psb_success_) then info=psb_err_from_subroutine_
info=psb_err_from_subroutine_ ch_err='psb_precbld'
ch_err='psb_precbld' call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err=ch_err) goto 9999
goto 9999 end if
tprec = psb_wtime()-t1
end if end if
tprec = psb_wtime()-t1
!!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.) !!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.)
call psb_amx(ictxt,thier)
call psb_amx(ictxt,tprec) call psb_amx(ictxt,tprec)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec & write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier
if (iam == psb_root_) call mld_precdescr(prec,info) if (iam == psb_root_) call mld_precdescr(prec,info)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'(" ")') & write(psb_out_unit,'(" ")')
@ -308,6 +332,7 @@ program ppde2d
t1 = psb_wtime() t1 = psb_wtime()
call psb_krylov(kmethd,a,prec,b,x,eps,desc_a,info,& call psb_krylov(kmethd,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 /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='solver routine' ch_err='solver routine'
@ -316,25 +341,31 @@ program ppde2d
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
precsize = prec%sizeof() precsize = prec%sizeof()
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 (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
write(psb_out_unit,'("Time to solve matrix : ",es12.5)') t2 write(psb_out_unit,'("Numer of levels of aggr. hierarchy: ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time per iteration : ",es12.5)') t2/iter write(psb_out_unit,'("Time to build aggr. hierarchy : ",es12.5)') thier
write(psb_out_unit,'("Number of iterations : ",i0)') iter write(psb_out_unit,'("Time to build smoothers : ",es12.5)') tprec
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err write(psb_out_unit,'("Total preconditioner time : ",es12.5)') tprec+thier
write(psb_out_unit,'("Info on exit : ",i0)') info write(psb_out_unit,'("Time to solve system : ",es12.5)') tslv
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize write(psb_out_unit,'("Time per iteration : ",es12.5)') tslv/iter
write(psb_out_unit,'("Number of iterations : ",i0)') iter
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err
write(psb_out_unit,'("Info on exit : ",i0)') info
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize
write(psb_out_unit,'("Storage format for A: ",a)') trim(a%get_fmt())
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize write(psb_out_unit,'("Storage format for DESC_A: ",a)') trim(desc_a%get_fmt())
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize
end if end if
! !
@ -467,7 +498,7 @@ contains
subroutine pr_usage(iout) subroutine pr_usage(iout)
integer(psb_ipk_) :: iout integer(psb_ipk_) :: iout
write(iout,*)'incorrect parameter(s) found' write(iout,*)'incorrect parameter(s) found'
write(iout,*)' usage: pde90 methd prec dim & write(iout,*)' usage: mld_d_pde2d methd prec dim &
&[istop itmax itrace]' &[istop itmax itrace]'
write(iout,*)' where:' write(iout,*)' where:'
write(iout,*)' methd: cgstab cgs rgmres bicgstabl' write(iout,*)' methd: cgstab cgs rgmres bicgstabl'
@ -482,4 +513,4 @@ contains
write(iout,*)' iterations ' write(iout,*)' iterations '
end subroutine pr_usage end subroutine pr_usage
end program ppde2d end program mld_d_pde2d

@ -1,8 +1,7 @@
!!$ !!$
!!$ !!$ MLD2P4 version 2.1
!!$ MLD2P4 version 2.0
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) !!$ based on PSBLAS (Parallel Sparse BLAS version 3.4)
!!$ !!$
!!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ (C) Copyright 2008, 2010, 2012, 2015
!!$ !!$
@ -37,9 +36,9 @@
!!$ !!$
!!$ !!$
! !
! File: ppde3d.f90 ! File: mld_d_pde3d.f90
! !
! Program: ppde3d ! Program: mld_d_pde3d
! This sample program solves a linear system obtained by discretizing a ! This sample program solves a linear system obtained by discretizing a
! PDE with Dirichlet BCs. ! PDE with Dirichlet BCs.
! !
@ -63,7 +62,7 @@
! then the corresponding vector is distributed according to a BLOCK ! then the corresponding vector is distributed according to a BLOCK
! data distribution. ! data distribution.
! !
module ppde3d_mod module mld_d_pde3d_mod
contains contains
! !
! functions parametrizing the differential equation ! functions parametrizing the differential equation
@ -121,15 +120,15 @@ contains
g = exp(y**2-z**2) g = exp(y**2-z**2)
end if end if
end function g end function g
end module ppde3d_mod end module mld_d_pde3d_mod
program ppde3d program mld_d_pde3d
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
use psb_util_mod use psb_util_mod
use data_input use data_input
use ppde3d_mod use mld_d_pde3d_mod
implicit none implicit none
! input parameters ! input parameters
@ -138,8 +137,7 @@ program ppde3d
integer(psb_ipk_) :: idim integer(psb_ipk_) :: idim
! miscellaneous ! miscellaneous
real(psb_dpk_), parameter :: one = 1.d0 real(psb_dpk_) :: t1, t2, tprec, thier, tslv
real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner ! sparse matrix and preconditioner
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
@ -203,7 +201,7 @@ program ppde3d
stop stop
endif endif
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
name='pde90' name='mld_d_pde3d'
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
! !
! Hello world ! Hello world
@ -257,6 +255,22 @@ program ppde3d
end if end if
if (prectype%athres >= dzero) & if (prectype%athres >= dzero) &
& call mld_precset(prec,'aggr_thresh', prectype%athres, info) & call mld_precset(prec,'aggr_thresh', prectype%athres, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_d_hierarchy_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
thier = psb_wtime()-t1
call mld_precset(prec,'smoother_type', prectype%smther, info) call mld_precset(prec,'smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call mld_precset(prec,'sub_ovr', prectype%novr, info)
@ -266,9 +280,6 @@ program ppde3d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call mld_precset(prec,'ml_type', prectype%mltype, info) call mld_precset(prec,'ml_type', prectype%mltype, info)
call mld_precset(prec,'smoother_pos', prectype%smthpos, info) call mld_precset(prec,'smoother_pos', prectype%smthpos, info)
call mld_precset(prec,'coarse_solve', prectype%csolve, info) call mld_precset(prec,'coarse_solve', prectype%csolve, info)
@ -277,6 +288,18 @@ program ppde3d
call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_d_ml_prec_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tprec = psb_wtime()-t1
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
@ -288,25 +311,26 @@ program ppde3d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
call psb_barrier(ictxt)
thier = dzero
t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tprec = psb_wtime()-t1
end if end if
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tprec = psb_wtime()-t1
!!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.) !!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.)
call psb_amx(ictxt,thier)
call psb_amx(ictxt,tprec) call psb_amx(ictxt,tprec)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec & write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier
if (iam == psb_root_) call mld_precdescr(prec,info) if (iam == psb_root_) call mld_precdescr(prec,info)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'(" ")') & write(psb_out_unit,'(" ")')
@ -329,8 +353,8 @@ program ppde3d
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -340,14 +364,20 @@ program ppde3d
call psb_sum(ictxt,precsize) call psb_sum(ictxt,precsize)
if (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
write(psb_out_unit,'("Time to solve matrix : ",es12.5)') t2 write(psb_out_unit,'("Numer of levels of aggr. hierarchy: ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time per iteration : ",es12.5)') t2/iter write(psb_out_unit,'("Time to build aggr. hierarchy : ",es12.5)') thier
write(psb_out_unit,'("Number of iterations : ",i0)') iter write(psb_out_unit,'("Time to build smoothers : ",es12.5)') tprec
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err write(psb_out_unit,'("Total preconditioner time : ",es12.5)') tprec+thier
write(psb_out_unit,'("Info on exit : ",i0)') info write(psb_out_unit,'("Time to solve system : ",es12.5)') tslv
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize write(psb_out_unit,'("Time per iteration : ",es12.5)') tslv/iter
write(psb_out_unit,'("Number of iterations : ",i0)') iter
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err
write(psb_out_unit,'("Info on exit : ",i0)') info
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize
write(psb_out_unit,'("Storage format for A: ",a)') trim(a%get_fmt())
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize write(psb_out_unit,'("Storage format for DESC_A: ",a)') trim(desc_a%get_fmt())
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize
end if end if
! !
@ -480,7 +510,7 @@ contains
subroutine pr_usage(iout) subroutine pr_usage(iout)
integer(psb_ipk_) :: iout integer(psb_ipk_) :: iout
write(iout,*)'incorrect parameter(s) found' write(iout,*)'incorrect parameter(s) found'
write(iout,*)' usage: pde90 methd prec dim & write(iout,*)' usage: mld_d_pde3d methd prec dim &
&[istop itmax itrace]' &[istop itmax itrace]'
write(iout,*)' where:' write(iout,*)' where:'
write(iout,*)' methd: cgstab cgs rgmres bicgstabl' write(iout,*)' methd: cgstab cgs rgmres bicgstabl'
@ -495,4 +525,4 @@ contains
write(iout,*)' iterations ' write(iout,*)' iterations '
end subroutine pr_usage end subroutine pr_usage
end program ppde3d end program mld_d_pde3d

@ -1,4 +1,4 @@
!!$ !!!$
!!$ !!$
!!$ MLD2P4 version 2.0 !!$ MLD2P4 version 2.0
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
@ -36,9 +36,9 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! File: spde2d.f90 ! File: mld_s_pde2d.f90
! !
! Program: spde2d ! Program: mld_s_pde2d
! This sample program solves a linear system obtained by discretizing a ! This sample program solves a linear system obtained by discretizing a
! PDE with Dirichlet BCs. ! PDE with Dirichlet BCs.
! !
@ -62,7 +62,7 @@
! then the corresponding vector is distributed according to a BLOCK ! then the corresponding vector is distributed according to a BLOCK
! data distribution. ! data distribution.
! !
module spde2d_mod module mld_s_pde2d_mod
contains contains
! !
@ -72,52 +72,52 @@ contains
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b1 real(psb_spk_) :: b1
real(psb_spk_), intent(in) :: x,y real(psb_spk_), intent(in) :: x,y
b1=0.e0/sqrt(2.e0) b1=0.d0/sqrt(2.d0)
end function b1 end function b1
function b2(x,y) function b2(x,y)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b2 real(psb_spk_) :: b2
real(psb_spk_), intent(in) :: x,y real(psb_spk_), intent(in) :: x,y
b2=0.e0/sqrt(2.e0) b2=0.d0/sqrt(2.d0)
end function b2 end function b2
function c(x,y) function c(x,y)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: c real(psb_spk_) :: c
real(psb_spk_), intent(in) :: x,y real(psb_spk_), intent(in) :: x,y
c=0.e0 c=0.d0
end function c end function c
function a1(x,y) function a1(x,y)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a1 real(psb_spk_) :: a1
real(psb_spk_), intent(in) :: x,y real(psb_spk_), intent(in) :: x,y
a1=1.e0!/80 a1=1.d0!/80
end function a1 end function a1
function a2(x,y) function a2(x,y)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a2 real(psb_spk_) :: a2
real(psb_spk_), intent(in) :: x,y real(psb_spk_), intent(in) :: x,y
a2=1.e0!/80 a2=1.d0!/80
end function a2 end function a2
function g(x,y) function g(x,y)
use psb_base_mod, only : psb_spk_, sone, szero use psb_base_mod, only : psb_spk_, done, dzero
real(psb_spk_) :: g real(psb_spk_) :: g
real(psb_spk_), intent(in) :: x,y real(psb_spk_), intent(in) :: x,y
g = szero g = dzero
if (x == sone) then if (x == done) then
g = sone g = done
else if (x == szero) then else if (x == dzero) then
g = exp(-y**2) g = exp(-y**2)
end if end if
end function g end function g
end module spde2d_mod end module mld_s_pde2d_mod
program spde2d program mld_s_pde2d
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
use psb_util_mod use psb_util_mod
use data_input use data_input
use spde2d_mod use mld_s_pde2d_mod
implicit none implicit none
! input parameters ! input parameters
@ -126,8 +126,7 @@ program spde2d
integer(psb_ipk_) :: idim integer(psb_ipk_) :: idim
! miscellaneous ! miscellaneous
real(psb_spk_), parameter :: one = 1.0 real(psb_dpk_) :: t1, t2, tprec, thier, tslv
real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner ! sparse matrix and preconditioner
type(psb_sspmat_type) :: a type(psb_sspmat_type) :: a
@ -191,7 +190,7 @@ program spde2d
stop stop
endif endif
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
name='pde2d90' name='mld_s_pde2d'
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
! !
! Hello world ! Hello world
@ -229,8 +228,7 @@ program spde2d
! !
! prepare the preconditioner. ! prepare the preconditioner.
! !
if (psb_toupper(prectype%prec) == 'ML') then
if (psb_toupper(prectype%prec) == 'ML') then
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
if (prectype%nlevs > 0) then if (prectype%nlevs > 0) then
! Force number of levels, so disregard the other related arguments. ! Force number of levels, so disregard the other related arguments.
@ -245,6 +243,22 @@ program spde2d
end if end if
if (prectype%athres >= dzero) & if (prectype%athres >= dzero) &
& call mld_precset(prec,'aggr_thresh', prectype%athres, info) & call mld_precset(prec,'aggr_thresh', prectype%athres, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_s_hierarchy_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
thier = psb_wtime()-t1
call mld_precset(prec,'smoother_type', prectype%smther, info) call mld_precset(prec,'smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call mld_precset(prec,'sub_ovr', prectype%novr, info)
@ -254,9 +268,6 @@ program spde2d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call mld_precset(prec,'ml_type', prectype%mltype, info) call mld_precset(prec,'ml_type', prectype%mltype, info)
call mld_precset(prec,'smoother_pos', prectype%smthpos, info) call mld_precset(prec,'smoother_pos', prectype%smthpos, info)
call mld_precset(prec,'coarse_solve', prectype%csolve, info) call mld_precset(prec,'coarse_solve', prectype%csolve, info)
@ -265,6 +276,18 @@ program spde2d
call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_s_ml_prec_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tprec = psb_wtime()-t1
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
@ -276,25 +299,26 @@ program spde2d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
end if call psb_barrier(ictxt)
thier = dzero
call psb_barrier(ictxt) t1 = psb_wtime()
t1 = psb_wtime() call mld_precbld(a,desc_a,prec,info)
call mld_precbld(a,desc_a,prec,info) if(info /= psb_success_) then
if(info /= psb_success_) then info=psb_err_from_subroutine_
info=psb_err_from_subroutine_ ch_err='psb_precbld'
ch_err='psb_precbld' call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err=ch_err) goto 9999
goto 9999 end if
tprec = psb_wtime()-t1
end if end if
tprec = psb_wtime()-t1
!!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.) !!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.)
call psb_amx(ictxt,thier)
call psb_amx(ictxt,tprec) call psb_amx(ictxt,tprec)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec & write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier
if (iam == psb_root_) call mld_precdescr(prec,info) if (iam == psb_root_) call mld_precdescr(prec,info)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'(" ")') & write(psb_out_unit,'(" ")')
@ -317,25 +341,31 @@ program spde2d
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
precsize = prec%sizeof() precsize = prec%sizeof()
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 (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
write(psb_out_unit,'("Time to solve matrix : ",es12.5)') t2 write(psb_out_unit,'("Numer of levels of aggr. hierarchy: ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time per iteration : ",es12.5)') t2/iter write(psb_out_unit,'("Time to build aggr. hierarchy : ",es12.5)') thier
write(psb_out_unit,'("Number of iterations : ",i0)') iter write(psb_out_unit,'("Time to build smoothers : ",es12.5)') tprec
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err write(psb_out_unit,'("Total preconditioner time : ",es12.5)') tprec+thier
write(psb_out_unit,'("Info on exit : ",i0)') info write(psb_out_unit,'("Time to solve system : ",es12.5)') tslv
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize write(psb_out_unit,'("Time per iteration : ",es12.5)') tslv/iter
write(psb_out_unit,'("Number of iterations : ",i0)') iter
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err
write(psb_out_unit,'("Info on exit : ",i0)') info
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize
write(psb_out_unit,'("Storage format for A: ",a)') trim(a%get_fmt())
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize write(psb_out_unit,'("Storage format for DESC_A: ",a)') trim(desc_a%get_fmt())
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize
end if end if
! !
@ -468,7 +498,7 @@ contains
subroutine pr_usage(iout) subroutine pr_usage(iout)
integer(psb_ipk_) :: iout integer(psb_ipk_) :: iout
write(iout,*)'incorrect parameter(s) found' write(iout,*)'incorrect parameter(s) found'
write(iout,*)' usage: pde90 methd prec dim & write(iout,*)' usage: mld_s_pde2d methd prec dim &
&[istop itmax itrace]' &[istop itmax itrace]'
write(iout,*)' where:' write(iout,*)' where:'
write(iout,*)' methd: cgstab cgs rgmres bicgstabl' write(iout,*)' methd: cgstab cgs rgmres bicgstabl'
@ -483,4 +513,4 @@ contains
write(iout,*)' iterations ' write(iout,*)' iterations '
end subroutine pr_usage end subroutine pr_usage
end program spde2d end program mld_s_pde2d

@ -1,8 +1,7 @@
!!$ !!$
!!$ !!$ MLD2P4 version 2.1
!!$ MLD2P4 version 2.0
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package !!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.3) !!$ based on PSBLAS (Parallel Sparse BLAS version 3.4)
!!$ !!$
!!$ (C) Copyright 2008, 2010, 2012, 2015 !!$ (C) Copyright 2008, 2010, 2012, 2015
!!$ !!$
@ -37,9 +36,9 @@
!!$ !!$
!!$ !!$
! !
! File: spde3d.f90 ! File: mld_s_pde3d.f90
! !
! Program: spde3d ! Program: mld_s_pde3d
! This sample program solves a linear system obtained by discretizing a ! This sample program solves a linear system obtained by discretizing a
! PDE with Dirichlet BCs. ! PDE with Dirichlet BCs.
! !
@ -63,7 +62,7 @@
! then the corresponding vector is distributed according to a BLOCK ! then the corresponding vector is distributed according to a BLOCK
! data distribution. ! data distribution.
! !
module spde3d_mod module mld_s_pde3d_mod
contains contains
! !
! functions parametrizing the differential equation ! functions parametrizing the differential equation
@ -72,64 +71,64 @@ contains
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b1 real(psb_spk_) :: b1
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
b1=0.e0/sqrt(3.e0) b1=0.d0/sqrt(3.d0)
end function b1 end function b1
function b2(x,y,z) function b2(x,y,z)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b2 real(psb_spk_) :: b2
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
b2=0.e0/sqrt(3.e0) b2=0.d0/sqrt(3.d0)
end function b2 end function b2
function b3(x,y,z) function b3(x,y,z)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b3 real(psb_spk_) :: b3
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
b3=0.e0/sqrt(3.e0) b3=0.d0/sqrt(3.d0)
end function b3 end function b3
function c(x,y,z) function c(x,y,z)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: c real(psb_spk_) :: c
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
c=0.e0 c=0.d0
end function c end function c
function a1(x,y,z) function a1(x,y,z)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a1 real(psb_spk_) :: a1
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
a1=1.e0!/80 a1=1.d0!/80
end function a1 end function a1
function a2(x,y,z) function a2(x,y,z)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a2 real(psb_spk_) :: a2
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
a2=1.e0!/80 a2=1.d0!/80
end function a2 end function a2
function a3(x,y,z) function a3(x,y,z)
use psb_base_mod, only : psb_spk_ use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a3 real(psb_spk_) :: a3
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
a3=1.e0!/80 a3=1.d0!/80
end function a3 end function a3
function g(x,y,z) function g(x,y,z)
use psb_base_mod, only : psb_spk_, sone, szero use psb_base_mod, only : psb_spk_, done, dzero
real(psb_spk_) :: g real(psb_spk_) :: g
real(psb_spk_), intent(in) :: x,y,z real(psb_spk_), intent(in) :: x,y,z
g = szero g = dzero
if (x == sone) then if (x == done) then
g = sone g = done
else if (x == szero) then else if (x == dzero) then
g = exp(y**2-z**2) g = exp(y**2-z**2)
end if end if
end function g end function g
end module spde3d_mod end module mld_s_pde3d_mod
program spde3d program mld_s_pde3d
use psb_base_mod use psb_base_mod
use mld_prec_mod use mld_prec_mod
use psb_krylov_mod use psb_krylov_mod
use psb_util_mod use psb_util_mod
use data_input use data_input
use spde3d_mod use mld_s_pde3d_mod
implicit none implicit none
! input parameters ! input parameters
@ -138,8 +137,7 @@ program spde3d
integer(psb_ipk_) :: idim integer(psb_ipk_) :: idim
! miscellaneous ! miscellaneous
real(psb_spk_), parameter :: one = 1.0 real(psb_dpk_) :: t1, t2, tprec, thier, tslv
real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner ! sparse matrix and preconditioner
type(psb_sspmat_type) :: a type(psb_sspmat_type) :: a
@ -154,7 +152,7 @@ program spde3d
! solver parameters ! solver parameters
integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nlv integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nlv
integer(psb_long_int_k_) :: amatsize, precsize, descsize integer(psb_long_int_k_) :: amatsize, precsize, descsize
real(psb_spk_) :: err, eps real(psb_spk_) :: err, eps
type precdata type precdata
character(len=20) :: descr ! verbose description of the prec character(len=20) :: descr ! verbose description of the prec
@ -203,7 +201,7 @@ program spde3d
stop stop
endif endif
if(psb_get_errstatus() /= 0) goto 9999 if(psb_get_errstatus() /= 0) goto 9999
name='pde90' name='mld_s_pde3d'
call psb_set_errverbosity(itwo) call psb_set_errverbosity(itwo)
! !
! Hello world ! Hello world
@ -242,8 +240,7 @@ program spde3d
! !
! prepare the preconditioner. ! prepare the preconditioner.
! !
if (psb_toupper(prectype%prec) == 'ML') then
if (psb_toupper(prectype%prec) == 'ML') then
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
if (prectype%nlevs > 0) then if (prectype%nlevs > 0) then
! Force number of levels, so disregard the other related arguments. ! Force number of levels, so disregard the other related arguments.
@ -258,6 +255,22 @@ program spde3d
end if end if
if (prectype%athres >= dzero) & if (prectype%athres >= dzero) &
& call mld_precset(prec,'aggr_thresh', prectype%athres, info) & call mld_precset(prec,'aggr_thresh', prectype%athres, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_s_hierarchy_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
thier = psb_wtime()-t1
call mld_precset(prec,'smoother_type', prectype%smther, info) call mld_precset(prec,'smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info) call mld_precset(prec,'sub_ovr', prectype%novr, info)
@ -267,9 +280,6 @@ program spde3d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
call mld_precset(prec,'aggr_kind', prectype%aggrkind,info)
call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info)
call mld_precset(prec,'aggr_ord', prectype%aggr_ord,info)
call mld_precset(prec,'ml_type', prectype%mltype, info) call mld_precset(prec,'ml_type', prectype%mltype, info)
call mld_precset(prec,'smoother_pos', prectype%smthpos, info) call mld_precset(prec,'smoother_pos', prectype%smthpos, info)
call mld_precset(prec,'coarse_solve', prectype%csolve, info) call mld_precset(prec,'coarse_solve', prectype%csolve, info)
@ -278,6 +288,18 @@ program spde3d
call mld_precset(prec,'coarse_fillin', prectype%cfill, info) call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_s_ml_prec_bld(a,desc_a,prec,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_precbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tprec = psb_wtime()-t1
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info) call mld_precinit(prec,prectype%prec, info)
@ -289,25 +311,26 @@ program spde3d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
end if call psb_barrier(ictxt)
thier = dzero
call psb_barrier(ictxt) t1 = psb_wtime()
t1 = psb_wtime() call mld_precbld(a,desc_a,prec,info)
call mld_precbld(a,desc_a,prec,info) if(info /= psb_success_) then
if(info /= psb_success_) then info=psb_err_from_subroutine_
info=psb_err_from_subroutine_ ch_err='psb_precbld'
ch_err='psb_precbld' call psb_errpush(info,name,a_err=ch_err)
call psb_errpush(info,name,a_err=ch_err) goto 9999
goto 9999 end if
tprec = psb_wtime()-t1
end if end if
tprec = psb_wtime()-t1
!!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.) !!$ call prec%dump(info,prefix='test-ml',ac=.true.,solver=.true.,smoother=.true.)
call psb_amx(ictxt,thier)
call psb_amx(ictxt,tprec) call psb_amx(ictxt,tprec)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'("Preconditioner time : ",es12.5)')tprec & write(psb_out_unit,'("Preconditioner time : ",es12.5)') tprec+thier
if (iam == psb_root_) call mld_precdescr(prec,info) if (iam == psb_root_) call mld_precdescr(prec,info)
if (iam == psb_root_) & if (iam == psb_root_) &
& write(psb_out_unit,'(" ")') & write(psb_out_unit,'(" ")')
@ -330,8 +353,8 @@ program spde3d
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
t2 = psb_wtime() - t1 tslv = psb_wtime() - t1
call psb_amx(ictxt,t2) call psb_amx(ictxt,tslv)
amatsize = a%sizeof() amatsize = a%sizeof()
descsize = desc_a%sizeof() descsize = desc_a%sizeof()
@ -341,14 +364,20 @@ program spde3d
call psb_sum(ictxt,precsize) call psb_sum(ictxt,precsize)
if (iam == psb_root_) then if (iam == psb_root_) then
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
write(psb_out_unit,'("Time to solve matrix : ",es12.5)') t2 write(psb_out_unit,'("Numer of levels of aggr. hierarchy: ",i12)') prec%get_nlevs()
write(psb_out_unit,'("Time per iteration : ",es12.5)') t2/iter write(psb_out_unit,'("Time to build aggr. hierarchy : ",es12.5)') thier
write(psb_out_unit,'("Number of iterations : ",i0)') iter write(psb_out_unit,'("Time to build smoothers : ",es12.5)') tprec
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err write(psb_out_unit,'("Total preconditioner time : ",es12.5)') tprec+thier
write(psb_out_unit,'("Info on exit : ",i0)') info write(psb_out_unit,'("Time to solve system : ",es12.5)') tslv
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize write(psb_out_unit,'("Time per iteration : ",es12.5)') tslv/iter
write(psb_out_unit,'("Number of iterations : ",i0)') iter
write(psb_out_unit,'("Convergence indicator on exit : ",es12.5)') err
write(psb_out_unit,'("Info on exit : ",i0)') info
write(psb_out_unit,'("Total memory occupation for A: ",i12)') amatsize
write(psb_out_unit,'("Storage format for A: ",a)') trim(a%get_fmt())
write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)') descsize
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize write(psb_out_unit,'("Storage format for DESC_A: ",a)') trim(desc_a%get_fmt())
write(psb_out_unit,'("Total memory occupation for PREC: ",i12)') precsize
end if end if
! !
@ -481,7 +510,7 @@ contains
subroutine pr_usage(iout) subroutine pr_usage(iout)
integer(psb_ipk_) :: iout integer(psb_ipk_) :: iout
write(iout,*)'incorrect parameter(s) found' write(iout,*)'incorrect parameter(s) found'
write(iout,*)' usage: pde90 methd prec dim & write(iout,*)' usage: mld_s_pde3d methd prec dim &
&[istop itmax itrace]' &[istop itmax itrace]'
write(iout,*)' where:' write(iout,*)' where:'
write(iout,*)' methd: cgstab cgs rgmres bicgstabl' write(iout,*)' methd: cgstab cgs rgmres bicgstabl'
@ -496,4 +525,4 @@ contains
write(iout,*)' iterations ' write(iout,*)' iterations '
end subroutine pr_usage end subroutine pr_usage
end program spde3d end program mld_s_pde3d

@ -1,6 +1,6 @@
CGR ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD CSR ! Storage format CSR COO JAD
0080 ! IDIM; domain size is idim**3 0100 ! IDIM; domain size is idim**3
2 ! ISTOPC 2 ! ISTOPC
2000 ! ITMAX 2000 ! ITMAX
10 ! ITRACE 10 ! ITRACE
@ -16,7 +16,7 @@ ML ! Preconditioner NONE JACOBI BJAC AS ML
SMOOTHED ! Type of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY SMOOTHED ! Type of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
SYMDEC ! Type of aggregation: DEC SYMDEC SYMDEC ! Type of aggregation: DEC SYMDEC
NATURAL ! Ordering of aggregation: NATURAL DEGREE NATURAL ! Ordering of aggregation: NATURAL DEGREE
KCYCLE ! Type of multilevel correction: ADD MULT KCYCLE VCYCLE WCYCLE KCYCLESYM MULT ! Type of multilevel correction: ADD MULT KCYCLE VCYCLE WCYCLE KCYCLESYM
TWOSIDE ! Side of correction: PRE POST TWOSIDE (ignored for ADD) TWOSIDE ! Side of correction: PRE POST TWOSIDE (ignored for ADD)
4 ! Smoother sweeps 4 ! Smoother sweeps
BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML

Loading…
Cancel
Save