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') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)

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

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ 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 psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_descr use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_descr
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
@ -66,13 +66,14 @@ subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
end if end if
write(iout_,*) write(iout_,*)
if (il == 2) then if (il == ilmin) then
call lv%parms%mldescr(iout_,info) call lv%parms%mldescr(iout_,info)
write(iout_,*) write(iout_,*)
end if end if
if (il > 1) then
if (coarse) then if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)' write(iout_,*) ' Level ',il,' (coarse)'
else else
write(iout_,*) ' Level ',il write(iout_,*) ' Level ',il
end if end if
@ -81,8 +82,8 @@ subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
if (nl > 1) then if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot & sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
@ -90,6 +91,7 @@ subroutine mld_c_base_onelev_descr(lv,il,nl,info,iout)
if (coarse.and.allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return 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 (level >= 2) then
if (ac_) then if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head) call lv%ac%print(fname,head=head)
end if end if
if (rp_) then if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx' 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) call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx' 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) call lv%map%map_Y2X%print(fname,head=head)
end if end if
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_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) 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') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)

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

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ 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 psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_descr use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_descr
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
@ -66,13 +66,14 @@ subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
end if end if
write(iout_,*) write(iout_,*)
if (il == 2) then if (il == ilmin) then
call lv%parms%mldescr(iout_,info) call lv%parms%mldescr(iout_,info)
write(iout_,*) write(iout_,*)
end if end if
if (il > 1) then
if (coarse) then if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)' write(iout_,*) ' Level ',il,' (coarse)'
else else
write(iout_,*) ' Level ',il write(iout_,*) ' Level ',il
end if end if
@ -81,8 +82,8 @@ subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
if (nl > 1) then if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot & sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
@ -90,6 +91,7 @@ subroutine mld_d_base_onelev_descr(lv,il,nl,info,iout)
if (coarse.and.allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return 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 (level >= 2) then
if (ac_) then if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head) call lv%ac%print(fname,head=head)
end if end if
if (rp_) then if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx' 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) call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx' 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) call lv%map%map_Y2X%print(fname,head=head)
end if end if
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_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) 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') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)

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

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ 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 psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_descr use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_descr
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
@ -66,13 +66,14 @@ subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
end if end if
write(iout_,*) write(iout_,*)
if (il == 2) then if (il == ilmin) then
call lv%parms%mldescr(iout_,info) call lv%parms%mldescr(iout_,info)
write(iout_,*) write(iout_,*)
end if end if
if (il > 1) then
if (coarse) then if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)' write(iout_,*) ' Level ',il,' (coarse)'
else else
write(iout_,*) ' Level ',il write(iout_,*) ' Level ',il
end if end if
@ -81,8 +82,8 @@ subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
if (nl > 1) then if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot & sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
@ -90,6 +91,7 @@ subroutine mld_s_base_onelev_descr(lv,il,nl,info,iout)
if (coarse.and.allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return 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 (level >= 2) then
if (ac_) then if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head) call lv%ac%print(fname,head=head)
end if end if
if (rp_) then if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx' 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) call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx' 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) call lv%map%map_Y2X%print(fname,head=head)
end if end if
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_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) 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') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)

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

