fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4:

Browse Source 
New checks in build of multilevel preconditioners: separated
aggregation from smoother build, and reconfigure number of levels "on
the fly" when appropriate.
stopcriterion
Salvatore Filippone 16 years ago
parent 24e1123fc6
commit 6002976472
38 changed files with 962 additions and 538 deletions
Show Stats Download Patch File Download Diff File

2
README
Unescape Escape View File

@ -8,7 +8,7 @@ In version 1.0.1:
- The internals of the multilevel preconditioner have been repackaged
in a more structured fashion; no changes are needed in the user
code.
- Note that we now need version 2.3.1 of PSBLAS.
- Note that we now need version 2.3.1 of PSBLAS.
To compile:

4
config/pac.m4
Unescape Escape View File

@ -141,8 +141,8 @@ dnl Warning : square brackets are EVIL!
[
cat > conftest.$ac_ext <<EOF
program main
#if ( __GNUC__ >= 4 && __GNUC_MINOR__ >= 2 ) || ( __GNUC__ > 4 )
print *, "ciao"
#if ( __GNUC__ >= 4 && __GNUC_MINOR__ > 2 ) || ( __GNUC__ > 4 )
print *, "ok"
#else
this program will fail
#endif

47
krylov/psb_prec_mod.F90
Unescape Escape View File

@ -50,50 +50,6 @@
!
module psb_prec_mod
#if (__GNUC__==4) && (__GNUC_MINOR__<=2)
!
! GNU Fortran 4.2.
! Workaround for PR 32634, it is fixed in GNU Fortran 4.3, will
! it be fixed in 4.2???
!
use mld_prec_type, &
& psb_dbaseprc_type => mld_dbaseprc_type,&
& psb_zbaseprc_type => mld_zbaseprc_type,&
& psb_dprec_type => mld_dprec_type,&
& psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr
use mld_prec_mod
interface psb_precbld
module procedure mld_dprecbld, mld_zprecbld
end interface
interface psb_precinit
module procedure mld_dprecinit, mld_zprecinit
end interface
interface psb_precset
module procedure mld_dprecseti, mld_dprecsetd,&
& mld_zprecseti, mld_zprecsetd
end interface
interface psb_precfree
module procedure mld_dprecfree, mld_zprecfree
end interface
interface psb_precaply
module procedure mld_dprec_aply, mld_dprec_aply1, &
& mld_zprec_aply, mld_zprec_aply1
end interface
#else
use mld_prec_mod, &
& psb_sbaseprc_type => mld_sbaseprc_type,&
& psb_dbaseprc_type => mld_dbaseprc_type,&
@ -103,7 +59,6 @@ module psb_prec_mod
& psb_dprec_type => mld_dprec_type,&
& psb_cprec_type => mld_cprec_type,&
& psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr,&
@ -113,8 +68,6 @@ module psb_prec_mod
& psb_precset => mld_precset, &
& psb_precaply => mld_precaply
#endif
integer, parameter :: psb_noprec_=mld_noprec_, psb_diag_=mld_diag_,&
& psb_bjac_=mld_bjac_

24
mlprec/Makefile
Unescape Escape View File

@ -6,32 +6,34 @@ HERE=.
FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLIBDIR)
MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o
MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o mld_transfer_mod.o
MPFOBJS=mld_saggrmat_raw_asb.o mld_saggrmat_smth_asb.o \
mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \
mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \
mld_zaggrmat_raw_asb.o mld_zaggrmat_smth_asb.o
MPCOBJS=mld_sslud_interface.o mld_dslud_interface.o mld_cslud_interface.o mld_zslud_interface.o
INNEROBJS=mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\
mld_smlprec_bld.o mld_ssp_renum.o mld_sfact_bld.o mld_silu_bld.o \
INNEROBJS=mld_saggr_bld.o mld_daggr_bld.o \
mld_caggr_bld.o mld_zaggr_bld.o \
mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\
mld_ssp_renum.o mld_sfact_bld.o mld_silu_bld.o \
mld_sbaseprec_bld.o mld_sdiag_bld.o mld_saggrmap_bld.o \
mld_smlprec_aply.o mld_sslud_bld.o\
mld_sbaseprec_aply.o mld_ssub_aply.o mld_ssub_solve.o \
mld_sas_aply.o mld_saggrmat_asb.o \
mld_das_bld.o mld_dslu_bld.o mld_dumf_bld.o mld_dilu0_fact.o\
mld_dmlprec_bld.o mld_dsp_renum.o mld_dfact_bld.o mld_dilu_bld.o \
mld_dsp_renum.o mld_dfact_bld.o mld_dilu_bld.o \
mld_dbaseprec_bld.o mld_ddiag_bld.o mld_daggrmap_bld.o \
mld_dmlprec_aply.o mld_dslud_bld.o\
mld_dbaseprec_aply.o mld_dsub_aply.o mld_dsub_solve.o \
mld_das_aply.o mld_daggrmat_asb.o \
mld_cas_bld.o mld_cslu_bld.o mld_cumf_bld.o mld_cilu0_fact.o\
mld_cmlprec_bld.o mld_csp_renum.o mld_cfact_bld.o mld_cilu_bld.o \
mld_csp_renum.o mld_cfact_bld.o mld_cilu_bld.o \
mld_cbaseprec_bld.o mld_cdiag_bld.o mld_caggrmap_bld.o \
mld_cmlprec_aply.o mld_cslud_bld.o\
mld_cbaseprec_aply.o mld_csub_aply.o mld_csub_solve.o \
mld_cas_aply.o mld_caggrmat_asb.o\
mld_zas_bld.o mld_zslu_bld.o mld_zumf_bld.o mld_zilu0_fact.o\
mld_zmlprec_bld.o mld_zsp_renum.o mld_zfact_bld.o mld_zilu_bld.o \
mld_zsp_renum.o mld_zfact_bld.o mld_zilu_bld.o \
mld_zbaseprec_bld.o mld_zdiag_bld.o mld_zaggrmap_bld.o \
mld_zmlprec_aply.o mld_zslud_bld.o\
mld_zbaseprec_aply.o mld_zsub_aply.o mld_zsub_solve.o \
@ -39,13 +41,13 @@ INNEROBJS=mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\
mld_siluk_fact.o mld_ciluk_fact.o mld_silut_fact.o mld_cilut_fact.o \
mld_diluk_fact.o mld_ziluk_fact.o mld_dilut_fact.o mld_zilut_fact.o \
$(MPFOBJS)
OUTEROBJS=mld_sprecbld.o mld_sprecfree.o mld_sprecset.o mld_sprecinit.o\
OUTEROBJS=mld_sprecbld.o mld_sprecset.o mld_sprecinit.o\
mld_sprec_aply.o \
mld_dprecbld.o mld_dprecfree.o mld_dprecset.o mld_dprecinit.o\
mld_dprecbld.o mld_dprecset.o mld_dprecinit.o\
mld_dprec_aply.o \
mld_cprecbld.o mld_cprecfree.o mld_cprecset.o mld_cprecinit.o\
mld_cprecbld.o mld_cprecset.o mld_cprecinit.o\
mld_cprec_aply.o \
mld_zprecbld.o mld_zprecfree.o mld_zprecset.o mld_zprecinit.o \
mld_zprecbld.o mld_zprecset.o mld_zprecinit.o \
mld_zprec_aply.o
F90OBJS=$(OUTEROBJS) $(INNEROBJS)
@ -67,6 +69,8 @@ lib: mpobjs $(OBJS)
$(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod))
mld_prec_mod.o mld_innner_mod.o: mld_prec_type.o
mld_inner_mod.o: mld_transfer_mod.o
mld_transfer_mod.o: mld_prec_type.o
$(MODOBJS): $(PSBLIBDIR)/psb_base_mod$(.mod)

