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

10
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) function psb_cget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_cget_nnz use psb_base_mod, psb_protect_name => psb_cget_nnz
use psi_mod use psi_mod
use mpi #ifdef MPI_MOD
use mpi
implicit none #endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res integer(psb_lpk_) :: res
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a

10
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) function psb_dget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_dget_nnz use psb_base_mod, psb_protect_name => psb_dget_nnz
use psi_mod use psi_mod
use mpi #ifdef MPI_MOD
use mpi
implicit none #endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res integer(psb_lpk_) :: res
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a

10
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) function psb_sget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_sget_nnz use psb_base_mod, psb_protect_name => psb_sget_nnz
use psi_mod use psi_mod
use mpi #ifdef MPI_MOD
use mpi
implicit none #endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res integer(psb_lpk_) :: res
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a

10
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) function psb_zget_nnz(a,desc_a,info) result(res)
use psb_base_mod, psb_protect_name => psb_zget_nnz use psb_base_mod, psb_protect_name => psb_zget_nnz
use psi_mod use psi_mod
use mpi #ifdef MPI_MOD
use mpi
implicit none #endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer(psb_lpk_) :: res integer(psb_lpk_) :: res
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a

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

@ -541,21 +541,18 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! We check if all the information contained in the preconditioner structure ! We check if all the information contained in the preconditioner structure
! are meaningful, otherwise we give an error and get out of the build ! are meaningful, otherwise we give an error and get out of the build
! procedure ! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.& iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.& fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.& inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.& fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
& (iinvalg == psb_ainv_lmx_)) then inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Do nothing: admissible request
else ! Check if the type of scaling is known, pay attention that not all the
info=psb_err_from_subroutine_ ! scalings make sense for all the factorization, if something that does not
ch_err='psb_ilu_ialg_' ! make sense is required the factorization routine will fail in an
call psb_errpush(info,name,a_err=ch_err) ! unnrecoverable way.
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
if ((iscale == psb_ilu_scale_none_).or.& if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.& (iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).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) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
fact_eps = prec%rprcparm(psb_fact_eps_) ! Check if the variant for the AINV is known to the library
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
if( (inv_thresh > 1) ) then ! 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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 (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then if(fill_in < 0) then
info=psb_err_from_subroutine_ 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_ prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if end if
end if end if
inv_fill = prec%iprcparm(psb_inv_fillin_) ! If no limit on the fill_in is required we allow every fill, this is needed
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything ! 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 on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_)) select case(prec%iprcparm(psb_f_type_))

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

@ -295,7 +295,7 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ctxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
else else
trans_='N' trans_='N'
@ -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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info) call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info) call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_SOLVE')
! We select here the type of solver on the block ! We select here the type of solver on the block
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("ILU") case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info) call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,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) call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select end select
case ("ILU_ALG") case ("ILU_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MILU") case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info) call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default case default
! Do nothing ! Do nothing
end select end select
case ("ILUT_SCALE") case ("ILUT_SCALE")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MAXVAL") case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG") 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) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM") case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info) 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 case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select end select
case ("AINV_ALG") case ("AINV_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("LLK") case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info) call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK") case("SYM-LLK")

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

@ -541,21 +541,18 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! We check if all the information contained in the preconditioner structure ! We check if all the information contained in the preconditioner structure
! are meaningful, otherwise we give an error and get out of the build ! are meaningful, otherwise we give an error and get out of the build
! procedure ! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.& iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.& fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.& inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.& fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
& (iinvalg == psb_ainv_lmx_)) then inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Do nothing: admissible request
else ! Check if the type of scaling is known, pay attention that not all the
info=psb_err_from_subroutine_ ! scalings make sense for all the factorization, if something that does not
ch_err='psb_ilu_ialg_' ! make sense is required the factorization routine will fail in an
call psb_errpush(info,name,a_err=ch_err) ! unnrecoverable way.
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
if ((iscale == psb_ilu_scale_none_).or.& if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.& (iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).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) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
fact_eps = prec%rprcparm(psb_fact_eps_) ! Check if the variant for the AINV is known to the library
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
if( (inv_thresh > 1) ) then ! 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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 (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then if(fill_in < 0) then
info=psb_err_from_subroutine_ 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_ prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if end if
end if end if
inv_fill = prec%iprcparm(psb_inv_fillin_) ! If no limit on the fill_in is required we allow every fill, this is needed
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything ! 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 on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_)) select case(prec%iprcparm(psb_f_type_))

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

