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/mld_c_prec_type.f90
 mlprec/mld_d_as_smoother.f03
 mlprec/mld_d_diag_solver.f03
 mlprec/mld_d_ilu_solver.f03
 mlprec/mld_d_jac_smoother.f03
 mlprec/mld_d_prec_type.f03
 mlprec/mld_dprecaply.f90
 mlprec/mld_dprecbld.f90
 mlprec/mld_dprecinit.F90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_prec_type.f90
 tests/pdegen/runs/ppde.inp

Used new Smoother/Solver object hierarchy, for 1 level. 
The precinit/precset is still the old one.
stopcriterion
Salvatore Filippone 15 years ago
parent bbd82a5b45
commit 88e27fb869
12 changed files with 291 additions and 138 deletions
Show Stats Download Patch File Download Diff File

4
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -486,7 +486,7 @@ contains
if (allocated(p%av)) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
@ -535,7 +535,7 @@ contains
! for the inner UMFPACK or SLU stuff
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
call p%ac%free()
if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info)

134
mlprec/mld_d_as_smoother.f03
Unescape Escape View File

@ -71,6 +71,10 @@ module mld_d_as_smoother
& d_as_smoother_setc, d_as_smoother_setr,&
& d_as_smoother_descr, d_as_smoother_sizeof
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
character(len=12), parameter, private :: &
& prolong_names(0:3)=(/'none ','sum ','average ','square root'/)
contains
@ -487,21 +491,21 @@ contains
end subroutine d_as_smoother_apply
subroutine d_as_smoother_bld(a,desc_a,sm,upd,info,b)
subroutine d_as_smoother_bld(a,desc_a,sm,upd,info)
use psb_base_mod
Implicit None
! Arguments
type(psb_d_sparse_mat), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
type(psb_d_sparse_mat), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
type(psb_d_sparse_mat), intent(in), target, optional :: b
character, intent(in) :: upd
integer, intent(out) :: info
! Local variables
integer :: n_row,n_col, nrow_a, nztota
type(psb_d_sparse_mat) :: blck, atmp
integer :: n_row,n_col, nrow_a, nhalo, novr, data_
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_as_smoother_bld', ch_err
@ -516,16 +520,92 @@ contains
& write(debug_unit,*) me,' ',trim(name),' start'
n_row = psb_cd_get_local_rows(desc_a)
novr = sm%novr
if (novr < 0) then
info=3
call psb_errpush(info,name,i_err=(/novr,0,0,0,0,0/))
goto 9999
endif
if ((novr == 0).or.(np==1)) then
if (psb_toupper(upd) == 'F') then
call psb_cdcpy(desc_a,sm%desc_data,info)
If(debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ' done cdcpy'
if(info /= 0) then
info=4010
ch_err='psb_cdcpy'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0'
endif
call blck%csall(0,0,info,1)
else
If (psb_toupper(upd) == 'F') Then
!
! Build the auxiliary descriptor desc_p%matrix_data(psb_n_row_).
! This is done by psb_cdbldext (interface to psb_cdovr), which is
! independent of CSR, and has been placed in the tools directory
! of PSBLAS, instead of the mlprec directory of MLD2P4, because it
! might be used independently of the AS preconditioner, to build
! a descriptor for an extended stencil in a PDE solver.
!
call psb_cdbldext(a,desc_a,novr,sm%desc_data,info,extype=psb_ovt_asov_)
if(debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ' From cdbldext _:',psb_cd_get_local_rows(sm%desc_data),&
& psb_cd_get_local_cols(sm%desc_data)
if (info /= 0) then
info=4010
ch_err='psb_cdbldext'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
Endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo '
!
! Retrieve the remote sparse matrix rows required for the AS extended
! matrix
data_ = psb_comm_ext_
Call psb_sphalo(a,sm%desc_data,blck,info,data=data_,rowscale=.true.)
if (info /= 0) then
info=4010
ch_err='psb_sphalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (debug_level >=psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'After psb_sphalo ',&
& blck%get_nrows(), blck%get_nzeros()
End if
if (info == 0) &
& call sm%sv%build(a,sm%desc_data,upd,info,blck)
nrow_a = a%get_nrows()
nztota = a%get_nzeros()
call a%csclip(sm%nd,info,&
n_row = psb_cd_get_local_rows(sm%desc_data)
n_col = psb_cd_get_local_cols(sm%desc_data)
if (info == 0) call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.)
if (info == 0) call blck%csclip(atmp,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_rwextd(n_row,sm%nd,info,b=atmp)
if (info == 0) call sm%nd%cscnv(info,&
& type='csr',dupl=psb_dupl_add_)
if (info == 0) &
& call sm%sv%build(a,desc_a,upd,info,b)
if (info /= 0) then
call psb_errpush(4010,name,a_err='clip & psb_spcnv csr 4')
@ -568,12 +648,18 @@ contains
select case(what)
case(mld_smoother_sweeps_)
sm%sweeps = val
case(mld_sub_ovr_)
sm%novr = val
case(mld_sub_restr_)
sm%restr = val
case(mld_sub_prol_)
sm%prol = val
case default
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
write(0,*) trim(name),' Missing component, not setting!'
info = 1121
!!$ else
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
end select
@ -648,8 +734,8 @@ contains
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
write(0,*) trim(name),' Missing component, not setting!'
info = 1121
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
call psb_erractionrestore(err_act)
@ -711,9 +797,9 @@ contains
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
@ -729,8 +815,10 @@ contains
iout_ = 6
endif
write(iout_,*) ' Block Jacobi smoother with ',&
& sm%sweeps,' sweeps.'
write(iout_,*) ' Additive Schwarz with ',&
& sm%sweeps,' sweeps and ',sm%novr, ' overlap layers.'
write(iout_,*) ' Restrictor: ',restrict_names(sm%restr)
write(iout_,*) ' Prolongator: ',prolong_names(sm%prol)
write(iout_,*) ' Local solver:'
if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_)
@ -752,7 +840,7 @@ contains
use psb_base_mod
implicit none
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
class(mld_d_as_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i

8
mlprec/mld_d_diag_solver.f03
Unescape Escape View File

@ -426,9 +426,9 @@ contains
Implicit None
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
class(mld_d_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
@ -453,7 +453,7 @@ contains
use psb_base_mod
implicit none
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
class(mld_d_diag_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i

12
mlprec/mld_d_ilu_solver.f03
Unescape Escape View File

@ -409,7 +409,7 @@ contains
case(mld_sub_fillin_)
sv%fill_in = val
case default
write(0,*) name,': Error: invalid WHAT'
!!$ write(0,*) name,': Error: invalid WHAT'
!!$ info = -2
end select
@ -484,7 +484,7 @@ contains
case(mld_sub_iluthrs_)
sv%thresh = val
case default
write(0,*) name,': Error: invalid WHAT'
!!$ write(0,*) name,': Error: invalid WHAT'
!!$ info = -2
!!$ goto 9999
end select
@ -546,9 +546,9 @@ contains
Implicit None
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
class(mld_d_ilu_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
@ -590,7 +590,7 @@ contains
use psb_base_mod
implicit none
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
class(mld_d_ilu_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i

21
mlprec/mld_d_jac_smoother.f03
Unescape Escape View File

@ -226,7 +226,7 @@ contains
end subroutine d_jac_smoother_apply
subroutine d_jac_smoother_bld(a,desc_a,sm,upd,info,b)
subroutine d_jac_smoother_bld(a,desc_a,sm,upd,info)
use psb_base_mod
use mld_d_diag_solver
@ -238,7 +238,6 @@ contains
class(mld_d_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
type(psb_d_sparse_mat), intent(in), target, optional :: b
! Local variables
integer :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
@ -269,7 +268,7 @@ contains
if (info == 0) call sm%nd%cscnv(info,&
& type='csr',dupl=psb_dupl_add_)
if (info == 0) &
& call sm%sv%build(a,desc_a,upd,info,b)
& call sm%sv%build(a,desc_a,upd,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='clip & psb_spcnv csr 4')
goto 9999
@ -316,8 +315,8 @@ contains
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
write(0,*) trim(name),' Missing component, not setting!'
info = 1121
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
end select
@ -392,8 +391,8 @@ contains
if (allocated(sm%sv)) then
call sm%sv%set(what,val,info)
else
write(0,*) trim(name),' Missing component, not setting!'
info = 1121
!!$ write(0,*) trim(name),' Missing component, not setting!'
!!$ info = 1121
end if
call psb_erractionrestore(err_act)
@ -455,9 +454,9 @@ contains
Implicit None
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
class(mld_d_jac_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
@ -496,7 +495,7 @@ contains
use psb_base_mod
implicit none
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
class(mld_d_jac_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i

163
mlprec/mld_d_prec_type.f03
Unescape Escape View File

@ -224,6 +224,7 @@ module mld_d_prec_type
end type mld_donelev_type
type, extends(psb_dprec_type) :: mld_dprec_type
integer :: ictxt
type(mld_donelev_type), allocatable :: precv(:)
contains
procedure, pass(prec) :: d_apply2v => mld_d_apply2v
@ -294,11 +295,13 @@ contains
!
function mld_dprec_sizeof(prec) result(val)
use psb_base_mod
implicit none
type(mld_dprec_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
val = 0
val = val + psb_sizeof_int
if (allocated(prec%precv)) then
do i=1, size(prec%precv)
val = val + mld_sizeof(prec%precv(i))
@ -358,7 +361,7 @@ contains
val = val + psb_sizeof(prec%desc_ac)
val = val + psb_sizeof(prec%ac)
val = val + psb_sizeof(prec%map)
if (allocated(prec%sm)) val = val + prec%sm%sizeof()
end function mld_d_onelev_prec_sizeof
!
@ -400,8 +403,10 @@ contains
end if
if (iout_ < 0) iout_ = 6
ictxt = p%ictxt
if (allocated(p%precv)) then
ictxt = psb_cd_get_context(p%precv(1)%prec%desc_data)
!!$ ictxt = psb_cd_get_context(p%precv(1)%prec%desc_data)
call psb_info(ictxt,me,np)
@ -420,72 +425,71 @@ contains
!
! Print description of base preconditioner
!
write(iout_,*) ' '
if (nlev > 1) then
write(iout_,*) 'Multilevel Schwarz'
write(iout_,*)
write(iout_,*) 'Base preconditioner (smoother) details'
endif
ilev = 1
call mld_base_prec_descr(iout_,p%precv(ilev)%prec%iprcparm,info,&
& dprcparm=p%precv(ilev)%prec%rprcparm)
call p%precv(1)%sm%descr(info,iout=iout_)
!!$
!!$ if (nlev > 1) then
!!$ write(iout_,*) 'Multilevel Schwarz'
!!$ write(iout_,*)
!!$ write(iout_,*) 'Base preconditioner (smoother) details'
!!$ endif
!!$
!!$ ilev = 1
!!$ call mld_base_prec_descr(iout_,p%precv(ilev)%prec%iprcparm,info,&
!!$ & dprcparm=p%precv(ilev)%prec%rprcparm)
!!$
end if
if (nlev > 1) then
!
! Print multilevel details
!
write(iout_,*)
write(iout_,*) 'Multilevel details'
do ilev = 2, nlev
if (.not.allocated(p%precv(ilev)%iprcparm)) then
info = 3111
write(iout_,*) ' ',name,&
& ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
return
endif
end do
write(iout_,*) ' Number of levels: ',nlev
!
! Currently, all the preconditioner parameters must have
! the same value at levels
! 2,...,nlev-1, hence only the values at level 2 are printed
!
ilev=2
call mld_ml_alg_descr(iout_,ilev,p%precv(ilev)%iprcparm, info,&
& dprcparm=p%precv(ilev)%rprcparm)
!
! Coarse matrices are different at levels 2,...,nlev-1, hence related
! info is printed separately
!
write(iout_,*)
do ilev = 2, nlev-1
call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
& p%precv(ilev)%map%naggr,info,&
& dprcparm=p%precv(ilev)%rprcparm)
end do
!
! Print coarsest level details
!
ilev = nlev
write(iout_,*)
call mld_ml_coarse_descr(iout_,ilev,&
& p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
& p%precv(ilev)%map%naggr,info,&
& dprcparm=p%precv(ilev)%rprcparm,&
& dprcparm2=p%precv(ilev)%prec%rprcparm)
!!$
!!$ !
!!$ ! Print multilevel details
!!$ !
!!$ write(iout_,*)
!!$ write(iout_,*) 'Multilevel details'
!!$
!!$ do ilev = 2, nlev
!!$ if (.not.allocated(p%precv(ilev)%iprcparm)) then
!!$ info = 3111
!!$ write(iout_,*) ' ',name,&
!!$ & ': error: inconsistent MLPREC part, should call MLD_PRECINIT'
!!$ return
!!$ endif
!!$ end do
!!$
!!$ write(iout_,*) ' Number of levels: ',nlev
!!$
!!$ !
!!$ ! Currently, all the preconditioner parameters must have
!!$ ! the same value at levels
!!$ ! 2,...,nlev-1, hence only the values at level 2 are printed
!!$ !
!!$
!!$ ilev=2
!!$ call mld_ml_alg_descr(iout_,ilev,p%precv(ilev)%iprcparm, info,&
!!$ & dprcparm=p%precv(ilev)%rprcparm)
!!$
!!$ !
!!$ ! Coarse matrices are different at levels 2,...,nlev-1, hence related
!!$ ! info is printed separately
!!$ !
!!$ write(iout_,*)
!!$ do ilev = 2, nlev-1
!!$ call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
!!$ & p%precv(ilev)%map%naggr,info,&
!!$ & dprcparm=p%precv(ilev)%rprcparm)
!!$ end do
!!$
!!$ !
!!$ ! Print coarsest level details
!!$ !
!!$
!!$ ilev = nlev
!!$ write(iout_,*)
!!$ call mld_ml_coarse_descr(iout_,ilev,&
!!$ & p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
!!$ & p%precv(ilev)%map%naggr,info,&
!!$ & dprcparm=p%precv(ilev)%rprcparm,&
!!$ & dprcparm2=p%precv(ilev)%prec%rprcparm)
end if
endif
@ -531,7 +535,7 @@ contains
if (allocated(p%av)) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
@ -588,7 +592,7 @@ contains
! for the inner UMFPACK or SLU stuff
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
call p%ac%free()
if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info)
@ -811,7 +815,7 @@ contains
return
end subroutine d_base_smoother_setr
subroutine d_base_smoother_bld(a,desc_a,sm,upd,info,b)
subroutine d_base_smoother_bld(a,desc_a,sm,upd,info)
use psb_base_mod
@ -823,7 +827,6 @@ contains
class(mld_d_base_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
type(psb_d_sparse_mat), intent(in), target, optional :: b
Integer :: err_act
character(len=20) :: name='d_base_smoother_bld'
@ -831,7 +834,7 @@ contains
info = 0
if (allocated(sm%sv)) then
call sm%sv%build(a,desc_a,upd,info,b)
call sm%sv%build(a,desc_a,upd,info)
else
info = 1121
call psb_errpush(info,name)
@ -894,9 +897,9 @@ contains
Implicit None
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
class(mld_d_base_smoother_type), intent(in) :: sm
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
@ -938,8 +941,8 @@ contains
function d_base_smoother_sizeof(sm) result(val)
implicit none
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
integer(psb_long_int_k_) :: val
class(mld_d_base_smoother_type), intent(in) :: sm
integer(psb_long_int_k_) :: val
integer :: i
val = 0
@ -1153,9 +1156,9 @@ contains
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
class(mld_d_base_solver_type), intent(in) :: sv
integer, intent(out) :: info
integer, intent(in), optional :: iout
! Local variables
integer :: err_act
@ -1185,8 +1188,8 @@ contains
function d_base_solver_sizeof(sv) result(val)
implicit none
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
integer(psb_long_int_k_) :: val
class(mld_d_base_solver_type), intent(in) :: sv
integer(psb_long_int_k_) :: val
integer :: i
val = 0

3
mlprec/mld_dprecaply.f90
Unescape Escape View File

@ -140,7 +140,8 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
!
! Number of levels = 1: apply the base preconditioner
!
call mld_baseprec_aply(done,prec%precv(1)%prec,x,dzero,y,desc_data,trans_, work_,info)
!!$ call mld_baseprec_aply(done,prec%precv(1)%prec,x,dzero,y,desc_data,trans_, work_,info)
call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_, work_,info)
else
info = 4013
call psb_errpush(info,name,a_err='Invalid size of precv',&

65
mlprec/mld_dprecbld.f90
Unescape Escape View File

@ -63,7 +63,11 @@ subroutine mld_dprecbld(a,desc_a,p,info)
use psb_base_mod
use mld_inner_mod
use mld_prec_mod, mld_protect_name => mld_dprecbld
use mld_d_jac_smoother
use mld_d_as_smoother
use mld_d_diag_solver
use mld_d_ilu_solver
Implicit None
! Arguments
@ -94,6 +98,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
int_err(1) = 0
ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
p%ictxt = ictxt
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
@ -181,15 +186,69 @@ subroutine mld_dprecbld(a,desc_a,p,info)
end select
call mld_check_def(p%precv(1)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
!!$
!!$ call mld_baseprec_bld(p%precv(1)%base_a,p%precv(1)%base_desc,&
!!$ & p%precv(1)%prec,info)
!
! Test version for beginning of OO stuff.
!
if (allocated(p%precv(1)%sm)) then
call p%precv(1)%sm%free(info)
if (info ==0) deallocate(p%precv(1)%sm,stat=info)
if (info /= 0) then
call psb_errpush(4000,name,a_err='One level preconditioner build.')
goto 9999
endif
end if
select case (p%precv(1)%prec%iprcparm(mld_smoother_type_))
case(mld_diag_, mld_bjac_, mld_pjac_)
allocate(mld_d_jac_smoother_type :: p%precv(1)%sm, stat=info)
case(mld_as_)
allocate(mld_d_as_smoother_type :: p%precv(1)%sm, stat=info)
case default
info = -1
end select
if (info /= 0) then
write(0,*) ' Smoother allocation error',info,&
& p%precv(1)%prec%iprcparm(mld_smoother_type_)
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
call p%precv(1)%sm%set(mld_sub_restr_,p%precv(1)%prec%iprcparm(mld_sub_restr_),info)
call p%precv(1)%sm%set(mld_sub_prol_,p%precv(1)%prec%iprcparm(mld_sub_prol_),info)
call p%precv(1)%sm%set(mld_sub_ovr_,p%precv(1)%prec%iprcparm(mld_sub_ovr_),info)
call p%precv(1)%sm%set(mld_smoother_sweeps_,&
& p%precv(1)%prec%iprcparm(mld_smoother_sweeps_),info)
call mld_baseprec_bld(p%precv(1)%base_a,p%precv(1)%base_desc,&
& p%precv(1)%prec,info)
select case (p%precv(1)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
allocate(mld_d_ilu_solver_type :: p%precv(1)%sm%sv, stat=info)
if (info == 0) call p%precv(1)%sm%sv%set(mld_sub_solve_,&
& p%precv(1)%prec%iprcparm(mld_sub_solve_),info)
if (info == 0) call p%precv(1)%sm%sv%set(mld_sub_fillin_,&
& p%precv(1)%prec%iprcparm(mld_sub_fillin_),info)
if (info == 0) call p%precv(1)%sm%sv%set(mld_sub_iluthrs_,&
& p%precv(1)%prec%rprcparm(mld_sub_iluthrs_),info)
case(mld_diag_scale_)
allocate(mld_d_diag_solver_type :: p%precv(1)%sm%sv, stat=info)
case default
info = -1
end select
if (info /= 0) then
write(0,*) ' Solver allocation error',info,&
& p%precv(1)%prec%iprcparm(mld_sub_solve_)
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
call p%precv(1)%sm%build(a,desc_a,upd_,info)
if (info /= 0) then
write(0,*) ' Smoother build error',info
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
!
! Number of levels > 1
!

3
mlprec/mld_dprecinit.F90
Unescape Escape View File

@ -90,6 +90,9 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
use psb_base_mod
use mld_prec_mod, mld_protect_name => mld_dprecinit
!!$ use mld_d_smoother
!!$ use mld_d_solver
implicit none

8
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -497,7 +497,7 @@ contains
if (allocated(p%av)) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
@ -548,7 +548,7 @@ contains
! for the inner UMFPACK or SLU stuff
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
call p%ac%free()
if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info)
@ -647,7 +647,7 @@ contains
select type(prec)
type is (mld_sprec_type)
call mld_precaply(prec,x,y,desc_data,info,trans,work)
!!$ call mld_precaply(prec,x,y,desc_data,info,trans,work)
class default
info = 700
call psb_errpush(info,name)
@ -680,7 +680,7 @@ contains
select type(prec)
type is (mld_sprec_type)
call mld_precaply(prec,x,desc_data,info,trans)
!!$ call mld_precaply(prec,x,desc_data,info,trans)
class default
info = 700
call psb_errpush(info,name)

4
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -479,7 +479,7 @@ contains
if (allocated(p%av)) then
do i=1,size(p%av)
call psb_sp_free(p%av(i),info)
call p%av(i)%free()
if (info /= 0) then
! Actually, we don't care here about this.
! Just let it go.
@ -532,7 +532,7 @@ contains
! for the inner UMFPACK or SLU stuff
call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info)
call p%ac%free()
if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info)

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

@ -6,8 +6,8 @@ CSR ! Storage format CSR COO JAD
01 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-7 ! EPS
3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars)
ML ! Preconditioner NONE DIAG BJAC AS ML
RAS ! Longer descriptive name for preconditioner (up to 20 chars)
AS ! Preconditioner NONE DIAG BJAC AS ML
1 ! Number of overlap layers for AS preconditioner at finest level
HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG

Write Preview
Loading…
Cancel
Save