fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4-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.
This commit is contained in:
Salvatore Filippone
2009-12-10 12:20:21 +00:00
parent bbd82a5b45
commit 88e27fb869
12 changed files with 291 additions and 138 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_c_prec_type.f90
+2 -2
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)
mlprec/mld_d_as_smoother.f03
+111 -23
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
mlprec/mld_d_diag_solver.f03
+4 -4
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
mlprec/mld_d_ilu_solver.f03
+6 -6
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
mlprec/mld_d_jac_smoother.f03
+10 -11
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
mlprec/mld_d_prec_type.f03
+83 -80
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
mlprec/mld_dprecaply.f90
+2 -1
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',&
mlprec/mld_dprecbld.f90
+62 -3
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
!
mlprec/mld_dprecinit.F90
+3
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
mlprec/mld_s_prec_type.f90
+4 -4
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)
mlprec/mld_z_prec_type.f90
+2 -2
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)
tests/pdegen/runs/ppde.inp
+2 -2
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