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

mld2p4-2:

Browse Source 
mlprec/impl/level/mld_c_base_onelev_csetr.f90
 mlprec/impl/level/mld_c_base_onelev_descr.f90
 mlprec/impl/level/mld_c_base_onelev_dump.f90
 mlprec/impl/level/mld_c_base_onelev_setr.f90
 mlprec/impl/level/mld_d_base_onelev_csetr.f90
 mlprec/impl/level/mld_d_base_onelev_descr.f90
 mlprec/impl/level/mld_d_base_onelev_dump.f90
 mlprec/impl/level/mld_d_base_onelev_setr.f90
 mlprec/impl/level/mld_s_base_onelev_csetr.f90
 mlprec/impl/level/mld_s_base_onelev_descr.f90
 mlprec/impl/level/mld_s_base_onelev_dump.f90
 mlprec/impl/level/mld_s_base_onelev_setr.f90
 mlprec/impl/level/mld_z_base_onelev_csetr.f90
 mlprec/impl/level/mld_z_base_onelev_descr.f90
 mlprec/impl/level/mld_z_base_onelev_dump.f90
 mlprec/impl/level/mld_z_base_onelev_setr.f90
 mlprec/impl/mld_ccprecset.F90
 mlprec/impl/mld_cprecinit.F90
 mlprec/impl/mld_cprecset.F90
 mlprec/impl/mld_dcprecset.F90
 mlprec/impl/mld_dprecinit.F90
 mlprec/impl/mld_dprecset.F90
 mlprec/impl/mld_scprecset.F90
 mlprec/impl/mld_sprecinit.F90
 mlprec/impl/mld_sprecset.F90
 mlprec/impl/mld_zcprecset.F90
 mlprec/impl/mld_zprecinit.F90
 mlprec/impl/mld_zprecset.F90
 mlprec/mld_base_prec_type.F90
 mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_type.f90
 tests/pdegen/runs/ppde.inp

Aligned descr printing with 2.0-maint.
Fix debug statements.
stopcriterion
Salvatore Filippone 9 years ago
parent 84aba17ddf
commit ca1c2616e5
38 changed files with 429 additions and 401 deletions
Show Stats Download Patch File Download Diff File

3
mlprec/impl/level/mld_c_base_onelev_csetr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info)
case ('AGGR_THRESH')
lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

40
mlprec/impl/level/mld_c_base_onelev_descr.f90
Unescape Escape View File

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_descr
Implicit None
! Arguments
class(mld_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
@ -66,31 +66,33 @@ subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
end if
write(iout_,*)
if (il == 2) then
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (il > 1) then
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarse)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
end if
end if
end if
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
return

3
mlprec/impl/level/mld_c_base_onelev_dump.f90
Unescape Escape View File

@ -86,15 +86,12 @@ subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solve
if (level >= 2) then
if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head)
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_Y2X%print(fname,head=head)
end if
end if

3
mlprec/impl/level/mld_c_base_onelev_setr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_c_base_onelev_setr(lv,what,val,info)
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

3
mlprec/impl/level/mld_d_base_onelev_csetr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info)
case ('AGGR_THRESH')
lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

40
mlprec/impl/level/mld_d_base_onelev_descr.f90
Unescape Escape View File

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_descr
Implicit None
! Arguments
class(mld_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
@ -66,31 +66,33 @@ subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
end if
write(iout_,*)
if (il == 2) then
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (il > 1) then
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarse)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
end if
end if
end if
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
return

3
mlprec/impl/level/mld_d_base_onelev_dump.f90
Unescape Escape View File

@ -86,15 +86,12 @@ subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solve
if (level >= 2) then
if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head)
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_Y2X%print(fname,head=head)
end if
end if

3
mlprec/impl/level/mld_d_base_onelev_setr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info)
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

3
mlprec/impl/level/mld_s_base_onelev_csetr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info)
case ('AGGR_THRESH')
lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

40
mlprec/impl/level/mld_s_base_onelev_descr.f90
Unescape Escape View File

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_descr
Implicit None
! Arguments
class(mld_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
@ -66,31 +66,33 @@ subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
end if
write(iout_,*)
if (il == 2) then
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (il > 1) then
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarse)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
end if
end if
end if
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
return

3
mlprec/impl/level/mld_s_base_onelev_dump.f90
Unescape Escape View File