@ -295,7 +295,7 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ctxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
else else
trans_='N' trans_='N'
@ -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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info) call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info) call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_SOLVE')
! We select here the type of solver on the block ! We select here the type of solver on the block
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("ILU") case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info) call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,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) call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select end select
case ("ILU_ALG") case ("ILU_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MILU") case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info) call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default case default
! Do nothing ! Do nothing
end select end select
case ("ILUT_SCALE") case ("ILUT_SCALE")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MAXVAL") case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG") 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) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM") case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info) 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 case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select end select
case ("AINV_ALG") case ("AINV_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("LLK") case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info) call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK") case("SYM-LLK")

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

@ -541,21 +541,18 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! We check if all the information contained in the preconditioner structure ! We check if all the information contained in the preconditioner structure
! are meaningful, otherwise we give an error and get out of the build ! are meaningful, otherwise we give an error and get out of the build
! procedure ! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.& iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.& fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.& inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.& fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
& (iinvalg == psb_ainv_lmx_)) then inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Do nothing: admissible request
else ! Check if the type of scaling is known, pay attention that not all the
info=psb_err_from_subroutine_ ! scalings make sense for all the factorization, if something that does not
ch_err='psb_ilu_ialg_' ! make sense is required the factorization routine will fail in an
call psb_errpush(info,name,a_err=ch_err) ! unnrecoverable way.
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
if ((iscale == psb_ilu_scale_none_).or.& if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.& (iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).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) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
fact_eps = prec%rprcparm(psb_fact_eps_) ! Check if the variant for the AINV is known to the library
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
if( (inv_thresh > 1) ) then ! 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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 (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then if(fill_in < 0) then
info=psb_err_from_subroutine_ 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_ prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if end if
end if end if
inv_fill = prec%iprcparm(psb_inv_fillin_) ! If no limit on the fill_in is required we allow every fill, this is needed
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything ! 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 on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_)) select case(prec%iprcparm(psb_f_type_))

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

@ -295,7 +295,7 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ctxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
else else
trans_='N' trans_='N'
@ -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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info) call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info) call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_SOLVE')
! We select here the type of solver on the block ! We select here the type of solver on the block
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("ILU") case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info) call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,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) call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select end select
case ("ILU_ALG") case ("ILU_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MILU") case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info) call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default case default
! Do nothing ! Do nothing
end select end select
case ("ILUT_SCALE") case ("ILUT_SCALE")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MAXVAL") case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG") 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) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM") case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info) 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 case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select end select
case ("AINV_ALG") case ("AINV_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("LLK") case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info) call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK") case("SYM-LLK")

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

@ -541,21 +541,18 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
! We check if all the information contained in the preconditioner structure ! We check if all the information contained in the preconditioner structure
! are meaningful, otherwise we give an error and get out of the build ! are meaningful, otherwise we give an error and get out of the build
! procedure ! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.& iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.& fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.& inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.& fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
& (iinvalg == psb_ainv_lmx_)) then inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Do nothing: admissible request
else ! Check if the type of scaling is known, pay attention that not all the
info=psb_err_from_subroutine_ ! scalings make sense for all the factorization, if something that does not
ch_err='psb_ilu_ialg_' ! make sense is required the factorization routine will fail in an
call psb_errpush(info,name,a_err=ch_err) ! unnrecoverable way.
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
if ((iscale == psb_ilu_scale_none_).or.& if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.& (iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).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) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
fact_eps = prec%rprcparm(psb_fact_eps_) ! Check if the variant for the AINV is known to the library
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
if( (inv_thresh > 1) ) then ! 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_ info=psb_err_from_subroutine_
ch_err='psb_fact_eps_' ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if 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 (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then if(fill_in < 0) then
info=psb_err_from_subroutine_ 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_ prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if end if
end if end if
inv_fill = prec%iprcparm(psb_inv_fillin_) ! If no limit on the fill_in is required we allow every fill, this is needed
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything ! 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 on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_)) select case(prec%iprcparm(psb_f_type_))

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