@ -36,14 +36,14 @@
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ 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 psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_descr use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_descr
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
@ -66,13 +66,14 @@ subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
end if end if
write(iout_,*) write(iout_,*)
if (il == 2) then if (il == ilmin) then
call lv%parms%mldescr(iout_,info) call lv%parms%mldescr(iout_,info)
write(iout_,*) write(iout_,*)
end if end if
if (il > 1) then
if (coarse) then if (coarse) then
write(iout_,*) ' Level ',il,' (coarsest)' write(iout_,*) ' Level ',il,' (coarse)'
else else
write(iout_,*) ' Level ',il write(iout_,*) ' Level ',il
end if end if
@ -81,8 +82,8 @@ subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
if (nl > 1) then if (nl > 1) then
if (allocated(lv%map%naggr)) then if (allocated(lv%map%naggr)) then
write(iout_,*) ' Size of coarse matrix: ', & write(iout_,*) ' Coarse Matrix: Dimension: ', &
& sum(lv%map%naggr(:)),lv%ac_nz_tot & sum(lv%map%naggr(:)),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Sizes of aggregates: ', & write(iout_,*) ' Sizes of aggregates: ', &
& lv%map%naggr(:) & lv%map%naggr(:)
end if end if
@ -90,6 +91,7 @@ subroutine mld_z_base_onelev_descr(lv,il,nl,info,iout)
if (coarse.and.allocated(lv%sm)) & if (coarse.and.allocated(lv%sm)) &
& call lv%sm%descr(info,iout=iout_,coarse=coarse) & call lv%sm%descr(info,iout=iout_,coarse=coarse)
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return 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 (level >= 2) then
if (ac_) then if (ac_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx' write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_ac.mtx'
write(0,*) 'Filename ',fname
call lv%ac%print(fname,head=head) call lv%ac%print(fname,head=head)
end if end if
if (rp_) then if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx' 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) call lv%map%map_X2Y%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx' 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) call lv%map%map_Y2X%print(fname,head=head)
end if end if
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_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) 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 ! File: mld_cprecset.f90
! !
! Subroutine: mld_cprecseti ! Subroutine: mld_cprecseti
! Version: real ! Version: complex
! !
! This routine sets the integer parameters defining the preconditioner. More ! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value ! 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 ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! respectively.
! !
! !
@ -85,9 +85,6 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
use mld_c_diag_solver use mld_c_diag_solver
use mld_c_ilu_solver use mld_c_ilu_solver
use mld_c_id_solver use mld_c_id_solver
#if defined(HAVE_UMF_) && 0
use mld_c_umf_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_c_slu_solver use mld_c_slu_solver
#endif #endif
@ -133,7 +130,6 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1) p%coarse_aggr_size = max(val,-1)
return return
end if end if
! !
! Set preconditioner parameters at level ilev. ! 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. ! Rules for fine level are slightly different.
! !
select case(psb_toupper(what)) select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE') case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info) call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE') case('SUB_SOLVE')
@ -195,9 +191,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info) call onelev_set_smoother(p%precv(nlev_),val,info)
#if defined(HAVE_UMF_) && 0 #if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) 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 ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(psb_toupper(what)) select case(psb_toupper(trim(what)))
case('SUB_SOLVE') case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1) do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then if (.not.allocated(p%precv(ilev_)%sm)) then
@ -296,9 +290,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
#if defined(HAVE_UMF_) && 0 #if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
@ -512,26 +504,6 @@ contains
end if end if
call level%sm%sv%set('SUB_SOLVE',val,info) 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_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -565,7 +537,7 @@ end subroutine mld_ccprecseti
! !
! Subroutine: mld_cprecsetc ! Subroutine: mld_cprecsetc
! Version: real ! Version: complex
! !
! This routine sets the character parameters defining the preconditioner. More ! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value ! 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 ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! respectively.
! !
! !
@ -653,10 +625,10 @@ end subroutine mld_ccprecsetc
! !
! Subroutine: mld_cprecsetr ! Subroutine: mld_cprecsetr
! Version: real ! Version: complex
! !
! This routine sets the real parameters defining the preconditioner. More ! This routine sets the complex parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value ! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'. ! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these ! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide. ! 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 ! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide. ! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output. ! info - integer, output.
@ -705,6 +677,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -749,6 +722,13 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info) 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 case default
do ilev_=1,nlev_ do ilev_=1,nlev_

