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

4
config/pac.m4
Unescape Escape View File

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

47
krylov/psb_prec_mod.F90
Unescape Escape View File

@ -50,50 +50,6 @@
! !
module psb_prec_mod 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, & use mld_prec_mod, &
& psb_sbaseprc_type => mld_sbaseprc_type,& & psb_sbaseprc_type => mld_sbaseprc_type,&
& psb_dbaseprc_type => mld_dbaseprc_type,& & psb_dbaseprc_type => mld_dbaseprc_type,&
@ -103,7 +59,6 @@ module psb_prec_mod
& psb_dprec_type => mld_dprec_type,& & psb_dprec_type => mld_dprec_type,&
& psb_cprec_type => mld_cprec_type,& & psb_cprec_type => mld_cprec_type,&
& psb_zprec_type => mld_zprec_type,& & psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,& & psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_precdescr => mld_precdescr,& & psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr,& & psb_prec_short_descr => mld_prec_short_descr,&
@ -113,8 +68,6 @@ module psb_prec_mod
& psb_precset => mld_precset, & & psb_precset => mld_precset, &
& psb_precaply => mld_precaply & psb_precaply => mld_precaply
#endif
integer, parameter :: psb_noprec_=mld_noprec_, psb_diag_=mld_diag_,& integer, parameter :: psb_noprec_=mld_noprec_, psb_diag_=mld_diag_,&
& psb_bjac_=mld_bjac_ & psb_bjac_=mld_bjac_

24
mlprec/Makefile
Unescape Escape View File

@ -6,32 +6,34 @@ HERE=.
FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLIBDIR) 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 \ MPFOBJS=mld_saggrmat_raw_asb.o mld_saggrmat_smth_asb.o \
mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \ mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \
mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \ mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \
mld_zaggrmat_raw_asb.o mld_zaggrmat_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 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\ INNEROBJS=mld_saggr_bld.o mld_daggr_bld.o \
mld_smlprec_bld.o mld_ssp_renum.o mld_sfact_bld.o mld_silu_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_sbaseprec_bld.o mld_sdiag_bld.o mld_saggrmap_bld.o \
mld_smlprec_aply.o mld_sslud_bld.o\ mld_smlprec_aply.o mld_sslud_bld.o\
mld_sbaseprec_aply.o mld_ssub_aply.o mld_ssub_solve.o \ mld_sbaseprec_aply.o mld_ssub_aply.o mld_ssub_solve.o \
mld_sas_aply.o mld_saggrmat_asb.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_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_dbaseprec_bld.o mld_ddiag_bld.o mld_daggrmap_bld.o \
mld_dmlprec_aply.o mld_dslud_bld.o\ mld_dmlprec_aply.o mld_dslud_bld.o\
mld_dbaseprec_aply.o mld_dsub_aply.o mld_dsub_solve.o \ mld_dbaseprec_aply.o mld_dsub_aply.o mld_dsub_solve.o \
mld_das_aply.o mld_daggrmat_asb.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_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_cbaseprec_bld.o mld_cdiag_bld.o mld_caggrmap_bld.o \
mld_cmlprec_aply.o mld_cslud_bld.o\ mld_cmlprec_aply.o mld_cslud_bld.o\
mld_cbaseprec_aply.o mld_csub_aply.o mld_csub_solve.o \ mld_cbaseprec_aply.o mld_csub_aply.o mld_csub_solve.o \
mld_cas_aply.o mld_caggrmat_asb.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_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_zbaseprec_bld.o mld_zdiag_bld.o mld_zaggrmap_bld.o \
mld_zmlprec_aply.o mld_zslud_bld.o\ mld_zmlprec_aply.o mld_zslud_bld.o\
mld_zbaseprec_aply.o mld_zsub_aply.o mld_zsub_solve.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_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 \ mld_diluk_fact.o mld_ziluk_fact.o mld_dilut_fact.o mld_zilut_fact.o \
$(MPFOBJS) $(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_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_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_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 mld_zprec_aply.o
F90OBJS=$(OUTEROBJS) $(INNEROBJS) F90OBJS=$(OUTEROBJS) $(INNEROBJS)
@ -67,6 +69,8 @@ lib: mpobjs $(OBJS)
$(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod)) $(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod))
mld_prec_mod.o mld_innner_mod.o: mld_prec_type.o 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) $(MODOBJS): $(PSBLIBDIR)/psb_base_mod$(.mod)

4
mlprec/mld_caggrmat_asb.f90
Unescape Escape View File

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