@ -295,7 +295,7 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ctxt = desc_data%get_context() ctxt = desc_data%get_context()
call psb_info(ctxt, me, np) call psb_info(ctxt, me, np)
if (present(trans)) then if (present(trans)) then
trans_=psb_toupper(trans) trans_=psb_toupper(trans)
else else
trans_='N' trans_='N'
@ -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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info) call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info) call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH') 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 ! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method. ! 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') case ('SUB_SOLVE')
! We select here the type of solver on the block ! We select here the type of solver on the block
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("ILU") case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info) call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,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) call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select end select
case ("ILU_ALG") case ("ILU_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MILU") case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info) call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default case default
! Do nothing ! Do nothing
end select end select
case ("ILUT_SCALE") case ("ILUT_SCALE")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case ("MAXVAL") case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG") 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) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM") case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info) 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 case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info) call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select end select
case ("AINV_ALG") case ("AINV_ALG")
select case (psb_toupper(string)) select case (psb_toupper(trim(string)))
case("LLK") case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info) call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK") 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_llk_noth_ = psb_ainv_s_ft_llk_ + 1
integer, parameter :: psb_ainv_mlk_ = psb_ainv_llk_noth_ + 1 integer, parameter :: psb_ainv_mlk_ = psb_ainv_llk_noth_ + 1
integer, parameter :: psb_ainv_lmx_ = psb_ainv_mlk_ 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 interface psb_check_def

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

@ -265,19 +265,19 @@ contains
end if end if
nt = nr nt = nr
call psb_sum(ctxt,nt) call psb_sum(ctxt,nt)
if (nt /= m) then if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! First example of use of CDALL: specify for each process a number of ! First example of use of CDALL: specify for each process a number of
! contiguous rows ! contiguous rows
! !
call psb_cdall(ctxt,desc_a,info,nl=nr) call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -291,20 +291,20 @@ contains
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
else else
write(psb_err_unit,*) iam, 'Initialization error: IV not present' write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! Second example of use of CDALL: specify for each row the ! Second example of use of CDALL: specify for each row the
! process that owns it ! process that owns it
! !
call psb_cdall(ctxt,desc_a,info,vg=iv) call psb_cdall(ctxt,desc_a,info,vg=iv)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -349,7 +349,7 @@ contains
! !
! Third example of use of CDALL: specify for each process ! Third example of use of CDALL: specify for each process
! the set of global indices it owns. ! the set of global indices it owns.
! !
call psb_cdall(ctxt,desc_a,info,vl=myidx) call psb_cdall(ctxt,desc_a,info,vl=myidx)
case default case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here' write(psb_err_unit,*) iam, 'Initialization error: should not get here'
@ -503,7 +503,7 @@ contains
end if end if
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call psb_barrier(ctxt) call psb_barrier(ctxt)
ttot = psb_wtime() - t0 ttot = psb_wtime() - t0
call psb_amx(ctxt,talc) call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen) call psb_amx(ctxt,tgen)
@ -608,7 +608,7 @@ program psb_d_pde2d
! !
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_gen_pde2d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) call psb_gen_pde2d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -631,11 +631,26 @@ program psb_d_pde2d
call prec%set('sub_solve', parms%alg, info) call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg)) select case (psb_toupper(parms%alg))
case ("ILU") case ("ILU")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info) call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT") case ("ILUT")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, 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) call prec%set('ilut_scale', parms%ilut_scale, info)
case default case default
! Do nothing, use default setting in the init routine ! Do nothing, use default setting in the init routine
@ -666,7 +681,7 @@ program psb_d_pde2d
! !
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
eps = 1.d-6 eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
@ -834,21 +849,29 @@ contains
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK') 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,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill 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,'("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,'("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 case default
write(psb_out_unit,'("Unknown diagonal solver")') write(psb_out_unit,'("Unknown diagonal solver")')
end select end select
end if end if
write(psb_out_unit,'("Iterative method : ",a)') kmethd write(psb_out_unit,'("Iterative method : ",a)') kmethd
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
else else
! wrong number of parameter, print an error message and exit ! wrong number of parameter, print an error message and exit
call pr_usage(izero) call pr_usage(izero)
call psb_abort(ctxt) call psb_abort(ctxt)
stop 1 stop 1
endif endif
@ -867,7 +890,14 @@ contains
call psb_bcast(ctxt,itmax) call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,itrace) call psb_bcast(ctxt,itrace)
call psb_bcast(ctxt,irst) 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 return
end subroutine get_parms end subroutine get_parms

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

