Completed integration of ILU-type factorization

implement-ainv
Cirdans-Home 4 years ago
parent fbf23c3959
commit 62c75abbf4

@ -568,7 +568,6 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999
endif
! This is where we have no renumbering, thus no need
! call psb_ilu_fct(a,lf,uf,dd,info)
call psb_ilu0_fact(ialg,a,lf,uf,dd,info)
if(info == psb_success_) then
@ -782,45 +781,19 @@ subroutine psb_c_bjac_precseti(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& ((prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_t_))) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case (psb_ilu_ialg_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_ialg_) = val
case (psb_ilu_scale_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_scale_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select
@ -855,26 +828,13 @@ subroutine psb_c_bjac_precsetr(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_fact_eps_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%rprcparm(psb_fact_eps_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select

@ -332,3 +332,126 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans)
end subroutine psb_c_apply1v
subroutine psb_ccprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_c_prec_type, psb_protect_name => psb_ccprecseti
implicit none
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='psb_precseti'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ("SUB_FILLIN")
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_ccprecseti
subroutine psb_ccprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_c_prec_type, psb_protect_name => psb_ccprecsetr
implicit none
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetr'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_ccprecsetr
subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_c_prec_type, psb_protect_name => psb_ccprecsetc
implicit none
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetc'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
case("ILUT")
call prec%prec%precset(psb_f_type_,psb_f_ilu_t_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_t_,info)
case default
! Default to ILU(0) factorization
call prec%prec%precset(psb_f_type_,psb_f_ilu_n_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case default
end select
end subroutine psb_ccprecsetc

@ -568,7 +568,6 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999
endif
! This is where we have no renumbering, thus no need
! call psb_ilu_fct(a,lf,uf,dd,info)
call psb_ilu0_fact(ialg,a,lf,uf,dd,info)
if(info == psb_success_) then
@ -782,45 +781,19 @@ subroutine psb_d_bjac_precseti(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& ((prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_t_))) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case (psb_ilu_ialg_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_ialg_) = val
case (psb_ilu_scale_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_scale_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select
@ -855,26 +828,13 @@ subroutine psb_d_bjac_precsetr(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_fact_eps_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%rprcparm(psb_fact_eps_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select

@ -332,3 +332,126 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans)
end subroutine psb_d_apply1v
subroutine psb_dcprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_d_prec_type, psb_protect_name => psb_dcprecseti
implicit none
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='psb_precseti'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ("SUB_FILLIN")
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_dcprecseti
subroutine psb_dcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_d_prec_type, psb_protect_name => psb_dcprecsetr
implicit none
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetr'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_dcprecsetr
subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_d_prec_type, psb_protect_name => psb_dcprecsetc
implicit none
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetc'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
case("ILUT")
call prec%prec%precset(psb_f_type_,psb_f_ilu_t_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_t_,info)
case default
! Default to ILU(0) factorization
call prec%prec%precset(psb_f_type_,psb_f_ilu_n_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case default
end select
end subroutine psb_dcprecsetc

@ -568,7 +568,6 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999
endif
! This is where we have no renumbering, thus no need
! call psb_ilu_fct(a,lf,uf,dd,info)
call psb_ilu0_fact(ialg,a,lf,uf,dd,info)
if(info == psb_success_) then
@ -782,45 +781,19 @@ subroutine psb_s_bjac_precseti(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& ((prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_t_))) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case (psb_ilu_ialg_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_ialg_) = val
case (psb_ilu_scale_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_scale_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select
@ -855,26 +828,13 @@ subroutine psb_s_bjac_precsetr(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_fact_eps_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%rprcparm(psb_fact_eps_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select

@ -332,3 +332,126 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans)
end subroutine psb_s_apply1v
subroutine psb_scprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_s_prec_type, psb_protect_name => psb_scprecseti
implicit none
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='psb_precseti'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ("SUB_FILLIN")
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_scprecseti
subroutine psb_scprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_s_prec_type, psb_protect_name => psb_scprecsetr
implicit none
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetr'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_scprecsetr
subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_s_prec_type, psb_protect_name => psb_scprecsetc
implicit none
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetc'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
case("ILUT")
call prec%prec%precset(psb_f_type_,psb_f_ilu_t_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_t_,info)
case default
! Default to ILU(0) factorization
call prec%prec%precset(psb_f_type_,psb_f_ilu_n_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case default
end select
end subroutine psb_scprecsetc

@ -568,7 +568,6 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999
endif
! This is where we have no renumbering, thus no need
! call psb_ilu_fct(a,lf,uf,dd,info)
call psb_ilu0_fact(ialg,a,lf,uf,dd,info)
if(info == psb_success_) then
@ -782,45 +781,19 @@ subroutine psb_z_bjac_precseti(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_ilu_fill_in_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& ((prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_t_))) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_fill_in_) = val
case (psb_ilu_ialg_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_ialg_) = val
case (psb_ilu_scale_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_ilu_scale_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select
@ -855,26 +828,13 @@ subroutine psb_z_bjac_precsetr(prec,what,val,info)
select case(what)
case (psb_f_type_)
if (prec%iprcparm(psb_p_type_) /= psb_bjac_) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%iprcparm(psb_f_type_) = val
case (psb_fact_eps_)
if ((prec%iprcparm(psb_p_type_) /= psb_bjac_).or.&
& (prec%iprcparm(psb_f_type_) /= psb_f_ilu_n_)) then
write(psb_err_unit,*) 'WHAT is invalid for current preconditioner ',&
& prec%iprcparm(psb_p_type_),&
& 'ignoring user specification'
return
endif
prec%rprcparm(psb_fact_eps_) = val
case default
write(psb_err_unit,*) 'WHAT is invalid, ignoring user specification'
write(psb_err_unit,'(i0," is invalid, ignoring user specification")') what
end select

@ -332,3 +332,126 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans)
end subroutine psb_z_apply1v
subroutine psb_zcprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_z_prec_type, psb_protect_name => psb_zcprecseti
implicit none
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='psb_precseti'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ("SUB_FILLIN")
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_zcprecseti
subroutine psb_zcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_z_prec_type, psb_protect_name => psb_zcprecsetr
implicit none
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetr'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case default
info = psb_err_invalid_args_combination_
write(psb_err_unit,*) name,&
& ': Error: uninitialized preconditioner,',&
&' should call prec%init'
return
end select
end subroutine psb_zcprecsetr
subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
use psb_base_mod
use psb_z_prec_type, psb_protect_name => psb_zcprecsetc
implicit none
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
! This optional inputs are backport from the inputs available in AMG4PSBLAS,
! they are of no actual use here a part from compatibility reasons.
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
! Local variables
character(len=*), parameter :: name='amg_precsetc'
info = psb_success_
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
case("ILUT")
call prec%prec%precset(psb_f_type_,psb_f_ilu_t_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_t_,info)
case default
! Default to ILU(0) factorization
call prec%prec%precset(psb_f_type_,psb_f_ilu_n_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case default
end select
end subroutine psb_zcprecsetc

@ -57,13 +57,11 @@ module psb_c_bjacprec
procedure, pass(prec) :: is_allocated_wrk => psb_c_bjac_is_allocated_wrk
end type psb_c_bjac_prec_type
private :: psb_c_bjac_sizeof, psb_c_bjac_precdescr, psb_c_bjac_get_nzeros
character(len=15), parameter, private :: &
& fact_names(0:2)=(/'None ','ILU(n) ',&
& 'ILU(eps) '/)
& fact_names(0:3)=(/'None ','ILU(0) ',&
& 'ILU(n) ','ILU(eps) '/)
private :: psb_c_bjac_sizeof, psb_c_bjac_precdescr, psb_c_bjac_get_nzeros
interface
subroutine psb_c_bjac_dump(prec,info,prefix,head)

@ -54,6 +54,10 @@ module psb_c_prec_type
procedure, pass(prec) :: build => psb_cprecbld
procedure, pass(prec) :: init => psb_cprecinit
procedure, pass(prec) :: descr => psb_cfile_prec_descr
procedure, pass(prec) :: cseti => psb_ccprecseti
procedure, pass(prec) :: csetc => psb_ccprecsetc
procedure, pass(prec) :: csetr => psb_ccprecsetr
generic, public :: set => cseti, csetc, csetr
procedure, pass(prec) :: allocate_wrk => psb_c_allocate_wrk
procedure, pass(prec) :: free_wrk => psb_c_free_wrk
procedure, pass(prec) :: is_allocated_wrk => psb_c_is_allocated_wrk
@ -151,6 +155,39 @@ module psb_c_prec_type
end subroutine psb_c_apply1v
end interface
interface
subroutine psb_ccprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_cprec_type, psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_ipk_
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_ccprecseti
subroutine psb_ccprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_cprec_type, psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_ipk_
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_ccprecsetr
subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
import :: psb_cprec_type, psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_ipk_
class(psb_cprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_ccprecsetc
end interface
contains
subroutine psb_cfile_prec_descr(prec,iout, root)

@ -57,13 +57,11 @@ module psb_d_bjacprec
procedure, pass(prec) :: is_allocated_wrk => psb_d_bjac_is_allocated_wrk
end type psb_d_bjac_prec_type
private :: psb_d_bjac_sizeof, psb_d_bjac_precdescr, psb_d_bjac_get_nzeros
character(len=15), parameter, private :: &
& fact_names(0:2)=(/'None ','ILU(n) ',&
& 'ILU(eps) '/)
& fact_names(0:3)=(/'None ','ILU(0) ',&
& 'ILU(n) ','ILU(eps) '/)
private :: psb_d_bjac_sizeof, psb_d_bjac_precdescr, psb_d_bjac_get_nzeros
interface
subroutine psb_d_bjac_dump(prec,info,prefix,head)

@ -54,6 +54,10 @@ module psb_d_prec_type
procedure, pass(prec) :: build => psb_dprecbld
procedure, pass(prec) :: init => psb_dprecinit
procedure, pass(prec) :: descr => psb_dfile_prec_descr
procedure, pass(prec) :: cseti => psb_dcprecseti
procedure, pass(prec) :: csetc => psb_dcprecsetc
procedure, pass(prec) :: csetr => psb_dcprecsetr
generic, public :: set => cseti, csetc, csetr
procedure, pass(prec) :: allocate_wrk => psb_d_allocate_wrk
procedure, pass(prec) :: free_wrk => psb_d_free_wrk
procedure, pass(prec) :: is_allocated_wrk => psb_d_is_allocated_wrk
@ -151,6 +155,39 @@ module psb_d_prec_type
end subroutine psb_d_apply1v
end interface
interface
subroutine psb_dcprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_dprec_type, psb_dspmat_type, psb_desc_type, psb_dpk_, &
& psb_ipk_
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_dcprecseti
subroutine psb_dcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_dprec_type, psb_dspmat_type, psb_desc_type, psb_dpk_, &
& psb_ipk_
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_dcprecsetr
subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
import :: psb_dprec_type, psb_dspmat_type, psb_desc_type, psb_dpk_, &
& psb_ipk_
class(psb_dprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_dcprecsetc
end interface
contains
subroutine psb_dfile_prec_descr(prec,iout, root)

@ -57,13 +57,11 @@ module psb_s_bjacprec
procedure, pass(prec) :: is_allocated_wrk => psb_s_bjac_is_allocated_wrk
end type psb_s_bjac_prec_type
private :: psb_s_bjac_sizeof, psb_s_bjac_precdescr, psb_s_bjac_get_nzeros
character(len=15), parameter, private :: &
& fact_names(0:2)=(/'None ','ILU(n) ',&
& 'ILU(eps) '/)
& fact_names(0:3)=(/'None ','ILU(0) ',&
& 'ILU(n) ','ILU(eps) '/)
private :: psb_s_bjac_sizeof, psb_s_bjac_precdescr, psb_s_bjac_get_nzeros
interface
subroutine psb_s_bjac_dump(prec,info,prefix,head)

@ -54,6 +54,10 @@ module psb_s_prec_type
procedure, pass(prec) :: build => psb_sprecbld
procedure, pass(prec) :: init => psb_sprecinit
procedure, pass(prec) :: descr => psb_sfile_prec_descr
procedure, pass(prec) :: cseti => psb_scprecseti
procedure, pass(prec) :: csetc => psb_scprecsetc
procedure, pass(prec) :: csetr => psb_scprecsetr
generic, public :: set => cseti, csetc, csetr
procedure, pass(prec) :: allocate_wrk => psb_s_allocate_wrk
procedure, pass(prec) :: free_wrk => psb_s_free_wrk
procedure, pass(prec) :: is_allocated_wrk => psb_s_is_allocated_wrk
@ -151,6 +155,39 @@ module psb_s_prec_type
end subroutine psb_s_apply1v
end interface
interface
subroutine psb_scprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_sprec_type, psb_sspmat_type, psb_desc_type, psb_spk_, &
& psb_ipk_
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_scprecseti
subroutine psb_scprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_sprec_type, psb_sspmat_type, psb_desc_type, psb_spk_, &
& psb_ipk_
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_scprecsetr
subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
import :: psb_sprec_type, psb_sspmat_type, psb_desc_type, psb_spk_, &
& psb_ipk_
class(psb_sprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_scprecsetc
end interface
contains
subroutine psb_sfile_prec_descr(prec,iout, root)

@ -57,13 +57,11 @@ module psb_z_bjacprec
procedure, pass(prec) :: is_allocated_wrk => psb_z_bjac_is_allocated_wrk
end type psb_z_bjac_prec_type
private :: psb_z_bjac_sizeof, psb_z_bjac_precdescr, psb_z_bjac_get_nzeros
character(len=15), parameter, private :: &
& fact_names(0:2)=(/'None ','ILU(n) ',&
& 'ILU(eps) '/)
& fact_names(0:3)=(/'None ','ILU(0) ',&
& 'ILU(n) ','ILU(eps) '/)
private :: psb_z_bjac_sizeof, psb_z_bjac_precdescr, psb_z_bjac_get_nzeros
interface
subroutine psb_z_bjac_dump(prec,info,prefix,head)

@ -54,6 +54,10 @@ module psb_z_prec_type
procedure, pass(prec) :: build => psb_zprecbld
procedure, pass(prec) :: init => psb_zprecinit
procedure, pass(prec) :: descr => psb_zfile_prec_descr
procedure, pass(prec) :: cseti => psb_zcprecseti
procedure, pass(prec) :: csetc => psb_zcprecsetc
procedure, pass(prec) :: csetr => psb_zcprecsetr
generic, public :: set => cseti, csetc, csetr
procedure, pass(prec) :: allocate_wrk => psb_z_allocate_wrk
procedure, pass(prec) :: free_wrk => psb_z_free_wrk
procedure, pass(prec) :: is_allocated_wrk => psb_z_is_allocated_wrk
@ -151,6 +155,39 @@ module psb_z_prec_type
end subroutine psb_z_apply1v
end interface
interface
subroutine psb_zcprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_zprec_type, psb_zspmat_type, psb_desc_type, psb_dpk_, &
& psb_ipk_
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_zcprecseti
subroutine psb_zcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
import :: psb_zprec_type, psb_zspmat_type, psb_desc_type, psb_dpk_, &
& psb_ipk_
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_zcprecsetr
subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
import :: psb_zprec_type, psb_zspmat_type, psb_desc_type, psb_dpk_, &
& psb_ipk_
class(psb_zprec_type), intent(inout) :: prec
character(len=*), intent(in) :: what
character(len=*), intent(in) :: string
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx
character(len=*), optional, intent(in) :: pos
end subroutine psb_zcprecsetc
end interface
contains
subroutine psb_zfile_prec_descr(prec,iout, root)

@ -563,6 +563,14 @@ program psb_d_pde2d
integer(psb_epk_) :: amatsize, precsize, descsize, d2size
real(psb_dpk_) :: err, eps
! Parameters for solvers in Block-Jacobi preconditioner
type ainvparms
character(len=12) :: alg, orth_alg, ilu_alg, ilut_scale
integer(psb_ipk_) :: fill, inv_fill
real(psb_dpk_) :: thresh, inv_thresh
end type ainvparms
type(ainvparms) :: parms
! other variables
integer(psb_ipk_) :: info, i
character(len=20) :: name,ch_err
@ -592,7 +600,7 @@ program psb_d_pde2d
!
! get parameters
!
call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart)
call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart,parms)
!
! allocate and fill in the coefficient matrix, rhs and initial guess
@ -615,6 +623,25 @@ program psb_d_pde2d
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ictxt,ptype,info)
!
! Set the options for the BJAC preconditioner
!
if (psb_toupper(ptype) == "BJAC") then
call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg))
case ("ILU")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -704,13 +731,14 @@ contains
!
! get iteration parameters from standard input
!
subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart)
subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart,parms)
integer(psb_ipk_) :: ictxt
character(len=*) :: kmethd, ptype, afmt
integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: ip, inp_unit
character(len=1024) :: filename
type(ainvparms) :: parms
call psb_info(ictxt, iam, np)
@ -761,6 +789,25 @@ contains
else
irst=1
endif
if (ip >= 9) then
read(inp_unit,*) parms%alg
read(inp_unit,*) parms%ilu_alg
read(inp_unit,*) parms%ilut_scale
read(inp_unit,*) parms%fill
read(inp_unit,*) parms%inv_fill
read(inp_unit,*) parms%thresh
read(inp_unit,*) parms%inv_thresh
read(inp_unit,*) parms%orth_alg
else
parms%alg = 'ILU' ! Block Solver ILU,ILUT,INVK,AINVT,AORTH
parms%ilu_alg = 'NONE' ! If ILU : MILU or NONE othewise ignored
parms%ilut_scale = 'NONE' ! If ILUT: NONE, MAXVAL, DIAG, ARWSUM, ACLSUM, ARCSUM
parms%fill = 0 ! Level of fill for forward factorization
parms%inv_fill = 1 ! Level of fill for inverse factorization (only INVK)
parms%thresh = 1E-1_psb_dpk_ ! Threshold for forward factorization
parms%inv_thresh = 1E-1_psb_dpk_ ! Threshold for inverse factorization
parms%orth_alg = 'LLK' ! What orthogonalization algorithm?
endif
write(psb_out_unit,'("Solving matrix : ell1")')
write(psb_out_unit,'("Grid dimensions : ",i5," x ",i5)')idim,idim
@ -775,6 +822,27 @@ contains
write(psb_out_unit,'("Unknown data distrbution, defaulting to 2D")')
end select
write(psb_out_unit,'("Preconditioner : ",a)') ptype
if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg))
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINVT','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
end if
write(psb_out_unit,'("Iterative method : ",a)') kmethd
write(psb_out_unit,'(" ")')
else
@ -825,5 +893,3 @@ contains
end subroutine pr_usage
end program psb_d_pde2d

@ -606,7 +606,7 @@ program psb_d_pde3d
! Parameters for solvers in Block-Jacobi preconditioner
type ainvparms
character(len=12) :: alg, orth_alg
character(len=12) :: alg, orth_alg, ilu_alg, ilut_scale
integer(psb_ipk_) :: fill, inv_fill
real(psb_dpk_) :: thresh, inv_thresh
end type ainvparms
@ -664,6 +664,25 @@ program psb_d_pde3d
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ictxt,ptype,info)
!
! Set the options for the BJAC preconditioner
!
if (psb_toupper(ptype) == "BJAC") then
call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg))
case ("ILU")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -813,16 +832,20 @@ contains
irst=1
endif
if (ip >= 9) then
read(psb_inp_unit,*) parms%alg
read(psb_inp_unit,*) parms%fill
read(psb_inp_unit,*) parms%inv_fill
read(psb_inp_unit,*) parms%thresh
read(psb_inp_unit,*) parms%inv_thresh
read(psb_inp_unit,*) parms%orth_alg
read(inp_unit,*) parms%alg
read(inp_unit,*) parms%ilu_alg
read(inp_unit,*) parms%ilut_scale
read(inp_unit,*) parms%fill
read(inp_unit,*) parms%inv_fill
read(inp_unit,*) parms%thresh
read(inp_unit,*) parms%inv_thresh
read(inp_unit,*) parms%orth_alg
else
parms%alg = 'ILU' ! AINV variant: ILU,ILUT,MILU,INVK,AINVT,AORTH
parms%fill = 0 ! Fill in for forward factorization
parms%inv_fill = 1 ! Fill in for inverse factorization
parms%alg = 'ILU' ! Block Solver ILU,ILUT,INVK,AINVT,AORTH
parms%ilu_alg = 'NONE' ! If ILU : MILU or NONE othewise ignored
parms%ilut_scale = 'NONE' ! If ILUT: NONE, MAXVAL, DIAG, ARWSUM, ACLSUM, ARCSUM
parms%fill = 0 ! Level of fill for forward factorization
parms%inv_fill = 1 ! Level of fill for inverse factorization (only INVK)
parms%thresh = 1E-1_psb_dpk_ ! Threshold for forward factorization
parms%inv_thresh = 1E-1_psb_dpk_ ! Threshold for inverse factorization
parms%orth_alg = 'LLK' ! What orthogonalization algorithm?
@ -846,16 +869,20 @@ contains
if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg))
case ('ILU','ILUT','MILU')
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",e2.2)') parms%thresh
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",e2.2)') parms%thresh
write(psb_out_unit,'("Invese Fill : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",e2.2)') parms%inv_thresh
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINVT','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",e2.2)') parms%inv_thresh
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select