@ -86,15 +86,12 @@ subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solve
if (level >= 2) then
if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head)
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_Y2X%print(fname,head=head)
end if
end if

3
mlprec/impl/level/mld_s_base_onelev_setr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_s_base_onelev_setr(lv,what,val,info)
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

3
mlprec/impl/level/mld_z_base_onelev_csetr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info)
case ('AGGR_THRESH')
lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

40
mlprec/impl/level/mld_z_base_onelev_descr.f90
Unescape Escape View File

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_descr
Implicit None
! Arguments
class(mld_z_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
@ -66,31 +66,33 @@ subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
end if
write(iout_,*)
if (il == 2) then
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
write(iout_,*)
end if
if (il > 1) then
if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)'
else
write(iout_,*) ' Level ',il
end if
if (coarse) then
write(iout_,*) ' Level ',il,' (coarse)'
else
write(iout_,*) ' Level ',il
end if
call lv%parms%descr(iout_,info,coarse=coarse)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:)
end if
end if
end if
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act)
return

3
mlprec/impl/level/mld_z_base_onelev_dump.f90
Unescape Escape View File

@ -86,15 +86,12 @@ subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solve
if (level >= 2) then
if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head)
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
write(0,*) 'Filename ',fname
call lv%map%map_Y2X%print(fname,head=head)
end if
end if

3
mlprec/impl/level/mld_z_base_onelev_setr.f90
Unescape Escape View File

@ -64,6 +64,9 @@ subroutine mld_z_base_onelev_setr(lv,what,val,info)
case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info)

