fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'implement-ainv' of https://github.com/sfilippone/psblas3 into implement-ainv

Browse Source
implement-ainv^2
Salvatore Filippone 4 years ago
parent 1917190ed5 4674de97cf
commit a57b7ce264
17 changed files with 410 additions and 252 deletions
Show Stats Download Patch File Download Diff File

6
base/psblas/psb_cgetmatinfo.f90 → base/psblas/psb_cgetmatinfo.F90
Unescape Escape View File

@ -37,9 +37,13 @@
function psb_cget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_cget_nnz
use psi_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res
type(psb_cspmat_type), intent(in) :: a

6
base/psblas/psb_dgetmatinfo.f90 → base/psblas/psb_dgetmatinfo.F90
Unescape Escape View File

@ -37,9 +37,13 @@
function psb_dget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_dget_nnz
use psi_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res
type(psb_dspmat_type), intent(in) :: a

6
base/psblas/psb_sgetmatinfo.f90 → base/psblas/psb_sgetmatinfo.F90
Unescape Escape View File

@ -37,9 +37,13 @@
function psb_sget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_sget_nnz
use psi_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res
type(psb_sspmat_type), intent(in) :: a

6
base/psblas/psb_zgetmatinfo.f90 → base/psblas/psb_zgetmatinfo.F90
Unescape Escape View File

@ -37,9 +37,13 @@
function psb_zget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_zget_nnz
use psi_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res
type(psb_zspmat_type), intent(in) :: a

60
prec/impl/psb_c_bjacprec_impl.f90
Unescape Escape View File

@ -543,19 +543,16 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@ -569,21 +566,39 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are
! requiring AINV or, or INVT we give an error
if( (inv_thresh > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@ -596,8 +611,11 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))

16
prec/impl/psb_c_prec_type_impl.f90
Unescape Escape View File

@ -355,7 +355,7 @@ subroutine psb_ccprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@ -391,7 +391,7 @@ subroutine psb_ccprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@ -427,10 +427,10 @@ subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(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)
@ -449,14 +449,14 @@ subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(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))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@ -467,11 +467,13 @@ subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")

60
prec/impl/psb_d_bjacprec_impl.f90
Unescape Escape View File

@ -543,19 +543,16 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@ -569,21 +566,39 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are
! requiring AINV or, or INVT we give an error
if( (inv_thresh > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@ -596,8 +611,11 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))

16
prec/impl/psb_d_prec_type_impl.f90
Unescape Escape View File

@ -355,7 +355,7 @@ subroutine psb_dcprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@ -391,7 +391,7 @@ subroutine psb_dcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@ -427,10 +427,10 @@ subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(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)
@ -449,14 +449,14 @@ subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(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))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@ -467,11 +467,13 @@ subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")

60
prec/impl/psb_s_bjacprec_impl.f90
Unescape Escape View File

@ -543,19 +543,16 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@ -569,21 +566,39 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are
! requiring AINV or, or INVT we give an error
if( (inv_thresh > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@ -596,8 +611,11 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))

16
prec/impl/psb_s_prec_type_impl.f90
Unescape Escape View File

@ -355,7 +355,7 @@ subroutine psb_scprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@ -391,7 +391,7 @@ subroutine psb_scprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@ -427,10 +427,10 @@ subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(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)
@ -449,14 +449,14 @@ subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(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))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@ -467,11 +467,13 @@ subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")

60
prec/impl/psb_z_bjacprec_impl.f90
Unescape Escape View File

@ -543,19 +543,16 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@ -569,21 +566,39 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are
! requiring AINV or, or INVT we give an error
if( (inv_thresh > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@ -596,8 +611,11 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))

16
prec/impl/psb_z_prec_type_impl.f90
Unescape Escape View File

@ -355,7 +355,7 @@ subroutine psb_zcprecseti(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@ -391,7 +391,7 @@ subroutine psb_zcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@ -427,10 +427,10 @@ subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! 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))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(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)
@ -449,14 +449,14 @@ subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(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))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@ -467,11 +467,13 @@ subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")

4
prec/psb_prec_const_mod.f90
Unescape Escape View File

@ -83,10 +83,6 @@ module psb_prec_const_mod
integer, parameter :: psb_ainv_llk_noth_ = psb_ainv_s_ft_llk_ + 1
integer, parameter :: psb_ainv_mlk_ = psb_ainv_llk_noth_ + 1
integer, parameter :: psb_ainv_lmx_ = psb_ainv_mlk_
#if defined(HAVE_TUMA_SAINV)
integer, parameter :: psb_ainv_s_tuma_ = psb_ainv_lmx_ + 1
integer, parameter :: psb_ainv_l_tuma_ = psb_ainv_s_tuma_ + 1
#endif
interface psb_check_def

32
test/pargen/psb_d_pde2d.f90
Unescape Escape View File

@ -637,6 +637,21 @@ program psb_d_pde2d
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 ("AINV")
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
@ -834,12 +849,20 @@ contains
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,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
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,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
@ -867,6 +890,13 @@ contains
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,itrace)
call psb_bcast(ctxt,irst)
call psb_bcast(ctxt,parms%alg)
call psb_bcast(ctxt,parms%fill)
call psb_bcast(ctxt,parms%inv_fill)
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return

9
test/pargen/psb_d_pde3d.f90
Unescape Escape View File

@ -681,20 +681,20 @@ program psb_d_pde3d
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
select case (psb_toupper(parms%orth_alg))
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
@ -894,11 +894,13 @@ contains
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
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
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
@ -937,6 +939,7 @@ contains
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return

32
test/pargen/psb_s_pde2d.f90
Unescape Escape View File

@ -637,6 +637,21 @@ program psb_s_pde2d
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 ("AINV")
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
@ -834,12 +849,20 @@ contains
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,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
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,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
@ -867,6 +890,13 @@ contains
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,itrace)
call psb_bcast(ctxt,irst)
call psb_bcast(ctxt,parms%alg)
call psb_bcast(ctxt,parms%fill)
call psb_bcast(ctxt,parms%inv_fill)
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return

9
test/pargen/psb_s_pde3d.f90
Unescape Escape View File

@ -681,20 +681,20 @@ program psb_s_pde3d
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
select case (psb_toupper(parms%orth_alg))
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
@ -894,11 +894,13 @@ contains
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
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
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
@ -937,6 +939,7 @@ contains
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return

Write Preview
Loading…
Cancel
Save