4
mlprec/mld_caggrmat_asb.f90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_onelev_prec_type), input/output.
! p - type(mld_c_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -100,7 +100,7 @@ subroutine mld_caggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_caggrmat_raw_asb.F90
Unescape Escape View File

@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_onelev_prec_type), input/output.
! p - type(mld_c_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -88,7 +88,7 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_caggrmat_smth_asb.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_onelev_prec_type), input/output.
! p - type(mld_c_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -105,7 +105,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

8
mlprec/mld_cbaseprec_bld.f90
Unescape Escape View File

@ -38,7 +38,7 @@
!!$
! File: mld_cbaseprec_bld.f90
!
! Subroutine: mld_cbaseprc_bld
! Subroutine: mld_cbaseprec_bld
! Version: complex
!
! This routine builds a 'base preconditioner' related to a matrix A.
@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_cbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_cbaseprec_bld
Implicit None
@ -211,5 +211,5 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_cbaseprc_bld
end subroutine mld_cbaseprec_bld

12
mlprec/mld_cmlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - complex(psb_spk_), input.
! The scalar alpha.
! precv - type(mld_c_onelev_prec_type), dimension(:), input.
! precv - type(mld_c_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -341,7 +341,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -577,7 +577,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -837,7 +837,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -1135,7 +1135,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)

2
mlprec/mld_cmlprec_bld.f90
Unescape Escape View File

@ -69,7 +69,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_c_onelev_prec_type), intent(inout),target :: p
type(mld_c_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables

183
mlprec/mld_cprecbld.f90
Unescape Escape View File

@ -73,13 +73,14 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type),intent(inout) :: p
type(mld_cprec_type),intent(inout), target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_cprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@ -129,7 +130,8 @@ subroutine mld_cprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@ -153,7 +155,6 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@ -187,7 +188,7 @@ subroutine mld_cprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@ -199,36 +200,8 @@ subroutine mld_cprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@ -240,40 +213,110 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
!
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1
newsz=i-1
end if
end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),&
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',szero,is_legal_s_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_c_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_cprecbld