60
mlprec/impl/mld_ccprecset.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! File: mld_cprecset.f90
!
! Subroutine: mld_cprecseti
! Version: real
! Version: complex
!
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
@ -47,7 +47,7 @@
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_cprecsetc and mld_cprecsetr,
! To set character and complex parameters, see mld_cprecsetc and mld_cprecsetr,
! respectively.
!
!
@ -85,9 +85,6 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
use mld_c_diag_solver
use mld_c_ilu_solver
use mld_c_id_solver
#if defined(HAVE_UMF_) && 0
use mld_c_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_c_slu_solver
#endif
@ -133,7 +130,6 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1)
return
end if
!
! Set preconditioner parameters at level ilev.
!
@ -143,7 +139,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
!
! Rules for fine level are slightly different.
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE')
@ -195,9 +191,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
@ -246,7 +240,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then
@ -296,9 +290,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
@ -512,26 +504,6 @@ contains
end if
call level%sm%sv%set('SUB_SOLVE',val,info)
#if defined(HAVE_UMF_) && 0
case (mld_umf_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_c_umf_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_c_umf_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_c_umf_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
@ -565,7 +537,7 @@ end subroutine mld_ccprecseti
!
! Subroutine: mld_cprecsetc
! Version: real
! Version: complex
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
@ -573,7 +545,7 @@ end subroutine mld_ccprecseti
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_cprecseti and mld_cprecsetr,
! To set integer and complex parameters, see mld_cprecseti and mld_cprecsetr,
! respectively.
!
!
@ -653,10 +625,10 @@ end subroutine mld_ccprecsetc
!
! Subroutine: mld_cprecsetr
! Version: real
! Version: complex
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! This routine sets the complex parameters defining the preconditioner. More
! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
@ -671,7 +643,7 @@ end subroutine mld_ccprecsetc
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - real(psb_dpk_), input.
! val - real(psb_spk_), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
@ -705,6 +677,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -749,6 +722,13 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_

16
mlprec/impl/mld_cprecinit.F90
Unescape Escape View File

@ -97,9 +97,6 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
use mld_c_id_solver
use mld_c_diag_solver
use mld_c_ilu_solver
#if defined(HAVE_UMF_) && 0
use mld_c_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_c_slu_solver
#endif
@ -115,7 +112,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr
real(psb_spk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit'
info = psb_success_
@ -191,10 +188,8 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
ilev_ = nlev_
allocate(mld_c_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return
#if defined(HAVE_UMF_) && 0
allocate(mld_c_umf_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#elif defined(HAVE_SLU_)
allocate(mld_c_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#if defined(HAVE_SLU_)
allocate(mld_c_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#else
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#endif
@ -205,10 +200,11 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0
thr = 0.05
scale = 1.0
do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr/2
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
end do
case default

89
mlprec/impl/mld_cprecset.F90
Unescape Escape View File

@ -47,7 +47,7 @@
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_cprecsetc and mld_cprecsetr,
! To set character and complex parameters, see mld_cprecsetc and mld_cprecsetr,
! respectively.
!
!
@ -85,9 +85,6 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
use mld_c_diag_solver
use mld_c_ilu_solver
use mld_c_id_solver
#if defined(HAVE_UMF_) && 0
use mld_c_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_c_slu_solver
#endif
@ -102,7 +99,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables
integer(psb_ipk_) :: ilev_, nlev_
integer(psb_ipk_) :: ilev_, nlev_
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
@ -195,13 +192,6 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
@ -296,13 +286,6 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
@ -360,7 +343,7 @@ contains
select type (sm => level%sm)
type is (mld_c_base_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_c_base_smoother_type ::&
@ -378,9 +361,9 @@ contains
case (mld_jac_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_c_jac_smoother_type)
class is (mld_c_jac_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_c_jac_smoother_type :: &
@ -397,9 +380,9 @@ contains
case (mld_bjac_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_c_jac_smoother_type)
class is (mld_c_jac_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_c_jac_smoother_type ::&
@ -416,9 +399,9 @@ contains
case (mld_as_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_c_as_smoother_type)
class is (mld_c_as_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_c_as_smoother_type ::&
@ -455,9 +438,9 @@ contains
case (mld_f_none_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_c_id_solver_type)
! do nothing
class default
class is (mld_c_id_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_c_id_solver_type ::&
@ -475,9 +458,9 @@ contains
case (mld_diag_scale_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_c_diag_solver_type)
class is (mld_c_diag_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_c_diag_solver_type ::&
@ -511,34 +494,13 @@ contains
& call level%sm%sv%default()
end if
call level%sm%sv%set(mld_sub_solve_,val,info)
#if defined(HAVE_UMF_) && 0
case (mld_umf_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_c_umf_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_c_umf_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_c_umf_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_c_slu_solver_type)
class is (mld_c_slu_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_c_slu_solver_type ::&
@ -640,7 +602,7 @@ subroutine mld_cprecsetsv(p,val,info,ilev)
integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
@ -708,7 +670,7 @@ end subroutine mld_cprecsetsv
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_cprecseti and mld_cprecsetr,
! To set integer and complex parameters, see mld_cprecseti and mld_cprecsetr,
! respectively.
!
!
@ -787,8 +749,8 @@ end subroutine mld_cprecsetc
! Subroutine: mld_cprecsetr
! Version: complex
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! This routine sets the complex parameters defining the preconditioner. More
! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
@ -837,6 +799,7 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -881,6 +844,13 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info)
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_
@ -892,3 +862,6 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
end subroutine mld_cprecsetr

39
mlprec/impl/mld_dcprecset.F90
Unescape Escape View File

@ -88,12 +88,12 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
#if defined(HAVE_UMF_)
use mld_d_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_d_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
implicit none
@ -136,7 +136,6 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1)
return
end if
!
! Set preconditioner parameters at level ilev.
!
@ -146,7 +145,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
!
! Rules for fine level are slightly different.
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE')
@ -249,7 +248,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then
@ -515,40 +514,40 @@ contains
end if
call level%sm%sv%set('SUB_SOLVE',val,info)
#ifdef HAVE_UMF_
case (mld_umf_)
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_d_umf_solver_type)
class is (mld_d_slu_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_d_umf_solver_type ::&
if (info == 0) allocate(mld_d_slu_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info)
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
#ifdef HAVE_UMF_
case (mld_umf_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_d_slu_solver_type)
class is (mld_d_umf_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_d_slu_solver_type ::&
if (info == 0) allocate(mld_d_umf_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info)
allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
@ -728,6 +727,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -772,6 +772,13 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_

9
mlprec/impl/mld_dprecinit.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr
real(psb_dpk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit'
info = psb_success_
@ -194,7 +194,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
#if defined(HAVE_UMF_)
allocate(mld_d_umf_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#elif defined(HAVE_SLU_)
allocate(mld_d_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
allocate(mld_d_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#else
allocate(mld_d_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#endif
@ -205,10 +205,11 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0
thr = 0.05
scale = 1.0
do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr/2
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
end do
case default

45
mlprec/impl/mld_dprecset.F90
Unescape Escape View File

@ -88,12 +88,12 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
#if defined(HAVE_UMF_)
use mld_d_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_d_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
implicit none
@ -204,6 +204,11 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
@ -305,6 +310,11 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
@ -514,7 +524,6 @@ contains
& call level%sm%sv%default()
end if
call level%sm%sv%set(mld_sub_solve_,val,info)
#ifdef HAVE_UMF_
case (mld_umf_)
if (allocated(level%sm%sv)) then
@ -535,40 +544,40 @@ contains
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_d_slu_solver_type)
class is (mld_d_sludist_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_d_slu_solver_type ::&
if (info == 0) allocate(mld_d_sludist_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info)
allocate(mld_d_sludist_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_d_sludist_solver_type)
class is (mld_d_slu_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_d_sludist_solver_type ::&
if (info == 0) allocate(mld_d_slu_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_d_sludist_solver_type :: level%sm%sv, stat=info)
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
@ -860,6 +869,7 @@ subroutine mld_dprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -904,6 +914,13 @@ subroutine mld_dprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info)
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_

46
mlprec/impl/mld_scprecset.F90
Unescape Escape View File

@ -85,9 +85,6 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
use mld_s_diag_solver
use mld_s_ilu_solver
use mld_s_id_solver
#if defined(HAVE_UMF_) && 0
use mld_s_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_s_slu_solver
#endif
@ -133,7 +130,6 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1)
return
end if
!
! Set preconditioner parameters at level ilev.
!
@ -143,7 +139,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
!
! Rules for fine level are slightly different.
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE')
@ -195,9 +191,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
@ -246,7 +240,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then
@ -296,9 +290,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
@ -512,26 +504,6 @@ contains
end if
call level%sm%sv%set('SUB_SOLVE',val,info)
#if defined(HAVE_UMF_) && 0
case (mld_umf_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_s_umf_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_s_umf_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_s_umf_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
@ -671,7 +643,7 @@ end subroutine mld_scprecsetc
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide.
! val - real(psb_dpk_), input.
! val - real(psb_spk_), input.
! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output.
@ -705,6 +677,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -749,6 +722,13 @@ subroutine mld_scprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_

16
mlprec/impl/mld_sprecinit.F90
Unescape Escape View File

@ -97,9 +97,6 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
use mld_s_id_solver
use mld_s_diag_solver
use mld_s_ilu_solver
#if defined(HAVE_UMF_) && 0
use mld_s_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_s_slu_solver
#endif
@ -115,7 +112,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr
real(psb_spk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit'
info = psb_success_
@ -191,10 +188,8 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
ilev_ = nlev_
allocate(mld_s_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return
#if defined(HAVE_UMF_) && 0
allocate(mld_s_umf_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#elif defined(HAVE_SLU_)
allocate(mld_s_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#if defined(HAVE_SLU_)
allocate(mld_s_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#else
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#endif
@ -205,10 +200,11 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0
thr = 0.05
scale = 1.0
do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr/2
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
end do
case default

78
mlprec/impl/mld_sprecset.F90
Unescape Escape View File

@ -85,9 +85,6 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
use mld_s_diag_solver
use mld_s_ilu_solver
use mld_s_id_solver
#if defined(HAVE_UMF_) && 0
use mld_s_umf_solver
#endif
#if defined(HAVE_SLU_)
use mld_s_slu_solver
#endif
@ -195,13 +192,6 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
@ -296,13 +286,6 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
select case (val)
case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
#if defined(HAVE_UMF_) && 0
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
@ -360,7 +343,7 @@ contains
select type (sm => level%sm)
type is (mld_s_base_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_s_base_smoother_type ::&
@ -378,9 +361,9 @@ contains
case (mld_jac_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_s_jac_smoother_type)
class is (mld_s_jac_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_s_jac_smoother_type :: &
@ -397,9 +380,9 @@ contains
case (mld_bjac_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_s_jac_smoother_type)
class is (mld_s_jac_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_s_jac_smoother_type ::&
@ -416,9 +399,9 @@ contains
case (mld_as_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_s_as_smoother_type)
class is (mld_s_as_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_s_as_smoother_type ::&
@ -455,9 +438,9 @@ contains
case (mld_f_none_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_s_id_solver_type)
! do nothing
class default
class is (mld_s_id_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_s_id_solver_type ::&
@ -475,9 +458,9 @@ contains
case (mld_diag_scale_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_s_diag_solver_type)
class is (mld_s_diag_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_s_diag_solver_type ::&
@ -511,34 +494,13 @@ contains
& call level%sm%sv%default()
end if
call level%sm%sv%set(mld_sub_solve_,val,info)
#if defined(HAVE_UMF_) && 0
case (mld_umf_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_s_umf_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_s_umf_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_s_umf_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_s_slu_solver_type)
class is (mld_s_slu_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_s_slu_solver_type ::&
@ -640,7 +602,7 @@ subroutine mld_sprecsetsv(p,val,info,ilev)
integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
@ -837,6 +799,7 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -881,6 +844,13 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info)
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_
@ -893,3 +863,5 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
end subroutine mld_sprecsetr

60
mlprec/impl/mld_zcprecset.F90
Unescape Escape View File

@ -39,7 +39,7 @@
! File: mld_zprecset.f90
!
! Subroutine: mld_zprecseti
! Version: real
! Version: complex
!
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
@ -47,7 +47,7 @@
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_zprecsetc and mld_zprecsetr,
! To set character and complex parameters, see mld_zprecsetc and mld_zprecsetr,
! respectively.
!
!
@ -88,6 +88,9 @@ subroutine mld_zcprecseti(p,what,val,info,ilev)
#if defined(HAVE_UMF_)
use mld_z_umf_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_z_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_z_slu_solver
#endif
@ -133,7 +136,6 @@ subroutine mld_zcprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1)
return
end if
!
! Set preconditioner parameters at level ilev.
!
@ -143,7 +145,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev)
!
! Rules for fine level are slightly different.
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE')
@ -246,7 +248,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev)
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(psb_toupper(what))
select case(psb_toupper(trim(what)))
case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then
@ -512,6 +514,26 @@ contains
end if
call level%sm%sv%set('SUB_SOLVE',val,info)
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_slu_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_slu_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_z_slu_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_UMF_
case (mld_umf_)
if (allocated(level%sm%sv)) then
@ -532,20 +554,20 @@ contains
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_slu_solver_type)
class is (mld_z_sludist_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_slu_solver_type ::&
if (info == 0) allocate(mld_z_sludist_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_z_slu_solver_type :: level%sm%sv, stat=info)
allocate(mld_z_sludist_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
@ -565,7 +587,7 @@ end subroutine mld_zcprecseti
!
! Subroutine: mld_zprecsetc
! Version: real
! Version: complex
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
@ -573,7 +595,7 @@ end subroutine mld_zcprecseti
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_zprecseti and mld_zprecsetr,
! To set integer and complex parameters, see mld_zprecseti and mld_zprecsetr,
! respectively.
!
!
@ -653,10 +675,10 @@ end subroutine mld_zcprecsetc
!
! Subroutine: mld_zprecsetr
! Version: real
! Version: complex
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! This routine sets the complex parameters defining the preconditioner. More
! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
@ -705,6 +727,7 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -749,6 +772,13 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_

9
mlprec/impl/mld_zprecinit.F90
Unescape Escape View File

@ -115,7 +115,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
! Local variables
integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr
real(psb_dpk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit'
info = psb_success_
@ -194,7 +194,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
#if defined(HAVE_UMF_)
allocate(mld_z_umf_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#elif defined(HAVE_SLU_)
allocate(mld_z_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
allocate(mld_z_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#else
allocate(mld_z_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#endif
@ -205,10 +205,11 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0
thr = 0.05
scale = 1.0
do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr/2
call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)
end do
case default

87
mlprec/impl/mld_zprecset.F90
Unescape Escape View File

@ -47,7 +47,7 @@
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_zprecsetc and mld_zprecsetr,
! To set character and complex parameters, see mld_zprecsetc and mld_zprecsetr,
! respectively.
!
!
@ -88,6 +88,9 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
#if defined(HAVE_UMF_)
use mld_z_umf_solver
#endif
#if defined(HAVE_SLUDIST_)
use mld_z_sludist_solver
#endif
#if defined(HAVE_SLU_)
use mld_z_slu_solver
#endif
@ -201,6 +204,11 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
@ -302,6 +310,11 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
#if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
#endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
@ -360,7 +373,7 @@ contains
select type (sm => level%sm)
type is (mld_z_base_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_z_base_smoother_type ::&
@ -378,9 +391,9 @@ contains
case (mld_jac_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_z_jac_smoother_type)
class is (mld_z_jac_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_z_jac_smoother_type :: &
@ -397,9 +410,9 @@ contains
case (mld_bjac_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_z_jac_smoother_type)
class is (mld_z_jac_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_z_jac_smoother_type ::&
@ -416,9 +429,9 @@ contains
case (mld_as_)
if (allocated(level%sm)) then
select type (sm => level%sm)
class is (mld_z_as_smoother_type)
class is (mld_z_as_smoother_type)
! do nothing
class default
class default
call level%sm%free(info)
if (info == 0) deallocate(level%sm)
if (info == 0) allocate(mld_z_as_smoother_type ::&
@ -455,9 +468,9 @@ contains
case (mld_f_none_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_id_solver_type)
! do nothing
class default
class is (mld_z_id_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_id_solver_type ::&
@ -475,9 +488,9 @@ contains
case (mld_diag_scale_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_diag_solver_type)
class is (mld_z_diag_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_diag_solver_type ::&
@ -511,14 +524,13 @@ contains
& call level%sm%sv%default()
end if
call level%sm%sv%set(mld_sub_solve_,val,info)
#ifdef HAVE_UMF_
case (mld_umf_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_umf_solver_type)
class is (mld_z_umf_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_umf_solver_type ::&
@ -532,13 +544,33 @@ contains
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_sludist_solver_type)
! do nothing
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_sludist_solver_type ::&
& level%sm%sv, stat=info)
end select
else
allocate(mld_z_sludist_solver_type :: level%sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
end if
#endif
#ifdef HAVE_SLU_
case (mld_slu_)
if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv)
class is (mld_z_slu_solver_type)
class is (mld_z_slu_solver_type)
! do nothing
class default
class default
call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv)
if (info == 0) allocate(mld_z_slu_solver_type ::&
@ -640,7 +672,7 @@ subroutine mld_zprecsetsv(p,val,info,ilev)
integer(psb_ipk_), optional, intent(in) :: ilev
! Local variables
integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
integer(psb_ipk_) :: ilev_, nlev_, ilmin, ilmax
character(len=*), parameter :: name='mld_precseti'
info = psb_success_
@ -708,7 +740,7 @@ end subroutine mld_zprecsetsv
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_zprecseti and mld_zprecsetr,
! To set integer and complex parameters, see mld_zprecseti and mld_zprecsetr,
! respectively.
!
!
@ -779,6 +811,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
val = mld_stringval(string)
if (val >=0) call p%set(what,val,info,ilev=ilev)
end subroutine mld_zprecsetc
@ -786,8 +819,8 @@ end subroutine mld_zprecsetc
! Subroutine: mld_zprecsetr
! Version: complex
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! This routine sets the complex parameters defining the preconditioner. More
! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
@ -836,6 +869,7 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
! Local variables
integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr'
info = psb_success_
@ -880,6 +914,13 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info)
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default
do ilev_=1,nlev_
@ -892,3 +933,5 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
end subroutine mld_zprecsetr

22
mlprec/mld_base_prec_type.F90
Unescape Escape View File

@ -80,9 +80,9 @@ module mld_base_prec_type
!
! Version numbers
!
character(len=*), parameter :: mld_version_string_ = "2.0.0"
character(len=*), parameter :: mld_version_string_ = "2.1.0"
integer(psb_ipk_), parameter :: mld_version_major_ = 2
integer(psb_ipk_), parameter :: mld_version_minor_ = 0
integer(psb_ipk_), parameter :: mld_version_minor_ = 1
integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
@ -111,7 +111,7 @@ module mld_base_prec_type
type, extends(mld_ml_parms) :: mld_sml_parms
real(psb_spk_) :: aggr_omega_val, aggr_thresh
real(psb_spk_) :: aggr_omega_val, aggr_thresh, aggr_scale
contains
procedure, pass(pm) :: clone => s_ml_parms_clone
procedure, pass(pm) :: descr => s_ml_parms_descr
@ -119,7 +119,7 @@ module mld_base_prec_type
end type mld_sml_parms
type, extends(mld_ml_parms) :: mld_dml_parms
real(psb_dpk_) :: aggr_omega_val, aggr_thresh
real(psb_dpk_) :: aggr_omega_val, aggr_thresh, aggr_scale
contains
procedure, pass(pm) :: clone => d_ml_parms_clone
procedure, pass(pm) :: descr => d_ml_parms_descr
@ -278,6 +278,7 @@ module mld_base_prec_type
integer(psb_ipk_), parameter :: mld_aggr_omega_val_ = 2
integer(psb_ipk_), parameter :: mld_aggr_thresh_ = 3
integer(psb_ipk_), parameter :: mld_coarse_iluthrs_ = 4
integer(psb_ipk_), parameter :: mld_aggr_scale_ = 5
integer(psb_ipk_), parameter :: mld_rfpsz_ = 8
!
@ -541,16 +542,17 @@ contains
integer(psb_ipk_), intent(out) :: info
info = psb_success_
write(iout,*) ' Coarsest matrix: ',&
write(iout,*) ' Coarse matrix: ',&
& matrix_names(pm%coarse_mat)
if (pm%coarse_solve == mld_bjac_) then
write(iout,*) ' Coarse solver: Block Jacobi '
if ((pm%coarse_solve == mld_bjac_).or.(pm%coarse_solve==mld_as_)) then
write(iout,*) ' Number of sweeps : ',&
& pm%sweeps
& pm%sweeps
write(iout,*) ' Coarse solver: ',&
& 'Block Jacobi'
else
write(iout,*) ' Coarse solver: ',&
& fact_names(pm%coarse_solve)
endif
end if
end subroutine ml_parms_coarsedescr
@ -997,6 +999,7 @@ contains
call pm%mld_ml_parms%clone(pout%mld_ml_parms,info)
pout%aggr_omega_val = pm%aggr_omega_val
pout%aggr_thresh = pm%aggr_thresh
pout%aggr_scale = pm%aggr_scale
class default
info = psb_err_invalid_dynamic_type_
ierr(1) = 2
@ -1026,6 +1029,7 @@ contains
call pm%mld_ml_parms%clone(pout%mld_ml_parms,info)
pout%aggr_omega_val = pm%aggr_omega_val
pout%aggr_thresh = pm%aggr_thresh
pout%aggr_scale = pm%aggr_scale
class default
info = psb_err_invalid_dynamic_type_
ierr(1) = 2

4
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_c_onelev_mod
interface
subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_c_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_c_base_onelev_descr

8
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -414,7 +414,7 @@ contains
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do
write(iout_,*)

4
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_d_onelev_mod
interface
subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_d_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_d_base_onelev_descr

8
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -414,7 +414,7 @@ contains
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do
write(iout_,*)

4
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_s_onelev_mod
interface
subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_s_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_s_base_onelev_descr

8
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -414,7 +414,7 @@ contains
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do
write(iout_,*)

4
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_z_onelev_mod
interface
subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
subroutine mld_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None
! Arguments
class(mld_z_onelev_type), intent(in) :: lv
integer(psb_ipk_), intent(in) :: il,nl
integer(psb_ipk_), intent(in) :: il,nl,ilmin
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_z_base_onelev_descr

8
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -414,7 +414,7 @@ contains
integer(psb_ipk_), intent(in), optional :: root
! Local variables
integer(psb_ipk_) :: ilev, nlev
integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_)
ilmin = 2
if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do
write(iout_,*)

10
tests/pdegen/runs/ppde.inp
Unescape Escape View File

@ -1,6 +1,6 @@
BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD
080 ! IDIM; domain size is idim**3
040 ! IDIM; domain size is idim**3
2 ! ISTOPC
2000 ! ITMAX
1 ! ITRACE
@ -16,16 +16,16 @@ ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU
1.d-4 ! Threshold T for ILU(T,P)
1 ! Smoother/Jacobi sweeps
AS ! Smoother type JACOBI BJAC AS; ignored for non-ML
3 ! Number of levels in a multilevel preconditioner
2 ! Number of levels in a multilevel preconditioner
SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST
SLU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
1 ! Coarse level: Level-set N for ILU(N)
UMF ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps
-0.10d0 ! Smoother Aggregation Threshold: >= 0.0 default if <0
200 ! Coarse size limit to determine levels. If <0, then use NL
-200 ! Coarse size limit to determine levels. If <0, then use NL

Write Preview
Loading…
Cancel
Save