@ -281,19 +281,19 @@ contains
end if end if
nt = nr nt = nr
call psb_sum(ctxt,nt) call psb_sum(ctxt,nt)
if (nt /= m) then if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! First example of use of CDALL: specify for each process a number of ! First example of use of CDALL: specify for each process a number of
! contiguous rows ! contiguous rows
! !
call psb_cdall(ctxt,desc_a,info,nl=nr) call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -307,20 +307,20 @@ contains
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
else else
write(psb_err_unit,*) iam, 'Initialization error: IV not present' write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! Second example of use of CDALL: specify for each row the ! Second example of use of CDALL: specify for each row the
! process that owns it ! process that owns it
! !
call psb_cdall(ctxt,desc_a,info,vg=iv) call psb_cdall(ctxt,desc_a,info,vg=iv)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -543,7 +543,7 @@ contains
end if end if
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call psb_barrier(ctxt) call psb_barrier(ctxt)
ttot = psb_wtime() - t0 ttot = psb_wtime() - t0
call psb_amx(ctxt,talc) call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen) call psb_amx(ctxt,tgen)
@ -648,7 +648,7 @@ program psb_d_pde3d
! !
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -681,20 +681,20 @@ program psb_d_pde3d
call prec%set('inv_thresh', parms%inv_thresh, info) call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info) call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info) call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK") case ("INVK")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info) call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT") case ("INVT")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info) call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info) call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info) call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default case default
! Do nothing, use default setting in the init routine ! Do nothing, use default setting in the init routine
end select end select
select case (psb_toupper(parms%orth_alg))
end select
else else
! nothing to set for NONE or DIAG preconditioner ! nothing to set for NONE or DIAG preconditioner
end if end if
@ -721,7 +721,7 @@ program psb_d_pde3d
! !
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
eps = 1.d-6 eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
@ -884,27 +884,29 @@ contains
if( psb_toupper(ptype) == "BJAC" ) then if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg)) select case (psb_toupper(parms%alg))
case ('ILU') case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT') case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK') case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case ('INVT') write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
write(psb_out_unit,'("Fill in : ",i0)') parms%fill case ('INVT')
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case ('AINV','AORTH') write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill case ('AINV','AORTH')
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case default 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")') write(psb_out_unit,'("Unknown diagonal solver")')
end select end select
end if end if
@ -912,7 +914,7 @@ contains
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
else else
! wrong number of parameter, print an error message and exit ! wrong number of parameter, print an error message and exit
call pr_usage(izero) call pr_usage(izero)
call psb_abort(ctxt) call psb_abort(ctxt)
stop 1 stop 1
endif endif
@ -937,6 +939,7 @@ contains
call psb_bcast(ctxt,parms%thresh) call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh) call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg) call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return return

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

@ -265,19 +265,19 @@ contains
end if end if
nt = nr nt = nr
call psb_sum(ctxt,nt) call psb_sum(ctxt,nt)
if (nt /= m) then if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! First example of use of CDALL: specify for each process a number of ! First example of use of CDALL: specify for each process a number of
! contiguous rows ! contiguous rows
! !
call psb_cdall(ctxt,desc_a,info,nl=nr) call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -291,20 +291,20 @@ contains
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
else else
write(psb_err_unit,*) iam, 'Initialization error: IV not present' write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! Second example of use of CDALL: specify for each row the ! Second example of use of CDALL: specify for each row the
! process that owns it ! process that owns it
! !
call psb_cdall(ctxt,desc_a,info,vg=iv) call psb_cdall(ctxt,desc_a,info,vg=iv)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -349,7 +349,7 @@ contains
! !
! Third example of use of CDALL: specify for each process ! Third example of use of CDALL: specify for each process
! the set of global indices it owns. ! the set of global indices it owns.
! !
call psb_cdall(ctxt,desc_a,info,vl=myidx) call psb_cdall(ctxt,desc_a,info,vl=myidx)
case default case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here' write(psb_err_unit,*) iam, 'Initialization error: should not get here'
@ -503,7 +503,7 @@ contains
end if end if
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call psb_barrier(ctxt) call psb_barrier(ctxt)
ttot = psb_wtime() - t0 ttot = psb_wtime() - t0
call psb_amx(ctxt,talc) call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen) call psb_amx(ctxt,tgen)
@ -608,7 +608,7 @@ program psb_s_pde2d
! !
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_gen_pde2d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) call psb_gen_pde2d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -631,11 +631,26 @@ program psb_s_pde2d
call prec%set('sub_solve', parms%alg, info) call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg)) select case (psb_toupper(parms%alg))
case ("ILU") case ("ILU")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info) call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT") case ("ILUT")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, 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) call prec%set('ilut_scale', parms%ilut_scale, info)
case default case default
! Do nothing, use default setting in the init routine ! Do nothing, use default setting in the init routine
@ -666,7 +681,7 @@ program psb_s_pde2d
! !
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
eps = 1.d-6 eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
@ -834,21 +849,29 @@ contains
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK') 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,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill 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,'("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,'("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 case default
write(psb_out_unit,'("Unknown diagonal solver")') write(psb_out_unit,'("Unknown diagonal solver")')
end select end select
end if end if
write(psb_out_unit,'("Iterative method : ",a)') kmethd write(psb_out_unit,'("Iterative method : ",a)') kmethd
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
else else
! wrong number of parameter, print an error message and exit ! wrong number of parameter, print an error message and exit
call pr_usage(izero) call pr_usage(izero)
call psb_abort(ctxt) call psb_abort(ctxt)
stop 1 stop 1
endif endif
@ -867,7 +890,14 @@ contains
call psb_bcast(ctxt,itmax) call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,itrace) call psb_bcast(ctxt,itrace)
call psb_bcast(ctxt,irst) 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 return
end subroutine get_parms end subroutine get_parms

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