14
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_id_solver
use mld_c_diag_solver use mld_c_diag_solver
use mld_c_ilu_solver use mld_c_ilu_solver
#if defined(HAVE_UMF_) && 0
use mld_c_umf_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_c_slu_solver use mld_c_slu_solver
#endif #endif
@ -115,7 +112,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr real(psb_spk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -191,9 +188,7 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
ilev_ = nlev_ ilev_ = nlev_
allocate(mld_c_jac_smoother_type :: p%precv(ilev_)%sm, stat=info) allocate(mld_c_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
#if defined(HAVE_UMF_) && 0 #if defined(HAVE_SLU_)
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) allocate(mld_c_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#else #else
allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_c_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
@ -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_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.05
scale = 1.0
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) 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 end do
case default case default

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

@ -47,7 +47,7 @@
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! respectively.
! !
! !
@ -85,9 +85,6 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
use mld_c_diag_solver use mld_c_diag_solver
use mld_c_ilu_solver use mld_c_ilu_solver
use mld_c_id_solver use mld_c_id_solver
#if defined(HAVE_UMF_) && 0
use mld_c_umf_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_c_slu_solver use mld_c_slu_solver
#endif #endif
@ -195,13 +192,6 @@ subroutine mld_cprecseti(p,what,val,info,ilev)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info) 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) 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_) case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) 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) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) 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) 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_) case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
@ -511,27 +494,6 @@ contains
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
call level%sm%sv%set(mld_sub_solve_,val,info) 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_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -708,7 +670,7 @@ end subroutine mld_cprecsetsv
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! respectively.
! !
! !
@ -787,8 +749,8 @@ end subroutine mld_cprecsetc
! Subroutine: mld_cprecsetr ! Subroutine: mld_cprecsetr
! Version: complex ! Version: complex
! !
! This routine sets the real parameters defining the preconditioner. More ! This routine sets the complex parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value ! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'. ! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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 ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -881,6 +844,13 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info) 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 case default
do ilev_=1,nlev_ do ilev_=1,nlev_
@ -892,3 +862,6 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
end subroutine mld_cprecsetr 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_) #if defined(HAVE_UMF_)
use mld_d_umf_solver use mld_d_umf_solver
#endif #endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
#if defined(HAVE_SLUDIST_) #if defined(HAVE_SLUDIST_)
use mld_d_sludist_solver use mld_d_sludist_solver
#endif #endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
implicit none implicit none
@ -136,7 +136,6 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1) p%coarse_aggr_size = max(val,-1)
return return
end if end if
! !
! Set preconditioner parameters at level ilev. ! 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. ! Rules for fine level are slightly different.
! !
select case(psb_toupper(what)) select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE') case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info) call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE') 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 ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(psb_toupper(what)) select case(psb_toupper(trim(what)))
case('SUB_SOLVE') case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1) do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then if (.not.allocated(p%precv(ilev_)%sm)) then
@ -515,40 +514,40 @@ contains
end if end if
call level%sm%sv%set('SUB_SOLVE',val,info) call level%sm%sv%set('SUB_SOLVE',val,info)
#ifdef HAVE_UMF_ #ifdef HAVE_SLU_
case (mld_umf_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv) select type (sv => level%sm%sv)
class is (mld_d_umf_solver_type) class is (mld_d_slu_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) 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) & level%sm%sv, stat=info)
end select end select
else else
allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info) allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(level%sm)) then
if (allocated(level%sm%sv)) & if (allocated(level%sm%sv)) &
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
#endif #endif
#ifdef HAVE_SLU_ #ifdef HAVE_UMF_
case (mld_slu_) case (mld_umf_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv) select type (sv => level%sm%sv)
class is (mld_d_slu_solver_type) class is (mld_d_umf_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) 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) & level%sm%sv, stat=info)
end select end select
else else
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info) allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(level%sm)) then
if (allocated(level%sm%sv)) & if (allocated(level%sm%sv)) &
@ -728,6 +727,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -772,6 +772,13 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info) 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 case default
do ilev_=1,nlev_ do ilev_=1,nlev_

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