4
mlprec/mld_caggrmat_raw_asb.F90
Unescape Escape View File

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

4
mlprec/mld_caggrmat_smth_asb.F90
Unescape Escape View File

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

8
mlprec/mld_cbaseprec_bld.f90
Unescape Escape View File

@ -38,7 +38,7 @@
!!$ !!$
! File: mld_cbaseprec_bld.f90 ! File: mld_cbaseprec_bld.f90
! !
! Subroutine: mld_cbaseprc_bld ! Subroutine: mld_cbaseprec_bld
! Version: complex ! Version: complex
! !
! This routine builds a 'base preconditioner' related to a matrix A. ! This routine builds a 'base preconditioner' related to a matrix A.
@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused ! previously preconditioned, hence some information is reused
! in building the new preconditioner. ! 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 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 Implicit None
@ -211,5 +211,5 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
end if end if
return 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: ! Arguments:
! alpha - complex(psb_spk_), input. ! alpha - complex(psb_spk_), input.
! The scalar alpha. ! 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 ! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level. ! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels. ! 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 ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
@ -341,7 +341,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
@ -577,7 +577,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
@ -837,7 +837,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
@ -1135,7 +1135,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) 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 ! Arguments
type(psb_cspmat_type), intent(in), target :: a type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_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 integer, intent(out) :: info
! Local variables ! Local variables

171
mlprec/mld_cprecbld.f90
Unescape Escape View File

@ -73,13 +73,14 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Arguments ! Arguments
type(psb_cspmat_type), target :: a type(psb_cspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_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 integer, intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! 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 :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
@ -129,6 +130,7 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! !
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1
iszv = size(p%precv) iszv = size(p%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -153,7 +155,6 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
call init_baseprc_av(p%precv(1)%prec,info) 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_a => a
p%precv(1)%base_desc => desc_a p%precv(1)%base_desc => desc_a
@ -199,36 +200,8 @@ subroutine mld_cprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat) & mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then 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 end if
@ -240,41 +213,111 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld. ! baseprec_bld is called inside mlprec_bld.
! !
call init_baseprc_av(p%precv(i)%prec,info) 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) & p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then 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 goto 9999
endif endif
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info & 'Return from ',i,' call to mlprcbld ',info
end do
! if (i>2) then
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1 newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if end if
end do end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),& if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',& &': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.' & newsz
write(debug_unit,*) me,trim(name),& write(debug_unit,*) trim(name),&
&': Maximum recommended NLEV:',k &': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*) write(debug_unit,*)
end if 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
end if 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 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) call psb_erractionrestore(err_act)
return return
@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av 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 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 if (allocated(p%precv)) then
do i=1,size(p%precv) do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
deallocate(p%precv) deallocate(p%precv)
end if end if

4
mlprec/mld_daggrmat_asb.f90
Unescape Escape View File

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

4
mlprec/mld_daggrmat_raw_asb.F90
Unescape Escape View File

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

4
mlprec/mld_daggrmat_smth_asb.F90
Unescape Escape View File

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

6
mlprec/mld_dbaseprec_bld.f90
Unescape Escape View File

@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused ! previously preconditioned, hence some information is reused
! in building the new preconditioner. ! 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 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 Implicit None
@ -211,5 +211,5 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
end if end if
return 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: ! Arguments:
! alpha - real(psb_dpk_), input. ! alpha - real(psb_dpk_), input.
! The scalar alpha. ! 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 ! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level. ! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels. ! 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 ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
@ -340,7 +340,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
@ -575,7 +575,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
@ -834,7 +834,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
@ -1131,7 +1131,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) 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 ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_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 integer, intent(out) :: info
! Local variables ! Local variables

173
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 psb_base_mod
use mld_inner_mod use mld_inner_mod
use mld_prec_mod, protect => mld_dprecbld use mld_prec_mod, mld_protect_name => mld_dprecbld
Implicit None Implicit None
! Arguments ! Arguments
type(psb_dspmat_type), target :: a type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout) :: p type(mld_dprec_type),intent(inout),target :: p
integer, intent(out) :: info integer, intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! 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 :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
@ -129,6 +130,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! !
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1
iszv = size(p%precv) iszv = size(p%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -153,7 +155,6 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
call init_baseprc_av(p%precv(1)%prec,info) 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_a => a
p%precv(1)%base_desc => desc_a p%precv(1)%base_desc => desc_a
@ -199,36 +200,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat) & mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then 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 end if
@ -240,41 +213,111 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld. ! baseprec_bld is called inside mlprec_bld.
! !
call init_baseprc_av(p%precv(i)%prec,info) 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) & p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then 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 goto 9999
endif endif
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info & 'Return from ',i,' call to mlprcbld ',info
end do
! if (i>2) then
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1 newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if end if
end do end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),& if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',& &': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.' & newsz
write(debug_unit,*) me,trim(name),& write(debug_unit,*) trim(name),&
&': Maximum recommended NLEV:',k &': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*) write(debug_unit,*)
end if 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
end if 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 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) call psb_erractionrestore(err_act)
return return
@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av 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 end subroutine mld_dprecbld