@ -563,6 +563,14 @@ program psb_s_pde2d
integer(psb_epk_) :: amatsize, precsize, descsize, d2size
real(psb_spk_) :: err, eps
! Parameters for solvers in Block-Jacobi preconditioner
type ainvparms
character(len=12) :: alg, orth_alg, ilu_alg, ilut_scale
integer(psb_ipk_) :: fill, inv_fill
real(psb_spk_) :: thresh, inv_thresh
end type ainvparms
type(ainvparms) :: parms
! other variables
integer(psb_ipk_) :: info, i
character(len=20) :: name,ch_err
@ -592,7 +600,7 @@ program psb_s_pde2d
!
! get parameters
!
call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart)
call get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart,parms)
!
! allocate and fill in the coefficient matrix, rhs and initial guess
@ -615,6 +623,25 @@ program psb_s_pde2d
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ictxt,ptype,info)
!
! Set the options for the BJAC preconditioner
!
if (psb_toupper(ptype) == "BJAC") then
call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg))
case ("ILU")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -704,13 +731,14 @@ contains
!
! get iteration parameters from standard input
!
subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart)
subroutine get_parms(ictxt,kmethd,ptype,afmt,idim,istopc,itmax,itrace,irst,ipart,parms)
integer(psb_ipk_) :: ictxt
character(len=*) :: kmethd, ptype, afmt
integer(psb_ipk_) :: idim, istopc,itmax,itrace,irst,ipart
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: ip, inp_unit
character(len=1024) :: filename
type(ainvparms) :: parms
call psb_info(ictxt, iam, np)
@ -761,6 +789,25 @@ contains
else
irst=1
endif
if (ip >= 9) then
read(inp_unit,*) parms%alg
read(inp_unit,*) parms%ilu_alg
read(inp_unit,*) parms%ilut_scale
read(inp_unit,*) parms%fill
read(inp_unit,*) parms%inv_fill
read(inp_unit,*) parms%thresh
read(inp_unit,*) parms%inv_thresh
read(inp_unit,*) parms%orth_alg
else
parms%alg = 'ILU' ! Block Solver ILU,ILUT,INVK,AINVT,AORTH
parms%ilu_alg = 'NONE' ! If ILU : MILU or NONE othewise ignored
parms%ilut_scale = 'NONE' ! If ILUT: NONE, MAXVAL, DIAG, ARWSUM, ACLSUM, ARCSUM
parms%fill = 0 ! Level of fill for forward factorization
parms%inv_fill = 1 ! Level of fill for inverse factorization (only INVK)
parms%thresh = 1E-1_psb_spk_ ! Threshold for forward factorization
parms%inv_thresh = 1E-1_psb_spk_ ! Threshold for inverse factorization
parms%orth_alg = 'LLK' ! What orthogonalization algorithm?
endif
write(psb_out_unit,'("Solving matrix : ell1")')
write(psb_out_unit,'("Grid dimensions : ",i5," x ",i5)')idim,idim
@ -775,6 +822,27 @@ contains
write(psb_out_unit,'("Unknown data distrbution, defaulting to 2D")')
end select
write(psb_out_unit,'("Preconditioner : ",a)') ptype
if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg))
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINVT','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
end if
write(psb_out_unit,'("Iterative method : ",a)') kmethd
write(psb_out_unit,'(" ")')
else
@ -825,5 +893,3 @@ contains
end subroutine pr_usage
end program psb_s_pde2d