@ -115,7 +115,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr real(psb_dpk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -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_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.05
scale = 1.0
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) 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 end do
case default 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_) #if defined(HAVE_UMF_)
use mld_d_umf_solver use mld_d_umf_solver
#endif #endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
#if defined(HAVE_SLUDIST_) #if defined(HAVE_SLUDIST_)
use mld_d_sludist_solver use mld_d_sludist_solver
#endif #endif
#if defined(HAVE_SLU_)
use mld_d_slu_solver
#endif
implicit none implicit none
@ -204,6 +204,11 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) 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 #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) 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_) 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) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) 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 #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) 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_) case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
@ -514,7 +524,6 @@ contains
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
call level%sm%sv%set(mld_sub_solve_,val,info) call level%sm%sv%set(mld_sub_solve_,val,info)
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -535,40 +544,40 @@ contains
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
#endif #endif
#ifdef HAVE_SLU_ #ifdef HAVE_SLUDIST_
case (mld_slu_) case (mld_sludist_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv) select type (sv => level%sm%sv)
class is (mld_d_slu_solver_type) class is (mld_d_sludist_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) 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) & level%sm%sv, stat=info)
end select end select
else else
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info) allocate(mld_d_sludist_solver_type :: level%sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(level%sm)) then
if (allocated(level%sm%sv)) & if (allocated(level%sm%sv)) &
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
#endif #endif
#ifdef HAVE_SLUDIST_ #ifdef HAVE_SLU_
case (mld_sludist_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
select type (sv => level%sm%sv) select type (sv => level%sm%sv)
class is (mld_d_sludist_solver_type) class is (mld_d_slu_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call level%sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) 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) & level%sm%sv, stat=info)
end select end select
else else
allocate(mld_d_sludist_solver_type :: level%sm%sv, stat=info) allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(level%sm)) then
if (allocated(level%sm%sv)) & if (allocated(level%sm%sv)) &
@ -860,6 +869,7 @@ subroutine mld_dprecsetr(p,what,val,info,ilev)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -904,6 +914,13 @@ subroutine mld_dprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info) 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 case default
do ilev_=1,nlev_ 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_diag_solver
use mld_s_ilu_solver use mld_s_ilu_solver
use mld_s_id_solver use mld_s_id_solver
#if defined(HAVE_UMF_) && 0
use mld_s_umf_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_s_slu_solver use mld_s_slu_solver
#endif #endif
@ -133,7 +130,6 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
p%coarse_aggr_size = max(val,-1) p%coarse_aggr_size = max(val,-1)
return return
end if end if
! !
! Set preconditioner parameters at level ilev. ! 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. ! Rules for fine level are slightly different.
! !
select case(psb_toupper(what)) select case(psb_toupper(trim(what)))
case('SMOOTHER_TYPE') case('SMOOTHER_TYPE')
call onelev_set_smoother(p%precv(ilev_),val,info) call onelev_set_smoother(p%precv(ilev_),val,info)
case('SUB_SOLVE') case('SUB_SOLVE')
@ -195,9 +191,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info) call onelev_set_smoother(p%precv(nlev_),val,info)
#if defined(HAVE_UMF_) && 0 #if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) 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 ! ilev not specified: set preconditioner parameters at all the appropriate
! levels ! levels
! !
select case(psb_toupper(what)) select case(psb_toupper(trim(what)))
case('SUB_SOLVE') case('SUB_SOLVE')
do ilev_=1,max(1,nlev_-1) do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%sm)) then if (.not.allocated(p%precv(ilev_)%sm)) then
@ -296,9 +290,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
#if defined(HAVE_UMF_) && 0 #if defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
#elif defined(HAVE_SLU_)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
@ -512,26 +504,6 @@ contains
end if end if
call level%sm%sv%set('SUB_SOLVE',val,info) 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_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -671,7 +643,7 @@ end subroutine mld_scprecsetc
! The number identifying the parameter to be set. ! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these ! A mnemonic constant has been associated to each of these
! numbers, as reported in the MLD2P4 User's and Reference Guide. ! 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 ! The value of the parameter to be set. The list of allowed
! values is reported in the MLD2P4 User's and Reference Guide. ! values is reported in the MLD2P4 User's and Reference Guide.
! info - integer, output. ! info - integer, output.
@ -705,6 +677,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -749,6 +722,13 @@ subroutine mld_scprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info) 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 case default
do ilev_=1,nlev_ do ilev_=1,nlev_