153
mlprec/mld_inner_mod.f90
Unescape Escape View File

@ -38,6 +38,7 @@
!!$ !!$
module mld_inner_mod module mld_inner_mod
use mld_prec_type use mld_prec_type
use mld_transfer_mod
interface mld_baseprec_aply interface mld_baseprec_aply
subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) 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 interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) 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 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(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) :: alpha,beta
real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
@ -156,9 +157,9 @@ module mld_inner_mod
end subroutine mld_smlprec_aply end subroutine mld_smlprec_aply
subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) 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 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(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) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:) real(psb_dpk_),intent(inout) :: y(:)
@ -168,9 +169,9 @@ module mld_inner_mod
end subroutine mld_dmlprec_aply end subroutine mld_dmlprec_aply
subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) 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 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(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) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:) complex(psb_spk_),intent(inout) :: y(:)
@ -180,9 +181,9 @@ module mld_inner_mod
end subroutine mld_cmlprec_aply end subroutine mld_cmlprec_aply
subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) 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 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(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) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
@ -383,6 +384,41 @@ module mld_inner_mod
end subroutine mld_zsp_renum end subroutine mld_zsp_renum
end interface 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 interface mld_aggrmap_bld
subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,nlaggr,ilaggr,info) 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_ 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 interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,p,info) subroutine mld_saggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ 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_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_saggrmat_asb end subroutine mld_saggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,p,info) subroutine mld_daggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ 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_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_daggrmat_asb end subroutine mld_daggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,p,info) subroutine mld_caggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ 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_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_caggrmat_asb end subroutine mld_caggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,p,info) subroutine mld_zaggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ 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_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_zaggrmat_asb end subroutine mld_zaggrmat_asb
end interface end interface
@ -464,34 +500,34 @@ module mld_inner_mod
interface mld_aggrmat_raw_asb interface mld_aggrmat_raw_asb
subroutine mld_saggrmat_raw_asb(a,desc_a,p,info) subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ 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_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_saggrmat_raw_asb end subroutine mld_saggrmat_raw_asb
subroutine mld_daggrmat_raw_asb(a,desc_a,p,info) subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ 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_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_daggrmat_raw_asb end subroutine mld_daggrmat_raw_asb
subroutine mld_caggrmat_raw_asb(a,desc_a,p,info) subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ 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_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_caggrmat_raw_asb end subroutine mld_caggrmat_raw_asb
subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info) subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ 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_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_zaggrmat_raw_asb end subroutine mld_zaggrmat_raw_asb
end interface end interface
@ -499,40 +535,40 @@ module mld_inner_mod
interface mld_aggrmat_smth_asb interface mld_aggrmat_smth_asb
subroutine mld_saggrmat_smth_asb(a,desc_a,p,info) subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ 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_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_saggrmat_smth_asb end subroutine mld_saggrmat_smth_asb
subroutine mld_daggrmat_smth_asb(a,desc_a,p,info) subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ 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_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_daggrmat_smth_asb end subroutine mld_daggrmat_smth_asb
subroutine mld_caggrmat_smth_asb(a,desc_a,p,info) subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ 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_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_caggrmat_smth_asb end subroutine mld_caggrmat_smth_asb
subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info) subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ 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_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_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 integer, intent(out) :: info
end subroutine mld_zaggrmat_smth_asb end subroutine mld_zaggrmat_smth_asb
end interface end interface
interface mld_baseprc_bld interface mld_baseprec_bld
subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd) subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type use mld_prec_type, only : mld_sbaseprc_type
type(psb_sspmat_type), target :: a type(psb_sspmat_type), target :: a
@ -540,8 +576,8 @@ module mld_inner_mod
type(mld_sbaseprc_type),intent(inout) :: p type(mld_sbaseprc_type),intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
character, intent(in), optional :: upd character, intent(in), optional :: upd
end subroutine mld_sbaseprc_bld end subroutine mld_sbaseprec_bld
subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type use mld_prec_type, only : mld_dbaseprc_type
type(psb_dspmat_type), target :: a type(psb_dspmat_type), target :: a
@ -549,8 +585,8 @@ module mld_inner_mod
type(mld_dbaseprc_type),intent(inout) :: p type(mld_dbaseprc_type),intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
character, intent(in), optional :: upd character, intent(in), optional :: upd
end subroutine mld_dbaseprc_bld end subroutine mld_dbaseprec_bld
subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd) subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type use mld_prec_type, only : mld_cbaseprc_type
type(psb_cspmat_type), target :: a type(psb_cspmat_type), target :: a
@ -558,8 +594,8 @@ module mld_inner_mod
type(mld_cbaseprc_type),intent(inout) :: p type(mld_cbaseprc_type),intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
character, intent(in), optional :: upd character, intent(in), optional :: upd
end subroutine mld_cbaseprc_bld end subroutine mld_cbaseprec_bld
subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type use mld_prec_type, only : mld_zbaseprc_type
type(psb_zspmat_type), target :: a type(psb_zspmat_type), target :: a
@ -567,7 +603,7 @@ module mld_inner_mod
type(mld_zbaseprc_type),intent(inout) :: p type(mld_zbaseprc_type),intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
character, intent(in), optional :: upd character, intent(in), optional :: upd
end subroutine mld_zbaseprc_bld end subroutine mld_zbaseprec_bld
end interface end interface
interface mld_as_bld interface mld_as_bld
@ -609,41 +645,6 @@ module mld_inner_mod
end subroutine mld_zas_bld end subroutine mld_zas_bld
end interface 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 interface mld_diag_bld
subroutine mld_sdiag_bld(a,desc_data,p,info) subroutine mld_sdiag_bld(a,desc_data,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_

60
mlprec/mld_prec_mod.f90
Unescape Escape View File

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

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

4
mlprec/mld_saggrmat_asb.f90
Unescape Escape View File

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

4
mlprec/mld_saggrmat_raw_asb.F90
Unescape Escape View File

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

4
mlprec/mld_saggrmat_smth_asb.F90
Unescape Escape View File

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

8
mlprec/mld_sbaseprec_bld.f90
Unescape Escape View File

@ -38,7 +38,7 @@
!!$ !!$
! File: mld_sbaseprec_bld.f90 ! File: mld_sbaseprec_bld.f90
! !
! Subroutine: mld_sbaseprc_bld ! Subroutine: mld_sbaseprec_bld
! Version: real ! Version: real
! !
! This routine builds a 'base preconditioner' related to a matrix A. ! This routine builds a 'base preconditioner' related to a matrix A.
@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused ! previously preconditioned, hence some information is reused
! in building the new preconditioner. ! 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 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 Implicit None
@ -211,5 +211,5 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
end if end if
return 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: ! Arguments:
! alpha - real(psb_spk_), input. ! alpha - real(psb_spk_), input.
! The scalar alpha. ! 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 ! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level. ! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels. ! 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 ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
@ -340,7 +340,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
@ -575,7 +575,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
@ -834,7 +834,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:) real(psb_spk_),intent(inout) :: y(:)
@ -1131,7 +1131,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:) 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 ! Arguments
type(psb_sspmat_type), intent(in), target :: a type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_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 integer, intent(out) :: info
! Local variables ! Local variables