2
mlprec/mld_cprecfree.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine mld_cprecfree(p,info)
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if

4
mlprec/mld_daggrmat_asb.f90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_onelev_prec_type), input/output.
! p - type(mld_d_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -100,7 +100,7 @@ subroutine mld_daggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_daggrmat_raw_asb.F90
Unescape Escape View File

@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_onelev_prec_type), input/output.
! p - type(mld_d_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -88,7 +88,7 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_daggrmat_smth_asb.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_onelev_prec_type), input/output.
! p - type(mld_d_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -105,7 +105,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

6
mlprec/mld_dbaseprec_bld.f90
Unescape Escape View File

@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_dbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_dbaseprec_bld
Implicit None
@ -211,5 +211,5 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_dbaseprc_bld
end subroutine mld_dbaseprec_bld

12
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - real(psb_dpk_), input.
! The scalar alpha.
! precv - type(mld_d_onelev_prec_type), dimension(:), input.
! precv - type(mld_d_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -340,7 +340,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -575,7 +575,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -834,7 +834,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -1131,7 +1131,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)

2
mlprec/mld_dmlprec_bld.f90
Unescape Escape View File

@ -70,7 +70,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_d_onelev_prec_type), intent(inout),target :: p
type(mld_d_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables

195
mlprec/mld_dprecbld.f90
Unescape Escape View File

@ -67,19 +67,20 @@ subroutine mld_dprecbld(a,desc_a,p,info)
use psb_base_mod
use mld_inner_mod
use mld_prec_mod, protect => mld_dprecbld
use mld_prec_mod, mld_protect_name => mld_dprecbld
Implicit None
! Arguments
type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout) :: p
integer, intent(out) :: info
type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout),target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_dprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@ -129,7 +130,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@ -153,7 +155,6 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@ -187,7 +188,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@ -199,36 +200,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@ -240,40 +213,110 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
!
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1
newsz=i-1
end if
end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),&
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',dzero,is_legal_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@ -304,8 +347,42 @@ contains
do k=1,size(p%av)
call psb_nullify_sp(p%av(k))
end do
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_d_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_dprecbld

153
mlprec/mld_inner_mod.f90
Unescape Escape View File