14
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_id_solver
use mld_s_diag_solver use mld_s_diag_solver
use mld_s_ilu_solver use mld_s_ilu_solver
#if defined(HAVE_UMF_) && 0
use mld_s_umf_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_s_slu_solver use mld_s_slu_solver
#endif #endif
@ -115,7 +112,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr real(psb_spk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -191,9 +188,7 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
ilev_ = nlev_ ilev_ = nlev_
allocate(mld_s_jac_smoother_type :: p%precv(ilev_)%sm, stat=info) allocate(mld_s_jac_smoother_type :: p%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
#if defined(HAVE_UMF_) && 0 #if defined(HAVE_SLU_)
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) allocate(mld_s_slu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
#else #else
allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info) allocate(mld_s_ilu_solver_type :: p%precv(ilev_)%sm%sv, stat=info)
@ -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_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.05
scale = 1.0
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) 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 end do
case default case default

48
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_diag_solver
use mld_s_ilu_solver use mld_s_ilu_solver
use mld_s_id_solver use mld_s_id_solver
#if defined(HAVE_UMF_) && 0
use mld_s_umf_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_s_slu_solver use mld_s_slu_solver
#endif #endif
@ -195,13 +192,6 @@ subroutine mld_sprecseti(p,what,val,info,ilev)
select case (val) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),val,info) 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) 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_) case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) 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) select case (val)
case(mld_bjac_) case(mld_bjac_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) 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) 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_) case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
@ -511,27 +494,6 @@ contains
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
call level%sm%sv%set(mld_sub_solve_,val,info) 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_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -837,6 +799,7 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
! Local variables ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -881,6 +844,13 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info) 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 case default
do ilev_=1,nlev_ do ilev_=1,nlev_
@ -893,3 +863,5 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
end subroutine mld_sprecsetr end subroutine mld_sprecsetr

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

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

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

@ -115,7 +115,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr real(psb_dpk_) :: thr, scale
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -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_prol_,psb_none_,info)
call p%precv(ilev_)%set(mld_sub_ovr_,izero,info) call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.16d0 thr = 0.05
scale = 1.0
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info) 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 end do
case default case default

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

@ -47,7 +47,7 @@
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! respectively.
! !
! !
@ -88,6 +88,9 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
#if defined(HAVE_UMF_) #if defined(HAVE_UMF_)
use mld_z_umf_solver use mld_z_umf_solver
#endif #endif
#if defined(HAVE_SLUDIST_)
use mld_z_sludist_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_z_slu_solver use mld_z_slu_solver
#endif #endif
@ -201,6 +204,11 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
call onelev_set_solver(p%precv(nlev_),mld_slu_,info) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) 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 #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) 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_) 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) call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
#else #else
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) 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 #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) 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_) case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
@ -511,7 +524,6 @@ contains
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
call level%sm%sv%set(mld_sub_solve_,val,info) call level%sm%sv%set(mld_sub_solve_,val,info)
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -532,6 +544,26 @@ contains
& call level%sm%sv%default() & call level%sm%sv%default()
end if end if
#endif #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_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(level%sm%sv)) then
@ -708,7 +740,7 @@ end subroutine mld_zprecsetsv
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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. ! respectively.
! !
! !
@ -779,6 +811,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
val = mld_stringval(string) val = mld_stringval(string)
if (val >=0) call p%set(what,val,info,ilev=ilev) if (val >=0) call p%set(what,val,info,ilev=ilev)
end subroutine mld_zprecsetc end subroutine mld_zprecsetc
@ -786,8 +819,8 @@ end subroutine mld_zprecsetc
! Subroutine: mld_zprecsetr ! Subroutine: mld_zprecsetr
! Version: complex ! Version: complex
! !
! This routine sets the real parameters defining the preconditioner. More ! This routine sets the complex parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value ! precisely, the complex parameter identified by 'what' is assigned the value
! contained in 'val'. ! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing ! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level. ! 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 ! Local variables
integer(psb_ipk_) :: ilev_,nlev_ integer(psb_ipk_) :: ilev_,nlev_
real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precsetr' character(len=*), parameter :: name='mld_precsetr'
info = psb_success_ info = psb_success_
@ -880,6 +914,13 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info) 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 case default
do ilev_=1,nlev_ do ilev_=1,nlev_
@ -892,3 +933,5 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
end subroutine mld_zprecsetr end subroutine mld_zprecsetr