173
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 psb_base_mod
use mld_inner_mod use mld_inner_mod
use mld_prec_mod, protect => mld_sprecbld use mld_prec_mod, mld_protect_name => mld_sprecbld
Implicit None Implicit None
! Arguments ! Arguments
type(psb_sspmat_type), target :: a type(psb_sspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type),intent(inout) :: p type(mld_sprec_type),intent(inout), target :: p
integer, intent(out) :: info integer, intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! 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 :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
@ -129,6 +130,7 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! !
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1
iszv = size(p%precv) iszv = size(p%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -153,7 +155,6 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
call init_baseprc_av(p%precv(1)%prec,info) 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_a => a
p%precv(1)%base_desc => desc_a p%precv(1)%base_desc => desc_a
@ -199,36 +200,8 @@ subroutine mld_sprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat) & mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then 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 end if
@ -240,41 +213,111 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld. ! baseprec_bld is called inside mlprec_bld.
! !
call init_baseprc_av(p%precv(i)%prec,info) 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) & p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then 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 goto 9999
endif endif
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info & 'Return from ',i,' call to mlprcbld ',info
end do
! if (i>2) then
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1 newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if end if
end do end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),& if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',& &': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.' & newsz
write(debug_unit,*) me,trim(name),& write(debug_unit,*) trim(name),&
&': Maximum recommended NLEV:',k &': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*) write(debug_unit,*)
end if 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
end if 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 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) call psb_erractionrestore(err_act)
return return
@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av 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 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 if (allocated(p%precv)) then
do i=1,size(p%precv) do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
deallocate(p%precv) deallocate(p%precv)
end if end if

