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

122
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_setc, d_as_smoother_setr,&
& d_as_smoother_descr, d_as_smoother_sizeof & 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 contains
@ -487,7 +491,7 @@ contains
end subroutine d_as_smoother_apply 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 use psb_base_mod
@ -499,9 +503,9 @@ contains
class(mld_d_as_smoother_type), intent(inout) :: sm class(mld_d_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer, intent(out) :: info
type(psb_d_sparse_mat), intent(in), target, optional :: b
! Local variables ! 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(:) real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_as_smoother_bld', ch_err character(len=20) :: name='d_as_smoother_bld', ch_err
@ -516,16 +520,92 @@ contains
& write(debug_unit,*) me,' ',trim(name),' start' & 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() nrow_a = a%get_nrows()
nztota = a%get_nzeros() n_row = psb_cd_get_local_rows(sm%desc_data)
call a%csclip(sm%nd,info,& 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.) & 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,& if (info == 0) call sm%nd%cscnv(info,&
& type='csr',dupl=psb_dupl_add_) & type='csr',dupl=psb_dupl_add_)
if (info == 0) &
& call sm%sv%build(a,desc_a,upd,info,b)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='clip & psb_spcnv csr 4') call psb_errpush(4010,name,a_err='clip & psb_spcnv csr 4')
@ -568,12 +648,18 @@ contains
select case(what) select case(what)
case(mld_smoother_sweeps_) case(mld_smoother_sweeps_)
sm%sweeps = val 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 case default
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%set(what,val,info) call sm%sv%set(what,val,info)
else !!$ else
write(0,*) trim(name),' Missing component, not setting!' !!$ write(0,*) trim(name),' Missing component, not setting!'
info = 1121 !!$ info = 1121
end if end if
end select end select
@ -648,8 +734,8 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%set(what,val,info) call sm%sv%set(what,val,info)
else else
write(0,*) trim(name),' Missing component, not setting!' !!$ write(0,*) trim(name),' Missing component, not setting!'
info = 1121 !!$ info = 1121
end if end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -711,7 +797,7 @@ contains
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
@ -729,8 +815,10 @@ contains
iout_ = 6 iout_ = 6
endif endif
write(iout_,*) ' Block Jacobi smoother with ',& write(iout_,*) ' Additive Schwarz with ',&
& sm%sweeps,' sweeps.' & 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:' write(iout_,*) ' Local solver:'
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%descr(info,iout_) call sm%sv%descr(info,iout_)
@ -752,7 +840,7 @@ contains
use psb_base_mod use psb_base_mod
implicit none implicit none
! Arguments ! 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(psb_long_int_k_) :: val
integer :: i integer :: i

4
mlprec/mld_d_diag_solver.f03
Unescape Escape View File

@ -426,7 +426,7 @@ contains
Implicit None Implicit None
! Arguments ! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv class(mld_d_diag_solver_type), intent(in) :: sv
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: iout integer, intent(in), optional :: iout
@ -453,7 +453,7 @@ contains
use psb_base_mod use psb_base_mod
implicit none implicit none
! Arguments ! 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(psb_long_int_k_) :: val
integer :: i integer :: i

8
mlprec/mld_d_ilu_solver.f03
Unescape Escape View File

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

17
mlprec/mld_d_jac_smoother.f03
Unescape Escape View File

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

151
mlprec/mld_d_prec_type.f03
Unescape Escape View File

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

63
mlprec/mld_dprecbld.f90
Unescape Escape View File

@ -63,6 +63,10 @@ subroutine mld_dprecbld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use mld_inner_mod use mld_inner_mod
use mld_prec_mod, mld_protect_name => mld_dprecbld 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 Implicit None
@ -94,6 +98,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
int_err(1) = 0 int_err(1) = 0
ictxt = psb_cd_get_context(desc_a) ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
p%ictxt = ictxt
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
@ -181,11 +186,65 @@ subroutine mld_dprecbld(a,desc_a,p,info)
end select end select
call mld_check_def(p%precv(1)%prec%iprcparm(mld_smoother_sweeps_),& call mld_check_def(p%precv(1)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_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)
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
call mld_baseprec_bld(p%precv(1)%base_a,p%precv(1)%base_desc,& if (info /= 0) then
& p%precv(1)%prec,info) 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 if (info /= 0) then
write(0,*) ' Smoother build error',info
call psb_errpush(4001,name,a_err='One level preconditioner build.') call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999 goto 9999
endif endif

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 psb_base_mod
use mld_prec_mod, mld_protect_name => mld_dprecinit use mld_prec_mod, mld_protect_name => mld_dprecinit
!!$ use mld_d_smoother
!!$ use mld_d_solver
implicit none implicit none

8
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -497,7 +497,7 @@ contains
if (allocated(p%av)) then if (allocated(p%av)) then
do i=1,size(p%av) do i=1,size(p%av)
call psb_sp_free(p%av(i),info) call p%av(i)%free()
if (info /= 0) then if (info /= 0) then
! Actually, we don't care here about this. ! Actually, we don't care here about this.
! Just let it go. ! Just let it go.
@ -548,7 +548,7 @@ contains
! for the inner UMFPACK or SLU stuff ! for the inner UMFPACK or SLU stuff
call mld_precfree(p%prec,info) call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info) call p%ac%free()
if (allocated(p%desc_ac%matrix_data)) & if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info) & call psb_cdfree(p%desc_ac,info)
@ -647,7 +647,7 @@ contains
select type(prec) select type(prec)
type is (mld_sprec_type) 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 class default
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name)
@ -680,7 +680,7 @@ contains
select type(prec) select type(prec)
type is (mld_sprec_type) 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 class default
info = 700 info = 700
call psb_errpush(info,name) 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 if (allocated(p%av)) then
do i=1,size(p%av) do i=1,size(p%av)
call psb_sp_free(p%av(i),info) call p%av(i)%free()
if (info /= 0) then if (info /= 0) then
! Actually, we don't care here about this. ! Actually, we don't care here about this.
! Just let it go. ! Just let it go.
@ -532,7 +532,7 @@ contains
! for the inner UMFPACK or SLU stuff ! for the inner UMFPACK or SLU stuff
call mld_precfree(p%prec,info) call mld_precfree(p%prec,info)
call psb_sp_free(p%ac,info) call p%ac%free()
if (allocated(p%desc_ac%matrix_data)) & if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info) & 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 01 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL) 30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-7 ! EPS 1.d-7 ! EPS
3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars) RAS ! Longer descriptive name for preconditioner (up to 20 chars)
ML ! Preconditioner NONE DIAG BJAC AS ML AS ! Preconditioner NONE DIAG BJAC AS ML
1 ! Number of overlap layers for AS preconditioner at finest level 1 ! Number of overlap layers for AS preconditioner at finest level
HALO ! Restriction operator NONE HALO HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG NONE ! Prolongation operator NONE SUM AVG

Write Preview
Loading…
Cancel
Save