@ -281,19 +281,19 @@ contains
end if end if
nt = nr nt = nr
call psb_sum(ctxt,nt) call psb_sum(ctxt,nt)
if (nt /= m) then if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! First example of use of CDALL: specify for each process a number of ! First example of use of CDALL: specify for each process a number of
! contiguous rows ! contiguous rows
! !
call psb_cdall(ctxt,desc_a,info,nl=nr) call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -307,20 +307,20 @@ contains
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
else else
write(psb_err_unit,*) iam, 'Initialization error: IV not present' write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1 info = -1
call psb_barrier(ctxt) call psb_barrier(ctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end if end if
! !
! Second example of use of CDALL: specify for each row the ! Second example of use of CDALL: specify for each row the
! process that owns it ! process that owns it
! !
call psb_cdall(ctxt,desc_a,info,vg=iv) call psb_cdall(ctxt,desc_a,info,vg=iv)
myidx = desc_a%get_global_indices() myidx = desc_a%get_global_indices()
nlr = size(myidx) nlr = size(myidx)
@ -543,7 +543,7 @@ contains
end if end if
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call psb_barrier(ctxt) call psb_barrier(ctxt)
ttot = psb_wtime() - t0 ttot = psb_wtime() - t0
call psb_amx(ctxt,talc) call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen) call psb_amx(ctxt,tgen)
@ -648,7 +648,7 @@ program psb_s_pde3d
! !
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart) call psb_gen_pde3d(ctxt,idim,a,bv,xxv,desc_a,afmt,info,partition=ipart)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t2 = psb_wtime() - t1 t2 = psb_wtime() - t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -681,20 +681,20 @@ program psb_s_pde3d
call prec%set('inv_thresh', parms%inv_thresh, info) call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info) call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info) call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK") case ("INVK")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info) call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT") case ("INVT")
call prec%set('sub_fillin', parms%fill, info) call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info) call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info) call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info) call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default case default
! Do nothing, use default setting in the init routine ! Do nothing, use default setting in the init routine
end select end select
select case (psb_toupper(parms%orth_alg))
end select
else else
! nothing to set for NONE or DIAG preconditioner ! nothing to set for NONE or DIAG preconditioner
end if end if
@ -721,7 +721,7 @@ program psb_s_pde3d
! !
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
eps = 1.d-6 eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,& call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
@ -884,27 +884,29 @@ contains
if( psb_toupper(ptype) == "BJAC" ) then if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg)) select case (psb_toupper(parms%alg))
case ('ILU') case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT') case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK') case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case ('INVT') write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
write(psb_out_unit,'("Fill in : ",i0)') parms%fill case ('INVT')
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case ('AINV','AORTH') write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill case ('AINV','AORTH')
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case default 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")') write(psb_out_unit,'("Unknown diagonal solver")')
end select end select
end if end if
@ -912,7 +914,7 @@ contains
write(psb_out_unit,'(" ")') write(psb_out_unit,'(" ")')
else else
! wrong number of parameter, print an error message and exit ! wrong number of parameter, print an error message and exit
call pr_usage(izero) call pr_usage(izero)
call psb_abort(ctxt) call psb_abort(ctxt)
stop 1 stop 1
endif endif
@ -937,6 +939,7 @@ contains
call psb_bcast(ctxt,parms%thresh) call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh) call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg) call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return return

Write Preview
Loading…
Cancel
Save