4
mlprec/mld_zaggrmat_asb.f90
Unescape Escape View File

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

4
mlprec/mld_zaggrmat_raw_asb.F90
Unescape Escape View File

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

4
mlprec/mld_zaggrmat_smth_asb.F90
Unescape Escape View File

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

10
mlprec/mld_zbaseprec_bld.f90
Unescape Escape View File

@ -38,7 +38,7 @@
!!$ !!$
! File: mld_zbaseprec_bld.f90 ! File: mld_zbaseprec_bld.f90
! !
! Subroutine: mld_zbaseprc_bld ! Subroutine: mld_zbaseprec_bld
! Version: complex ! Version: complex
! !
! This routine builds a 'base preconditioner' related to a matrix A. ! This routine builds a 'base preconditioner' related to a matrix A.
@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused ! previously preconditioned, hence some information is reused
! in building the new preconditioner. ! 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 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 Implicit None
@ -89,7 +89,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return if (psb_get_errstatus() /= 0) return
name = 'mld_zbaseprc_bld' name = 'mld_zbaseprec_bld'
info=0 info=0
err=0 err=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -211,5 +211,5 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
end if end if
return 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: ! Arguments:
! alpha - complex(psb_dpk_), input. ! alpha - complex(psb_dpk_), input.
! The scalar alpha. ! 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 ! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level. ! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels. ! 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 ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
@ -341,7 +341,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
@ -577,7 +577,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
@ -837,7 +837,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) complex(psb_dpk_),intent(inout) :: y(:)
@ -1135,7 +1135,7 @@ contains
! Arguments ! Arguments
type(psb_desc_type),intent(in) :: desc_data 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) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:) 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 ! Arguments
type(psb_zspmat_type), intent(in), target :: a type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_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 integer, intent(out) :: info
! Local variables ! Local variables

171
mlprec/mld_zprecbld.f90
Unescape Escape View File

@ -73,13 +73,14 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Arguments ! Arguments
type(psb_zspmat_type), target :: a type(psb_zspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_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 integer, intent(out) :: info
!!$ character, intent(in), optional :: upd !!$ character, intent(in), optional :: upd
! Local Variables ! 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 :: ipv(mld_ifpsz_), val
integer :: int_err(5) integer :: int_err(5)
character :: upd_ character :: upd_
@ -129,6 +130,7 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! !
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1
iszv = size(p%precv) iszv = size(p%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -153,7 +155,6 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc ! Finest level first; remember to fix base_a and base_desc
! !
call init_baseprc_av(p%precv(1)%prec,info) 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_a => a
p%precv(1)%base_desc => desc_a p%precv(1)%base_desc => desc_a
@ -199,36 +200,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat) & mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then 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 end if
@ -240,41 +213,111 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld. ! baseprec_bld is called inside mlprec_bld.
! !
call init_baseprc_av(p%precv(i)%prec,info) 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) & p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then 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 goto 9999
endif endif
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info & 'Return from ',i,' call to mlprcbld ',info
end do
! if (i>2) then
! Check on sizes from level 2 onwards
!
if (me==0) then
k = iszv+1
do i=iszv,3,-1
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
k=i-1 newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if end if
end do end do
if (k<=iszv) then
write(debug_unit,*) me,trim(name),& if (newsz > 0) then
if (me == 0) then
write(debug_unit,*) trim(name),&
&': Warning: aggregates from level ',& &': Warning: aggregates from level ',&
& k, ' to ',iszv,' coincide.' & newsz
write(debug_unit,*) me,trim(name),& write(debug_unit,*) trim(name),&
&': Maximum recommended NLEV:',k &': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*) write(debug_unit,*)
end if 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
end if 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 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) call psb_erractionrestore(err_act)
return return
@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av 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 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 if (allocated(p%precv)) then
do i=1,size(p%precv) do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info) call mld_precfree(p%precv(i),info)
end do end do
deallocate(p%precv) deallocate(p%precv)
end if end if

Write Preview
Loading…
Cancel
Save