fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
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.
This commit is contained in:
Salvatore Filippone
2009-01-13 15:24:55 +00:00
parent 24e1123fc6
commit 6002976472
38 changed files with 962 additions and 538 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README
+1 -1
View File
@@ -8,7 +8,7 @@ In version 1.0.1:
- The internals of the multilevel preconditioner have been repackaged
in a more structured fashion; no changes are needed in the user
code.
- Note that we now need version 2.3.1 of PSBLAS.
- Note that we now need version 2.3.1 of PSBLAS.
To compile:
config/pac.m4
+2 -2
View File
@@ -141,8 +141,8 @@ dnl Warning : square brackets are EVIL!
[
cat > conftest.$ac_ext <<EOF
program main
#if ( __GNUC__ >= 4 && __GNUC_MINOR__ >= 2 ) || ( __GNUC__ > 4 )
print *, "ciao"
#if ( __GNUC__ >= 4 && __GNUC_MINOR__ > 2 ) || ( __GNUC__ > 4 )
print *, "ok"
#else
this program will fail
#endif
krylov/psb_prec_mod.F90
-47
View File
@@ -50,50 +50,6 @@
!
module psb_prec_mod
#if (__GNUC__==4) && (__GNUC_MINOR__<=2)
!
! GNU Fortran 4.2.
! Workaround for PR 32634, it is fixed in GNU Fortran 4.3, will
! it be fixed in 4.2???
!
use mld_prec_type, &
& psb_dbaseprc_type => mld_dbaseprc_type,&
& psb_zbaseprc_type => mld_zbaseprc_type,&
& psb_dprec_type => mld_dprec_type,&
& psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr
use mld_prec_mod
interface psb_precbld
module procedure mld_dprecbld, mld_zprecbld
end interface
interface psb_precinit
module procedure mld_dprecinit, mld_zprecinit
end interface
interface psb_precset
module procedure mld_dprecseti, mld_dprecsetd,&
& mld_zprecseti, mld_zprecsetd
end interface
interface psb_precfree
module procedure mld_dprecfree, mld_zprecfree
end interface
interface psb_precaply
module procedure mld_dprec_aply, mld_dprec_aply1, &
& mld_zprec_aply, mld_zprec_aply1
end interface
#else
use mld_prec_mod, &
& psb_sbaseprc_type => mld_sbaseprc_type,&
& psb_dbaseprc_type => mld_dbaseprc_type,&
@@ -103,7 +59,6 @@ module psb_prec_mod
& psb_dprec_type => mld_dprec_type,&
& psb_cprec_type => mld_cprec_type,&
& psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr,&
@@ -113,8 +68,6 @@ module psb_prec_mod
& psb_precset => mld_precset, &
& psb_precaply => mld_precaply
#endif
integer, parameter :: psb_noprec_=mld_noprec_, psb_diag_=mld_diag_,&
& psb_bjac_=mld_bjac_
mlprec/Makefile
+14 -10
View File
@@ -6,32 +6,34 @@ HERE=.
FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLIBDIR)
MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o
MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o mld_transfer_mod.o
MPFOBJS=mld_saggrmat_raw_asb.o mld_saggrmat_smth_asb.o \
mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \
mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \
mld_zaggrmat_raw_asb.o mld_zaggrmat_smth_asb.o
MPCOBJS=mld_sslud_interface.o mld_dslud_interface.o mld_cslud_interface.o mld_zslud_interface.o
INNEROBJS=mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\
mld_smlprec_bld.o mld_ssp_renum.o mld_sfact_bld.o mld_silu_bld.o \
INNEROBJS=mld_saggr_bld.o mld_daggr_bld.o \
mld_caggr_bld.o mld_zaggr_bld.o \
mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\
mld_ssp_renum.o mld_sfact_bld.o mld_silu_bld.o \
mld_sbaseprec_bld.o mld_sdiag_bld.o mld_saggrmap_bld.o \
mld_smlprec_aply.o mld_sslud_bld.o\
mld_sbaseprec_aply.o mld_ssub_aply.o mld_ssub_solve.o \
mld_sas_aply.o mld_saggrmat_asb.o \
mld_das_bld.o mld_dslu_bld.o mld_dumf_bld.o mld_dilu0_fact.o\
mld_dmlprec_bld.o mld_dsp_renum.o mld_dfact_bld.o mld_dilu_bld.o \
mld_dsp_renum.o mld_dfact_bld.o mld_dilu_bld.o \
mld_dbaseprec_bld.o mld_ddiag_bld.o mld_daggrmap_bld.o \
mld_dmlprec_aply.o mld_dslud_bld.o\
mld_dbaseprec_aply.o mld_dsub_aply.o mld_dsub_solve.o \
mld_das_aply.o mld_daggrmat_asb.o \
mld_cas_bld.o mld_cslu_bld.o mld_cumf_bld.o mld_cilu0_fact.o\
mld_cmlprec_bld.o mld_csp_renum.o mld_cfact_bld.o mld_cilu_bld.o \
mld_csp_renum.o mld_cfact_bld.o mld_cilu_bld.o \
mld_cbaseprec_bld.o mld_cdiag_bld.o mld_caggrmap_bld.o \
mld_cmlprec_aply.o mld_cslud_bld.o\
mld_cbaseprec_aply.o mld_csub_aply.o mld_csub_solve.o \
mld_cas_aply.o mld_caggrmat_asb.o\
mld_zas_bld.o mld_zslu_bld.o mld_zumf_bld.o mld_zilu0_fact.o\
mld_zmlprec_bld.o mld_zsp_renum.o mld_zfact_bld.o mld_zilu_bld.o \
mld_zsp_renum.o mld_zfact_bld.o mld_zilu_bld.o \
mld_zbaseprec_bld.o mld_zdiag_bld.o mld_zaggrmap_bld.o \
mld_zmlprec_aply.o mld_zslud_bld.o\
mld_zbaseprec_aply.o mld_zsub_aply.o mld_zsub_solve.o \
@@ -39,13 +41,13 @@ INNEROBJS=mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\
mld_siluk_fact.o mld_ciluk_fact.o mld_silut_fact.o mld_cilut_fact.o \
mld_diluk_fact.o mld_ziluk_fact.o mld_dilut_fact.o mld_zilut_fact.o \
$(MPFOBJS)
OUTEROBJS=mld_sprecbld.o mld_sprecfree.o mld_sprecset.o mld_sprecinit.o\
OUTEROBJS=mld_sprecbld.o mld_sprecset.o mld_sprecinit.o\
mld_sprec_aply.o \
mld_dprecbld.o mld_dprecfree.o mld_dprecset.o mld_dprecinit.o\
mld_dprecbld.o mld_dprecset.o mld_dprecinit.o\
mld_dprec_aply.o \
mld_cprecbld.o mld_cprecfree.o mld_cprecset.o mld_cprecinit.o\
mld_cprecbld.o mld_cprecset.o mld_cprecinit.o\
mld_cprec_aply.o \
mld_zprecbld.o mld_zprecfree.o mld_zprecset.o mld_zprecinit.o \
mld_zprecbld.o mld_zprecset.o mld_zprecinit.o \
mld_zprec_aply.o
F90OBJS=$(OUTEROBJS) $(INNEROBJS)
@@ -67,6 +69,8 @@ lib: mpobjs $(OBJS)
$(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod))
mld_prec_mod.o mld_innner_mod.o: mld_prec_type.o
mld_inner_mod.o: mld_transfer_mod.o
mld_transfer_mod.o: mld_prec_type.o
$(MODOBJS): $(PSBLIBDIR)/psb_base_mod$(.mod)
mlprec/mld_caggrmat_asb.f90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_onelev_prec_type), input/output.
! p - type(mld_c_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -100,7 +100,7 @@ subroutine mld_caggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_caggrmat_raw_asb.F90
+2 -2
View File
@@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_onelev_prec_type), input/output.
! p - type(mld_c_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -88,7 +88,7 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_caggrmat_smth_asb.F90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_onelev_prec_type), input/output.
! p - type(mld_c_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -105,7 +105,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_cbaseprec_bld.f90
+4 -4
View File
@@ -38,7 +38,7 @@
!!$
! File: mld_cbaseprec_bld.f90
!
! Subroutine: mld_cbaseprc_bld
! Subroutine: mld_cbaseprec_bld
! Version: complex
!
! This routine builds a 'base preconditioner' related to a matrix A.
@@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_cbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_cbaseprec_bld
Implicit None
@@ -211,5 +211,5 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_cbaseprc_bld
end subroutine mld_cbaseprec_bld
mlprec/mld_cmlprec_aply.f90
+6 -6
View File
@@ -78,7 +78,7 @@
! Arguments:
! alpha - complex(psb_spk_), input.
! The scalar alpha.
! precv - type(mld_c_onelev_prec_type), dimension(:), input.
! precv - type(mld_c_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@@ -148,7 +148,7 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@@ -341,7 +341,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@@ -577,7 +577,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@@ -837,7 +837,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@@ -1135,7 +1135,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: precv(:)
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
mlprec/mld_cmlprec_bld.f90
+1 -1
View File
@@ -69,7 +69,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_c_onelev_prec_type), intent(inout),target :: p
type(mld_c_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_cprecbld.f90
+130 -53
View File
@@ -73,13 +73,14 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type),intent(inout) :: p
type(mld_cprec_type),intent(inout), target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_cprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@@ -129,7 +130,8 @@ subroutine mld_cprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@@ -153,7 +155,6 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@@ -187,7 +188,7 @@ subroutine mld_cprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@@ -199,36 +200,8 @@ subroutine mld_cprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@@ -240,40 +213,110 @@ subroutine mld_cprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
!
! 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
k=i-1
end if
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 ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',szero,is_legal_s_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_c_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_cprecbld
mlprec/mld_cprecfree.f90
+1 -1
View File
@@ -76,7 +76,7 @@ subroutine mld_cprecfree(p,info)
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
mlprec/mld_daggrmat_asb.f90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_onelev_prec_type), input/output.
! p - type(mld_d_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -100,7 +100,7 @@ subroutine mld_daggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_daggrmat_raw_asb.F90
+2 -2
View File
@@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_onelev_prec_type), input/output.
! p - type(mld_d_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -88,7 +88,7 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_daggrmat_smth_asb.F90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_onelev_prec_type), input/output.
! p - type(mld_d_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -105,7 +105,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_dbaseprec_bld.f90
+3 -3
View File
@@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_dbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_dbaseprec_bld
Implicit None
@@ -211,5 +211,5 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_dbaseprc_bld
end subroutine mld_dbaseprec_bld
mlprec/mld_dmlprec_aply.f90
+6 -6
View File
@@ -78,7 +78,7 @@
! Arguments:
! alpha - real(psb_dpk_), input.
! The scalar alpha.
! precv - type(mld_d_onelev_prec_type), dimension(:), input.
! precv - type(mld_d_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@@ -148,7 +148,7 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@@ -340,7 +340,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@@ -575,7 +575,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@@ -834,7 +834,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@@ -1131,7 +1131,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
mlprec/mld_dmlprec_bld.f90
+1 -1
View File
@@ -70,7 +70,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_d_onelev_prec_type), intent(inout),target :: p
type(mld_d_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_dprecbld.f90
+136 -59
View File
@@ -67,19 +67,20 @@ subroutine mld_dprecbld(a,desc_a,p,info)
use psb_base_mod
use mld_inner_mod
use mld_prec_mod, protect => mld_dprecbld
use mld_prec_mod, mld_protect_name => mld_dprecbld
Implicit None
! Arguments
type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout) :: p
integer, intent(out) :: info
type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type),intent(inout),target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_dprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@@ -129,7 +130,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@@ -153,7 +155,6 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@@ -187,7 +188,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@@ -199,36 +200,8 @@ subroutine mld_dprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@@ -240,40 +213,110 @@ subroutine mld_dprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
!
! 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
k=i-1
end if
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 ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',dzero,is_legal_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@@ -304,8 +347,42 @@ contains
do k=1,size(p%av)
call psb_nullify_sp(p%av(k))
end do
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_d_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_dprecbld
mlprec/mld_inner_mod.f90
+77 -76
View File
@@ -38,6 +38,7 @@
!!$
module mld_inner_mod
use mld_prec_type
use mld_transfer_mod
interface mld_baseprec_aply
subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
@@ -144,9 +145,9 @@ module mld_inner_mod
interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@@ -156,9 +157,9 @@ module mld_inner_mod
end subroutine mld_smlprec_aply
subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_onelev_prec_type), intent(in) :: precv(:)
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@@ -168,9 +169,9 @@ module mld_inner_mod
end subroutine mld_dmlprec_aply
subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_onelev_prec_type), intent(in) :: baseprecv(:)
type(mld_c_interlev_prec_type), intent(in) :: baseprecv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@@ -180,9 +181,9 @@ module mld_inner_mod
end subroutine mld_cmlprec_aply
subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: baseprecv(:)
type(mld_z_interlev_prec_type), intent(in) :: baseprecv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@@ -383,6 +384,41 @@ module mld_inner_mod
end subroutine mld_zsp_renum
end interface
interface mld_aggr_bld
subroutine mld_saggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggr_bld
subroutine mld_daggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggr_bld
subroutine mld_caggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggr_bld
subroutine mld_zaggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggr_bld
end interface
interface mld_aggrmap_bld
subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
@@ -429,34 +465,34 @@ module mld_inner_mod
interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_asb
end interface
@@ -464,34 +500,34 @@ module mld_inner_mod
interface mld_aggrmat_raw_asb
subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_raw_asb
subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_raw_asb
subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_raw_asb
subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_raw_asb
end interface
@@ -499,40 +535,40 @@ module mld_inner_mod
interface mld_aggrmat_smth_asb
subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_smth_asb
subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_smth_asb
subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_onelev_prec_type), intent(inout), target :: p
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_smth_asb
subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_smth_asb
end interface
interface mld_baseprc_bld
subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
interface mld_baseprec_bld
subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type
type(psb_sspmat_type), target :: a
@@ -540,8 +576,8 @@ module mld_inner_mod
type(mld_sbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_sbaseprc_bld
subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd)
end subroutine mld_sbaseprec_bld
subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type
type(psb_dspmat_type), target :: a
@@ -549,8 +585,8 @@ module mld_inner_mod
type(mld_dbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_dbaseprc_bld
subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd)
end subroutine mld_dbaseprec_bld
subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type
type(psb_cspmat_type), target :: a
@@ -558,8 +594,8 @@ module mld_inner_mod
type(mld_cbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_cbaseprc_bld
subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
end subroutine mld_cbaseprec_bld
subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type
type(psb_zspmat_type), target :: a
@@ -567,7 +603,7 @@ module mld_inner_mod
type(mld_zbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine mld_zbaseprc_bld
end subroutine mld_zbaseprec_bld
end interface
interface mld_as_bld
@@ -609,41 +645,6 @@ module mld_inner_mod
end subroutine mld_zas_bld
end interface
interface mld_mlprec_bld
subroutine mld_smlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type
type(psb_sspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_smlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type
type(psb_dspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_d_onelev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_dmlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type
type(psb_cspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_c_onelev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
end subroutine mld_cmlprec_bld
subroutine mld_zmlprec_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type
type(psb_zspmat_type), intent(inout), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_z_onelev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
end subroutine mld_zmlprec_bld
end interface
interface mld_diag_bld
subroutine mld_sdiag_bld(a,desc_data,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
mlprec/mld_prec_mod.f90
+39 -39
View File
@@ -199,33 +199,33 @@ module mld_prec_mod
integer, optional, intent(in) :: ilev
end subroutine mld_zprecsetc
end interface
interface mld_precfree
subroutine mld_sprecfree(p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sprec_type
type(mld_sprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_sprecfree
subroutine mld_dprecfree(p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dprec_type
type(mld_dprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_dprecfree
subroutine mld_cprecfree(p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cprec_type
type(mld_cprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_cprecfree
subroutine mld_zprecfree(p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zprec_type
type(mld_zprec_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine mld_zprecfree
end interface
!!$
!!$ interface mld_precfree
!!$ subroutine mld_sprecfree(p,info)
!!$ use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
!!$ use mld_prec_type, only : mld_sprec_type
!!$ type(mld_sprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_sprecfree
!!$ subroutine mld_dprecfree(p,info)
!!$ use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
!!$ use mld_prec_type, only : mld_dprec_type
!!$ type(mld_dprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_dprecfree
!!$ subroutine mld_cprecfree(p,info)
!!$ use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
!!$ use mld_prec_type, only : mld_cprec_type
!!$ type(mld_cprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_cprecfree
!!$ subroutine mld_zprecfree(p,info)
!!$ use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
!!$ use mld_prec_type, only : mld_zprec_type
!!$ type(mld_zprec_type), intent(inout) :: p
!!$ integer, intent(out) :: info
!!$ end subroutine mld_zprecfree
!!$ end interface
interface mld_precaply
subroutine mld_sprec_aply(prec,x,y,desc_data,info,trans,work)
@@ -315,30 +315,30 @@ module mld_prec_mod
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sprec_type
implicit none
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type), intent(inout) :: prec
integer, intent(out) :: info
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type), intent(inout), target :: prec
integer, intent(out) :: info
!!$ character, intent(in),optional :: upd
end subroutine mld_sprecbld
subroutine mld_dprecbld(a,desc_a,prec,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout) :: prec
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
integer, intent(out) :: info
!!$ character, intent(in),optional :: upd
end subroutine mld_dprecbld
subroutine mld_cprecbld(a,desc_a,prec,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cprec_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type), intent(inout) :: prec
integer, intent(out) :: info
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_cprec_type), intent(inout), target :: prec
integer, intent(out) :: info
!!$ character, intent(in),optional :: upd
end subroutine mld_cprecbld
subroutine mld_zprecbld(a,desc_a,prec,info)
mlprec/mld_prec_type.f90
+227 -69
View File
@@ -91,14 +91,14 @@ module mld_prec_type
! one, i.e. level 1 is the finest level and A(1) is the matrix A.
!
!| type mld_Xprec_type
!| type(mld_X_onelev_prec_type), allocatable :: precv(:)
!| type(mld_X_interlev_prec_type), allocatable :: precv(:)
!| end type mld_Xprec_type
!|
!
! precv(ilev) is the preconditioner at level ilev.
! The number of levels is given by size(precv(:)).
!
! Type: mld_X_onelev_prec_type.
! Type: mld_X_interlev_prec_type.
! The data type containing necessary items for the current level.
!
! type(mld_Xbaseprc_type) - prec
@@ -175,7 +175,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_sbaseprc_type
type mld_s_onelev_prec_type
type mld_s_interlev_prec_type
type(mld_sbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
@@ -185,10 +185,10 @@ module mld_prec_type
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_s_onelev_prec_type
end type mld_s_interlev_prec_type
type mld_sprec_type
type(mld_s_onelev_prec_type), allocatable :: precv(:)
type(mld_s_interlev_prec_type), allocatable :: precv(:)
end type mld_sprec_type
type mld_dbaseprc_type
@@ -200,7 +200,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_dbaseprc_type
type mld_d_onelev_prec_type
type mld_d_interlev_prec_type
type(mld_dbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
@@ -210,10 +210,10 @@ module mld_prec_type
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_d_onelev_prec_type
end type mld_d_interlev_prec_type
type mld_dprec_type
type(mld_d_onelev_prec_type), allocatable :: precv(:)
type(mld_d_interlev_prec_type), allocatable :: precv(:)
end type mld_dprec_type
@@ -226,7 +226,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_cbaseprc_type
type mld_c_onelev_prec_type
type mld_c_interlev_prec_type
type(mld_cbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
@@ -236,10 +236,10 @@ module mld_prec_type
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_c_onelev_prec_type
end type mld_c_interlev_prec_type
type mld_cprec_type
type(mld_c_onelev_prec_type), allocatable :: precv(:)
type(mld_c_interlev_prec_type), allocatable :: precv(:)
end type mld_cprec_type
type mld_zbaseprc_type
@@ -251,7 +251,7 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_zbaseprc_type
type mld_z_onelev_prec_type
type mld_z_interlev_prec_type
type(mld_zbaseprc_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
@@ -261,10 +261,10 @@ module mld_prec_type
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map_desc
end type mld_z_onelev_prec_type
end type mld_z_interlev_prec_type
type mld_zprec_type
type(mld_z_onelev_prec_type), allocatable :: precv(:)
type(mld_z_interlev_prec_type), allocatable :: precv(:)
end type mld_zprec_type
@@ -411,14 +411,13 @@ module mld_prec_type
! for printing its description and for deallocating its data structure
!
interface mld_base_precfree
interface mld_precfree
module procedure mld_sbase_precfree, mld_cbase_precfree,&
& mld_dbase_precfree, mld_zbase_precfree
end interface
interface mld_onelev_precfree
module procedure mld_s_onelev_precfree, mld_d_onelev_precfree, &
& mld_c_onelev_precfree, mld_z_onelev_precfree
& mld_dbase_precfree, mld_zbase_precfree, &
& mld_s_onelev_precfree, mld_d_onelev_precfree, &
& mld_c_onelev_precfree, mld_z_onelev_precfree, &
& mld_sprec_free, mld_dprec_free, &
& mld_cprec_free, mld_zprec_free
end interface
interface mld_nullify_baseprec
@@ -435,6 +434,7 @@ module mld_prec_type
module procedure mld_icheck_def, mld_scheck_def, mld_dcheck_def
end interface
interface mld_precdescr
module procedure mld_file_prec_descr, &
& mld_zfile_prec_descr,&
@@ -457,7 +457,6 @@ module mld_prec_type
contains
!
! Subroutine: mld_stringval
!
@@ -755,7 +754,7 @@ contains
function mld_s_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_s_onelev_prec_type), intent(in) :: prec
type(mld_s_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@@ -772,7 +771,7 @@ contains
function mld_d_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_d_onelev_prec_type), intent(in) :: prec
type(mld_d_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@@ -789,7 +788,7 @@ contains
function mld_c_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_c_onelev_prec_type), intent(in) :: prec
type(mld_c_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@@ -806,7 +805,7 @@ contains
function mld_z_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_z_onelev_prec_type), intent(in) :: prec
type(mld_z_interlev_prec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@@ -1859,16 +1858,11 @@ contains
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
!!$ call mld_sslu_free(p%iprcparm(mld_slu_ptr_),info)
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_sslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
end if
!!$ if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
!!$ call mld_ssludist_free(p%iprcparm(mld_slud_ptr_),info)
!!$ end if
!!$ if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
!!$ call mld_dumf_free(p%iprcparm(mld_umf_symptr_),&
!!$ & p%iprcparm(mld_umf_numptr_),info)
!!$ end if
deallocate(p%iprcparm,stat=info)
end if
call mld_nullify_baseprec(p)
@@ -1878,7 +1872,7 @@ contains
subroutine mld_s_onelev_precfree(p,info)
implicit none
type(mld_s_onelev_prec_type), intent(inout) :: p
type(mld_s_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@@ -1886,7 +1880,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@@ -1921,7 +1915,7 @@ contains
subroutine mld_nullify_s_onelevprec(p)
implicit none
type(mld_s_onelev_prec_type), intent(inout) :: p
type(mld_s_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@@ -1983,15 +1977,17 @@ contains
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_dslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
call mld_dsludist_free(p%iprcparm(mld_slud_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_dumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_dslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then
call mld_dsludist_free(p%iprcparm(mld_slud_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_dumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
end if
end if
deallocate(p%iprcparm,stat=info)
end if
@@ -2001,7 +1997,7 @@ contains
subroutine mld_d_onelev_precfree(p,info)
implicit none
type(mld_d_onelev_prec_type), intent(inout) :: p
type(mld_d_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@@ -2009,7 +2005,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@@ -2053,7 +2049,7 @@ contains
subroutine mld_nullify_d_onelevprec(p)
implicit none
type(mld_d_onelev_prec_type), intent(inout) :: p
type(mld_d_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@@ -2100,13 +2096,11 @@ contains
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
!!$ call mld_cslu_free(p%iprcparm(mld_slu_ptr_),info)
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_cslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
end if
!!$ if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
!!$ call mld_zumf_free(p%iprcparm(mld_umf_symptr_),&
!!$ & p%iprcparm(mld_umf_numptr_),info)
!!$ end if
deallocate(p%iprcparm,stat=info)
end if
call mld_nullify_baseprec(p)
@@ -2115,7 +2109,7 @@ contains
subroutine mld_c_onelev_precfree(p,info)
implicit none
type(mld_c_onelev_prec_type), intent(inout) :: p
type(mld_c_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@@ -2123,7 +2117,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@@ -2157,7 +2151,7 @@ contains
subroutine mld_nullify_c_onelevprec(p)
implicit none
type(mld_c_onelev_prec_type), intent(inout) :: p
type(mld_c_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@@ -2213,13 +2207,15 @@ contains
deallocate(p%invperm,stat=info)
endif
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_zslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_zumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
if (allocated(p%iprcparm)) then
if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then
if (p%iprcparm(mld_sub_solve_)==mld_slu_) then
call mld_zslu_free(p%iprcparm(mld_slu_ptr_),info)
end if
if (p%iprcparm(mld_sub_solve_)==mld_umf_) then
call mld_zumf_free(p%iprcparm(mld_umf_symptr_),&
& p%iprcparm(mld_umf_numptr_),info)
end if
end if
deallocate(p%iprcparm,stat=info)
end if
@@ -2229,7 +2225,7 @@ contains
subroutine mld_z_onelev_precfree(p,info)
implicit none
type(mld_z_onelev_prec_type), intent(inout) :: p
type(mld_z_interlev_prec_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@@ -2237,7 +2233,7 @@ contains
! Actually we might just deallocate the top level array, except
! for the inner UMFPACK or SLU stuff
call mld_base_precfree(p%prec,info)
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
if (allocated(p%desc_ac%matrix_data)) &
@@ -2271,7 +2267,7 @@ contains
subroutine mld_nullify_z_onelevprec(p)
implicit none
type(mld_z_onelev_prec_type), intent(inout) :: p
type(mld_z_interlev_prec_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@@ -2309,4 +2305,166 @@ contains
end function pr_to_str
subroutine mld_sprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_sprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_sprec_free
subroutine mld_dprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_dprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_dprec_free
subroutine mld_cprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_cprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_cprec_free
subroutine mld_zprec_free(p,info)
use psb_base_mod
implicit none
! Arguments
type(mld_zprec_type), intent(inout) :: p
integer, intent(out) :: info
! Local variables
integer :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
me=-1
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine mld_zprec_free
end module mld_prec_type
mlprec/mld_saggrmat_asb.f90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_onelev_prec_type), input/output.
! p - type(mld_s_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -100,7 +100,7 @@ subroutine mld_saggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_saggrmat_raw_asb.F90
+2 -2
View File
@@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_onelev_prec_type), input/output.
! p - type(mld_s_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -88,7 +88,7 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_saggrmat_smth_asb.F90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_onelev_prec_type), input/output.
! p - type(mld_s_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -105,7 +105,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_onelev_prec_type), intent(inout), target :: p
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_sbaseprec_bld.f90
+4 -4
View File
@@ -38,7 +38,7 @@
!!$
! File: mld_sbaseprec_bld.f90
!
! Subroutine: mld_sbaseprc_bld
! Subroutine: mld_sbaseprec_bld
! Version: real
!
! This routine builds a 'base preconditioner' related to a matrix A.
@@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_sbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_sbaseprec_bld
Implicit None
@@ -211,5 +211,5 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_sbaseprc_bld
end subroutine mld_sbaseprec_bld
mlprec/mld_smlprec_aply.f90
+6 -6
View File
@@ -78,7 +78,7 @@
! Arguments:
! alpha - real(psb_spk_), input.
! The scalar alpha.
! precv - type(mld_s_onelev_prec_type), dimension(:), input.
! precv - type(mld_s_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@@ -148,7 +148,7 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@@ -340,7 +340,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@@ -575,7 +575,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@@ -834,7 +834,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@@ -1131,7 +1131,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_onelev_prec_type), intent(in) :: precv(:)
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
mlprec/mld_smlprec_bld.f90
+1 -1
View File
@@ -70,7 +70,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_s_onelev_prec_type), intent(inout),target :: p
type(mld_s_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_sprecbld.f90
+134 -57
View File
@@ -67,19 +67,20 @@ subroutine mld_sprecbld(a,desc_a,p,info)
use psb_base_mod
use mld_inner_mod
use mld_prec_mod, protect => mld_sprecbld
use mld_prec_mod, mld_protect_name => mld_sprecbld
Implicit None
! Arguments
type(psb_sspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type),intent(inout) :: p
integer, intent(out) :: info
type(psb_sspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_sprec_type),intent(inout), target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_sprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@@ -129,7 +130,8 @@ subroutine mld_sprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@@ -153,7 +155,6 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@@ -187,7 +188,7 @@ subroutine mld_sprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@@ -199,36 +200,8 @@ subroutine mld_sprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@@ -240,40 +213,110 @@ subroutine mld_sprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
!
! 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
k=i-1
end if
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 ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',szero,is_legal_s_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@@ -307,5 +350,39 @@ contains
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_s_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_sprecbld
mlprec/mld_sprecfree.f90
+1 -1
View File
@@ -76,7 +76,7 @@ subroutine mld_sprecfree(p,info)
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if
mlprec/mld_zaggrmat_asb.f90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_onelev_prec_type), input/output.
! p - type(mld_z_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -100,7 +100,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_zaggrmat_raw_asb.F90
+2 -2
View File
@@ -66,7 +66,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_onelev_prec_type), input/output.
! p - type(mld_z_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -88,7 +88,7 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_zaggrmat_smth_asb.F90
+2 -2
View File
@@ -83,7 +83,7 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_onelev_prec_type), input/output.
! p - type(mld_z_interlev_prec_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
@@ -105,7 +105,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_onelev_prec_type), intent(inout), target :: p
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_zbaseprec_bld.f90
+5 -5
View File
@@ -38,7 +38,7 @@
!!$
! File: mld_zbaseprec_bld.f90
!
! Subroutine: mld_zbaseprc_bld
! Subroutine: mld_zbaseprec_bld
! Version: complex
!
! This routine builds a 'base preconditioner' related to a matrix A.
@@ -68,10 +68,10 @@
! previously preconditioned, hence some information is reused
! in building the new preconditioner.
!
subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_zbaseprc_bld
use mld_inner_mod, mld_protect_name => mld_zbaseprec_bld
Implicit None
@@ -89,7 +89,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
name = 'mld_zbaseprc_bld'
name = 'mld_zbaseprec_bld'
info=0
err=0
call psb_erractionsave(err_act)
@@ -211,5 +211,5 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd)
end if
return
end subroutine mld_zbaseprc_bld
end subroutine mld_zbaseprec_bld
mlprec/mld_zmlprec_aply.f90
+6 -6
View File
@@ -78,7 +78,7 @@
! Arguments:
! alpha - complex(psb_dpk_), input.
! The scalar alpha.
! precv - type(mld_z_onelev_prec_type), dimension(:), input.
! precv - type(mld_z_interlev_prec_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@@ -148,7 +148,7 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@@ -341,7 +341,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@@ -577,7 +577,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@@ -837,7 +837,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@@ -1135,7 +1135,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_onelev_prec_type), intent(in) :: precv(:)
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
mlprec/mld_zmlprec_bld.f90
+1 -1
View File
@@ -69,7 +69,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_z_onelev_prec_type), intent(inout),target :: p
type(mld_z_interlev_prec_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
mlprec/mld_zprecbld.f90
+131 -54
View File
@@ -73,13 +73,14 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_zprec_type),intent(inout) :: p
type(mld_zprec_type),intent(inout), target :: p
integer, intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables
Integer :: err,i,k,ictxt, me,np, err_act, iszv
type(mld_zprec_type) :: t_prec
Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz
integer :: ipv(mld_ifpsz_), val
integer :: int_err(5)
character :: upd_
@@ -129,7 +130,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
!
! Check to ensure all procs have the same
!
iszv = size(p%precv)
newsz = -1
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
if (iszv /= size(p%precv)) then
info=4001
@@ -153,7 +155,6 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! Finest level first; remember to fix base_a and base_desc
!
call init_baseprc_av(p%precv(1)%prec,info)
if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_)
p%precv(1)%base_a => a
p%precv(1)%base_desc => desc_a
@@ -187,7 +188,7 @@ subroutine mld_zprecbld(a,desc_a,p,info)
&': Inconsistent arguments among processes, resetting.'
p%precv(i)%iprcparm(:) = ipv(:)
end if
!
! Sanity checks on the parameters
!
@@ -199,36 +200,8 @@ subroutine mld_zprecbld(a,desc_a,p,info)
& mld_distr_mat_,is_distr_ml_coarse_mat)
else if (i == iszv) then
!
! At the coarsest level, check mld_coarse_solve_
!
val = p%precv(i)%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(i)%prec%iprcparm(mld_sub_solve_) = val
p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
call check_coarse_lev(p%precv(i))
end if
@@ -240,40 +213,110 @@ subroutine mld_zprecbld(a,desc_a,p,info)
! baseprec_bld is called inside mlprec_bld.
!
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,&
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='Init & build upper level preconditioner')
call psb_errpush(4001,name,a_err='Init upper level preconditioner')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
if (newsz > 0) exit
end if
end do
!
! 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
k=i-1
end if
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 ',&
& k, ' to ',iszv,' coincide.'
write(debug_unit,*) me,trim(name),&
&': Maximum recommended NLEV:',k
& newsz
write(debug_unit,*) trim(name),&
&': to level ',&
& iszv
write(debug_unit,*) trim(name),&
&': coincide.'
write(debug_unit,*) trim(name),&
&': Number of levels actually used :',newsz
write(debug_unit,*)
end if
allocate(t_prec%precv(newsz),stat=info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='prec reallocation')
goto 9999
endif
do i=1,newsz-1
call mld_transfer(p%precv(i),t_prec%precv(i),info)
end do
call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info)
do i=newsz+1, iszv
call mld_precfree(p%precv(i),info)
end do
call mld_transfer(t_prec,p,info)
! Ignore errors from transfer
info = 0
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be already OK
do i=2, iszv - 1
p%precv(i)%base_a => p%precv(i)%ac
p%precv(i)%base_desc => p%precv(i)%desc_ac
p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc
p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc
end do
i = iszv
call check_coarse_lev(p%precv(i))
call init_baseprc_av(p%precv(i)%prec,info)
if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,&
& p%precv(i-1)%base_desc, p%precv(i),info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='coarse rebuild')
goto 9999
endif
end if
endif
end if
do i=1, iszv
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
select case(p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),&
& 'Level',0,is_legal_ml_lev)
case(mld_ilu_t_)
call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
& 'Eps',dzero,is_legal_fact_thrs)
end select
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Return from ',i,' call to mlprcbld ',info
end do
call psb_erractionrestore(err_act)
return
@@ -304,8 +347,42 @@ contains
do k=1,size(p%av)
call psb_nullify_sp(p%av(k))
end do
end subroutine init_baseprc_av
subroutine check_coarse_lev(prec)
type(mld_z_interlev_prec_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_
!
val = prec%iprcparm(mld_coarse_solve_)
select case (val)
case(mld_umf_, mld_slu_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
end if
case(mld_sludist_)
if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.&
& (prec%prec%iprcparm(mld_sub_solve_) /= val)) then
if (me == 0) write(debug_unit,*)&
& 'Warning: inconsistent coarse level specification.'
if (me == 0) write(debug_unit,*)&
& ' Resetting according to the value specified for mld_coarse_solve_.'
prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_
prec%prec%iprcparm(mld_sub_solve_) = val
prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_
prec%prec%iprcparm(mld_smoother_sweeps_) = 1
end if
end select
end subroutine check_coarse_lev
end subroutine mld_zprecbld
mlprec/mld_zprecfree.f90
+1 -1
View File
@@ -76,7 +76,7 @@ subroutine mld_zprecfree(p,info)
if (allocated(p%precv)) then
do i=1,size(p%precv)
call mld_onelev_precfree(p%precv(i),info)
call mld_precfree(p%precv(i),info)
end do
deallocate(p%precv)
end if