@ -38,6 +38,7 @@
!!$
module mld_inner_mod
use mld_prec_type
use mld_transfer_mod
interface mld_baseprec_aply
subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
@ -144,9 +145,9 @@ module mld_inner_mod
interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -156,9 +157,9 @@ module mld_inner_mod
end subroutine mld_smlprec_aply
subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -168,9 +169,9 @@ module mld_inner_mod
end subroutine mld_dmlprec_aply
subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: baseprecv(:)
type(mld_c_interlev_prec_type), intent(in) :: baseprecv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -180,9 +181,9 @@ module mld_inner_mod
end subroutine mld_cmlprec_aply
subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: baseprecv(:)
type(mld_z_interlev_prec_type), intent(in) :: baseprecv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -383,6 +384,41 @@ module mld_inner_mod
end subroutine mld_zsp_renum
end interface
interface mld_aggr_bld
subroutine mld_saggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggr_bld
subroutine mld_daggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggr_bld
subroutine mld_caggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggr_bld
subroutine mld_zaggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggr_bld
end interface
interface mld_aggrmap_bld
subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
@ -429,34 +465,34 @@ module mld_inner_mod
interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_asb
end interface
@ -464,34 +500,34 @@ module mld_inner_mod
interface mld_aggrmat_raw_asb
subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_raw_asb
subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_raw_asb
subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_raw_asb
subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_raw_asb
end interface
@ -499,40 +535,40 @@ module mld_inner_mod
interface mld_aggrmat_smth_asb
subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_smth_asb
subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_smth_asb
subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_smth_asb
subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_smth_asb
end interface
interface mld_baseprc_bld
subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
interface mld_baseprec_bld
subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type
type(psb_sspmat_type), target :: a
@ -540,8 +576,8 @@ module mld_inner_mod
type(mld_sbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_sbaseprc_bld
subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
end subroutine mld_sbaseprec_bld
subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type
type(psb_dspmat_type), target :: a
@ -549,8 +585,8 @@ module mld_inner_mod
type(mld_dbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_dbaseprc_bld
subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
end subroutine mld_dbaseprec_bld
subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type
type(psb_cspmat_type), target :: a
@ -558,8 +594,8 @@ module mld_inner_mod
type(mld_cbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_cbaseprc_bld
subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
end subroutine mld_cbaseprec_bld
subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type
type(psb_zspmat_type), target :: a
@ -567,7 +603,7 @@ module mld_inner_mod
type(mld_zbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_zbaseprc_bld
end subroutine mld_zbaseprec_bld
end interface
interface mld_as_bld
@ -609,41 +645,6 @@ module mld_inner_mod
end subroutine mld_zas_bld
end interface
interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
type(psb_sspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_smlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_dmlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_c_onelev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
end subroutine mld_cmlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
type(psb_zspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_z_onelev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
end subroutine mld_zmlprec_bld
end interface
interface mld_diag_bld
subroutine mld_sdiag_bld(a,desc_data,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_

78
mlprec/mld_prec_mod.f90
Unescape Escape View File

@ -199,33 +199,33 @@ module mld_prec_mod
integer, optional, intent(in) :: ilev
end subroutine mld_zprecsetc
end interface
interface mld_precfree
subroutine mld_sprecfree(p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sprec_type
type(mld_sprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_sprecfree
subroutine mld_dprecfree(p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dprec_type
type(mld_dprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_dprecfree
subroutine mld_cprecfree(p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cprec_type
type(mld_cprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_cprecfree
subroutine mld_zprecfree(p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zprec_type
type(mld_zprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_zprecfree
end interface
!!$
!!$ interface mld_precfree
!!$ subroutine mld_sprecfree(p,info)
!!$ use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
!!$ use mld_prec_type, only : mld_sprec_type
!!$ type(mld_sprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_sprecfree
!!$ subroutine mld_dprecfree(p,info)
!!$ use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
!!$ use mld_prec_type, only : mld_dprec_type
!!$ type(mld_dprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_dprecfree
!!$ subroutine mld_cprecfree(p,info)
!!$ use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
!!$ use mld_prec_type, only : mld_cprec_type
!!$ type(mld_cprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_cprecfree
!!$ subroutine mld_zprecfree(p,info)
!!$ use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
!!$ use mld_prec_type, only : mld_zprec_type
!!$ type(mld_zprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_zprecfree
!!$ end interface
interface mld_precaply
subroutine mld_sprec_aply(prec,x,y,desc_data,info,trans,work)
@ -315,30 +315,30 @@ module mld_prec_mod
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sprec_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type), intent(inout) :: prec
integer, intent(out) :: info
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type), intent(inout), target :: prec
integer, intent(out) :: info
!!$ character, intent(in),optional :: upd
end subroutine mld_sprecbld
subroutine mld_dprecbld(a,desc_a,prec,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout) :: prec
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
integer, intent(out) :: info
!!$ character, intent(in),optional :: upd
end subroutine mld_dprecbld
subroutine mld_cprecbld(a,desc_a,prec,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cprec_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type), intent(inout) :: prec
integer, intent(out) :: info
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type), intent(inout), target :: prec
integer, intent(out) :: info
!!$ character, intent(in),optional :: upd
end subroutine mld_cprecbld
subroutine mld_zprecbld(a,desc_a,prec,info)

296
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -91,14 +91,14 @@ module mld_prec_type
! one, i.e. level 1 is the finest level and A(1) is the matrix A.
!
!| type mld_Xprec_type
!| type(mld_X_onelev_prec_type), allocatable :: precv(:)
!| type(mld_X_interlev_prec_type), allocatable :: precv(:)
!| end type mld_Xprec_type
!|
!
! precv(ilev) is the preconditioner at level ilev.
! The number of levels is given by size(precv(:)).
!
! Type: mld_X_onelev_prec_type.
! Type: mld_X_interlev_prec_type.
! The data type containing necessary items for the current level.
!
! type(mld_Xbaseprc_type) - prec
@ -175,7 +175,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_sbaseprc_type
type mld_s_onelev_prec_type
type mld_s_interlev_prec_type
type(mld_sbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
@ -185,10 +185,10 @@ module mld_prec_type
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_s_onelev_prec_type
end type mld_s_interlev_prec_type
type mld_sprec_type
type(mld_s_onelev_prec_type), allocatable :: precv(:)
type(mld_s_interlev_prec_type), allocatable :: precv(:)
end type mld_sprec_type
type mld_dbaseprc_type
@ -200,7 +200,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_dbaseprc_type
type mld_d_onelev_prec_type
type mld_d_interlev_prec_type
type(mld_dbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
@ -210,10 +210,10 @@ module mld_prec_type
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_d_onelev_prec_type
end type mld_d_interlev_prec_type
type mld_dprec_type
type(mld_d_onelev_prec_type), allocatable :: precv(:)
type(mld_d_interlev_prec_type), allocatable :: precv(:)
end type mld_dprec_type
@ -226,7 +226,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_cbaseprc_type
type mld_c_onelev_prec_type
type mld_c_interlev_prec_type
type(mld_cbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
@ -236,10 +236,10 @@ module mld_prec_type
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_c_onelev_prec_type
end type mld_c_interlev_prec_type
type mld_cprec_type
type(mld_c_onelev_prec_type), allocatable :: precv(:)
type(mld_c_interlev_prec_type), allocatable :: precv(:)
end type mld_cprec_type
type mld_zbaseprc_type
@ -251,7 +251,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_zbaseprc_type
type mld_z_onelev_prec_type
type mld_z_interlev_prec_type
type(mld_zbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
@ -261,10 +261,10 @@ module mld_prec_type
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_z_onelev_prec_type
end type mld_z_interlev_prec_type
type mld_zprec_type
type(mld_z_onelev_prec_type), allocatable :: precv(:)
type(mld_z_interlev_prec_type), allocatable :: precv(:)
end type mld_zprec_type
@ -411,14 +411,13 @@ module mld_prec_type
! for printing its description and for deallocating its data structure
!
interface mld_base_precfree
interface mld_precfree
module procedure mld_sbase_precfree, mld_cbase_precfree,&
& mld_dbase_precfree, mld_zbase_precfree
end interface
interface mld_onelev_precfree
module procedure mld_s_onelev_precfree, mld_d_onelev_precfree, &
& mld_c_onelev_precfree, mld_z_onelev_precfree
& mld_dbase_precfree, mld_zbase_precfree, &
& mld_s_onelev_precfree, mld_d_onelev_precfree, &
& mld_c_onelev_precfree, mld_z_onelev_precfree, &
& mld_sprec_free, mld_dprec_free, &
& mld_cprec_free, mld_zprec_free
end interface
interface mld_nullify_baseprec
@ -435,6 +434,7 @@ module mld_prec_type
module procedure mld_icheck_def, mld_scheck_def, mld_dcheck_def
end interface
interface mld_precdescr
module procedure mld_file_prec_descr, &
& mld_zfile_prec_descr,&
@ -457,7 +457,6 @@ module mld_prec_type
contains
!
! Subroutine: mld_stringval
!
@ -755,7 +754,7 @@ contains
function mld_s_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_s_onelev_prec_type), intent(in) :: prec
type(mld_s_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -772,7 +771,7 @@ contains
function mld_d_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_d_onelev_prec_type), intent(in) :: prec
type(mld_d_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -789,7 +788,7 @@ contains
function mld_c_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_c_onelev_prec_type), intent(in) :: prec
type(mld_c_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -806,7 +805,7 @@ contains
function mld_z_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_z_onelev_prec_type), intent(in) :: prec
type(mld_z_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -1859,16 +1858,11 @@ contains
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
!!$ call mld_sslu_free(p%iprcparm(mld_slu_ptr_),info)
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_sslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
end if
!!$ if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
!!$ call mld_ssludist_free(p%iprcparm(mld_slud_ptr_),info)
!!$ end if
!!$ if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
!!$ call mld_dumf_free(p%iprcparm(mld_umf_symptr_),&
!!$ & p%iprcparm(mld_umf_numptr_),info)
!!$ end if
deallocate(p%iprcparm,stat=info)
end if
call mld_nullify_baseprec(p)
@ -1878,7 +1872,7 @@ contains
subroutine mld_s_onelev_precfree(p,info)
implicit none
type(mld_s_onelev_prec_type), intent(inout) :: p
type(mld_s_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -1886,7 +1880,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@ -1921,7 +1915,7 @@ contains
subroutine mld_nullify_s_onelevprec(p)
implicit none
type(mld_s_onelev_prec_type), intent(inout) :: p
type(mld_s_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -1983,15 +1977,17 @@ contains
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_dslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
call mld_dsludist_free(p%iprcparm(mld_slud_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_dumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_dslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
call mld_dsludist_free(p%iprcparm(mld_slud_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_dumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
end if
end if
deallocate(p%iprcparm,stat=info)
end if
@ -2001,7 +1997,7 @@ contains
subroutine mld_d_onelev_precfree(p,info)
implicit none
type(mld_d_onelev_prec_type), intent(inout) :: p
type(mld_d_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -2009,7 +2005,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@ -2053,7 +2049,7 @@ contains
subroutine mld_nullify_d_onelevprec(p)
implicit none
type(mld_d_onelev_prec_type), intent(inout) :: p
type(mld_d_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -2100,13 +2096,11 @@ contains
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
!!$ call mld_cslu_free(p%iprcparm(mld_slu_ptr_),info)
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_cslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
end if
!!$ if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
!!$ call mld_zumf_free(p%iprcparm(mld_umf_symptr_),&
!!$ & p%iprcparm(mld_umf_numptr_),info)
!!$ end if
deallocate(p%iprcparm,stat=info)
end if
call mld_nullify_baseprec(p)
@ -2115,7 +2109,7 @@ contains
subroutine mld_c_onelev_precfree(p,info)
implicit none
type(mld_c_onelev_prec_type), intent(inout) :: p
type(mld_c_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -2123,7 +2117,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@ -2157,7 +2151,7 @@ contains
subroutine mld_nullify_c_onelevprec(p)
implicit none
type(mld_c_onelev_prec_type), intent(inout) :: p
type(mld_c_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -2213,13 +2207,15 @@ contains
deallocate(p%invperm,stat=info)
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_zslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_zumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_zslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_zumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
end if
end if
deallocate(p%iprcparm,stat=info)
end if
@ -2229,7 +2225,7 @@ contains
subroutine mld_z_onelev_precfree(p,info)
implicit none
type(mld_z_onelev_prec_type), intent(inout) :: p
type(mld_z_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -2237,7 +2233,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@ -2271,7 +2267,7 @@ contains
subroutine mld_nullify_z_onelevprec(p)
implicit none
type(mld_z_onelev_prec_type), intent(inout) :: p
type(mld_z_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -2309,4 +2305,166 @@ contains
end function pr_to_str
subroutine mld_sprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_sprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_sprec_free
subroutine mld_dprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_dprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_dprec_free
subroutine mld_cprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_cprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_cprec_free
subroutine mld_zprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_zprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_zprec_free
end module mld_prec_type

4
mlprec/mld_saggrmat_asb.f90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_onelev_prec_type), input/output.
! p - type(mld_s_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -100,7 +100,7 @@ subroutine mld_saggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_saggrmat_raw_asb.F90
Unescape Escape View File

@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_onelev_prec_type), input/output.
! p - type(mld_s_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -88,7 +88,7 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_saggrmat_smth_asb.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_onelev_prec_type), input/output.
! p - type(mld_s_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -105,7 +105,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

8
mlprec/mld_sbaseprec_bld.f90
Unescape Escape View File

@ -38,7 +38,7 @@
!!$
! File: mld_sbaseprec_bld.f90
!
! Subroutine: mld_sbaseprc_bld
! Subroutine: mld_sbaseprec_bld
! Version: real
!
! This routine builds a 'base preconditioner' related to a matrix A.
@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_sbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_sbaseprec_bld
Implicit None
@ -211,5 +211,5 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_sbaseprc_bld
end subroutine mld_sbaseprec_bld

12
mlprec/mld_smlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - real(psb_spk_), input.
! The scalar alpha.
! precv - type(mld_s_onelev_prec_type), dimension(:), input.
! precv - type(mld_s_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -340,7 +340,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -575,7 +575,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -834,7 +834,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -1131,7 +1131,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)

2
mlprec/mld_smlprec_bld.f90
Unescape Escape View File

@ -70,7 +70,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_s_onelev_prec_type), intent(inout),target :: p
type(mld_s_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables

191
mlprec/mld_sprecbld.f90
Unescape Escape View File

@ -67,19 +67,20 @@ subroutine mld_sprecbld(a,desc_a,p,info)
use psb_base_mod
use mld_inner_mod
use mld_prec_mod, protect => mld_sprecbld
use mld_prec_mod, mld_protect_name => mld_sprecbld
Implicit None
! Arguments
type(psb_sspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type),intent(inout) :: p
integer, intent(out) :: info
type(psb_sspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type),intent(inout), target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_sprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@ -129,7 +130,8 @@ subroutine mld_sprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@ -153,7 +155,6 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@ -187,7 +188,7 @@ subroutine mld_sprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@ -199,36 +200,8 @@ subroutine mld_sprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@ -240,40 +213,110 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
!
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1
newsz=i-1
end if
end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),&
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',szero,is_legal_s_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_s_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_sprecbld

2
mlprec/mld_sprecfree.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine mld_sprecfree(p,info)
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if

4
mlprec/mld_zaggrmat_asb.f90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_onelev_prec_type), input/output.
! p - type(mld_z_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -100,7 +100,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_zaggrmat_raw_asb.F90
Unescape Escape View File

@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_onelev_prec_type), input/output.
! p - type(mld_z_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -88,7 +88,7 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

4
mlprec/mld_zaggrmat_smth_asb.F90
Unescape Escape View File

@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_onelev_prec_type), input/output.
! p - type(mld_z_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@ -105,7 +105,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables

10
mlprec/mld_zbaseprec_bld.f90
Unescape Escape View File

@ -38,7 +38,7 @@
!!$
! File: mld_zbaseprec_bld.f90
!
! Subroutine: mld_zbaseprc_bld
! Subroutine: mld_zbaseprec_bld
! Version: complex
!
! This routine builds a 'base preconditioner' related to a matrix A.
@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_zbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_zbaseprec_bld
Implicit None
@ -89,7 +89,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
name = 'mld_zbaseprc_bld'
name = 'mld_zbaseprec_bld'
info=0
err=0
call psb_erractionsave(err_act)
@ -211,5 +211,5 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_zbaseprc_bld
end subroutine mld_zbaseprec_bld

12
mlprec/mld_zmlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - complex(psb_dpk_), input.
! The scalar alpha.
! precv - type(mld_z_onelev_prec_type), dimension(:), input.
! precv - type(mld_z_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -341,7 +341,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -577,7 +577,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -837,7 +837,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -1135,7 +1135,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)

2
mlprec/mld_zmlprec_bld.f90
Unescape Escape View File

@ -69,7 +69,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_z_onelev_prec_type), intent(inout),target :: p
type(mld_z_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables

185
mlprec/mld_zprecbld.f90
Unescape Escape View File

@ -73,13 +73,14 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_zprec_type),intent(inout) :: p
type(mld_zprec_type),intent(inout), target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_zprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@ -129,7 +130,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@ -153,7 +155,6 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@ -187,7 +188,7 @@ subroutine mld_zprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@ -199,36 +200,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@ -240,40 +213,110 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
!
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1
newsz=i-1
end if
end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),&
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',dzero,is_legal_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@ -304,8 +347,42 @@ contains
do k=1,size(p%av)
call psb_nullify_sp(p%av(k))
end do
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_z_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_zprecbld

2
mlprec/mld_zprecfree.f90
Unescape Escape View File

@ -76,7 +76,7 @@ subroutine mld_zprecfree(p,info)
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if

Write Preview
Loading…
Cancel
Save