@ -606,9 +606,9 @@ program psb_s_pde3d
! Parameters for solvers in Block-Jacobi preconditioner
type ainvparms
character(len=12) :: alg, orth_alg
character(len=12) :: alg, orth_alg, ilu_alg, ilut_scale
integer(psb_ipk_) :: fill, inv_fill
real(psb_dpk_) :: thresh, inv_thresh
real(psb_spk_) :: thresh, inv_thresh
end type ainvparms
type(ainvparms) :: parms
@ -664,6 +664,25 @@ program psb_s_pde3d
!
if(iam == psb_root_) write(psb_out_unit,'("Setting preconditioner to : ",a)')ptype
call prec%init(ictxt,ptype,info)
!
! Set the options for the BJAC preconditioner
!
if (psb_toupper(ptype) == "BJAC") then
call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg))
case ("ILU")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
@ -813,16 +832,20 @@ contains
irst=1
endif
if (ip >= 9) then
read(psb_inp_unit,*) parms%alg
read(psb_inp_unit,*) parms%fill
read(psb_inp_unit,*) parms%inv_fill
read(psb_inp_unit,*) parms%thresh
read(psb_inp_unit,*) parms%inv_thresh
read(psb_inp_unit,*) parms%orth_alg
read(inp_unit,*) parms%alg
read(inp_unit,*) parms%ilu_alg
read(inp_unit,*) parms%ilut_scale
read(inp_unit,*) parms%fill
read(inp_unit,*) parms%inv_fill
read(inp_unit,*) parms%thresh
read(inp_unit,*) parms%inv_thresh
read(inp_unit,*) parms%orth_alg
else
parms%alg = 'ILU' ! AINV variant: ILU,ILUT,MILU,INVK,AINVT,AORTH
parms%fill = 0 ! Fill in for forward factorization
parms%inv_fill = 1 ! Fill in for inverse factorization
parms%alg = 'ILU' ! Block Solver ILU,ILUT,INVK,AINVT,AORTH
parms%ilu_alg = 'NONE' ! If ILU : MILU or NONE othewise ignored
parms%ilut_scale = 'NONE' ! If ILUT: NONE, MAXVAL, DIAG, ARWSUM, ACLSUM, ARCSUM
parms%fill = 0 ! Level of fill for forward factorization
parms%inv_fill = 1 ! Level of fill for inverse factorization (only INVK)
parms%thresh = 1E-1_psb_spk_ ! Threshold for forward factorization
parms%inv_thresh = 1E-1_psb_spk_ ! Threshold for inverse factorization
parms%orth_alg = 'LLK' ! What orthogonalization algorithm?
@ -846,16 +869,20 @@ contains
if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg))
case ('ILU','ILUT','MILU')
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",e2.2)') parms%thresh
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",e2.2)') parms%thresh
write(psb_out_unit,'("Invese Fill : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",e2.2)') parms%inv_thresh
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINVT','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",e2.2)') parms%inv_thresh
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select

@ -1,4 +1,4 @@
8 Number of entries below this
17 Number of entries below this
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO
@ -8,11 +8,11 @@ CSR Storage format for matrix A: CSR COO
0100 MAXIT
05 ITRACE
002 IRST restart for RGMRES and BiCGSTABL
ILU Factorization variant: ILU,ILUT,MILU,INVK,AINVT,AORTH
0 Fill in for forward factorization
1 Fill in for inverse factorization (ignored if not INVK)
1E-1 Threshold for forward factorization (ignored if ILU)
1E-1 Threshold for inverse factorization (ignored if ILU,ILUT,MILU)
LLK What orthogonalization algorithm? (ignored if ILU,ILUT,MILU,INVK)
ILU Block Solver ILU,ILUT,INVK,AINVT,AORTH
NONE If ILU : MILU or NONE othewise ignored
NONE Scaling if ILUT: NONE, MAXVAL otherwise ignored
0 Level of fill for forward factorization
1 Level of fill for inverse factorization (only INVK)
1E-1 Threshold for forward factorization
1E-1 Threshold for inverse factorization (Only INVK, AINVT)
LLK What orthogonalization algorithm? (Only AINVT)

Loading…
Cancel
Save