20
mlprec/mld_base_prec_type.F90
Unescape Escape View File

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

4
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_c_onelev_mod
interface 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, & import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, &
& psb_clinmap_type, psb_spk_, mld_c_onelev_type, & & psb_clinmap_type, psb_spk_, mld_c_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type & psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(mld_c_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_c_base_onelev_descr 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 integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev ilmin = 2
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_) if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do end do
write(iout_,*) write(iout_,*)

4
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_d_onelev_mod
interface 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, & import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &
& psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type & psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_d_base_onelev_descr 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 integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev ilmin = 2
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_) if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do end do
write(iout_,*) write(iout_,*)

4
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_s_onelev_mod
interface 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, & import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, &
& psb_slinmap_type, psb_spk_, mld_s_onelev_type, & & psb_slinmap_type, psb_spk_, mld_s_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type & psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(mld_s_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_s_base_onelev_descr 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 integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev ilmin = 2
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_) if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do end do
write(iout_,*) write(iout_,*)

4
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -162,14 +162,14 @@ module mld_z_onelev_mod
interface 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, & import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, &
& psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, &
& psb_ipk_, psb_long_int_k_, psb_desc_type & psb_ipk_, psb_long_int_k_, psb_desc_type
Implicit None Implicit None
! Arguments ! Arguments
class(mld_z_onelev_type), intent(in) :: lv 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(out) :: info
integer(psb_ipk_), intent(in), optional :: iout integer(psb_ipk_), intent(in), optional :: iout
end subroutine mld_z_base_onelev_descr 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 integer(psb_ipk_), intent(in), optional :: root
! Local variables ! Local variables
integer(psb_ipk_) :: ilev, nlev integer(psb_ipk_) :: ilev, nlev, ilmin
integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20), parameter :: name='mld_file_prec_descr' character(len=20), parameter :: name='mld_file_prec_descr'
integer(psb_ipk_) :: iout_ integer(psb_ipk_) :: iout_
@ -486,8 +486,10 @@ contains
write(iout_,*) 'Multilevel details' write(iout_,*) 'Multilevel details'
write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Number of levels : ',nlev
write(iout_,*) ' Operator complexity: ',p%get_complexity() write(iout_,*) ' Operator complexity: ',p%get_complexity()
do ilev=2,nlev ilmin = 2
call p%precv(ilev)%descr(ilev,nlev,info,iout=iout_) if (nlev == 2) ilmin=1
do ilev=ilmin,nlev
call p%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_)
end do end do
write(iout_,*) 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 BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD CSR ! Storage format CSR COO JAD
080 ! IDIM; domain size is idim**3 040 ! IDIM; domain size is idim**3
2 ! ISTOPC 2 ! ISTOPC
2000 ! ITMAX 2000 ! ITMAX
1 ! ITRACE 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.d-4 ! Threshold T for ILU(T,P)
1 ! Smoother/Jacobi sweeps 1 ! Smoother/Jacobi sweeps
AS ! Smoother type JACOBI BJAC AS; ignored for non-ML 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 SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
DEC ! Type of aggregation DEC SYMDEC GLB DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT MULT ! Type of multilevel correction: ADD MULT
TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD) TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST
SLU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST UMF ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
1 ! Coarse level: Level-set N for ILU(N) 0 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps
-0.10d0 ! Smoother Aggregation Threshold: >= 0.0 default if <0 -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