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' into new-context

Browse Source
new-context
Salvatore Filippone 4 years ago
parent 31e6f2cd7b 99f8c2d5aa
commit 96d6260a27
4 changed files with 184 additions and 128 deletions
Show Stats Download Patch File Download Diff File

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

@ -566,38 +566,52 @@ 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
! Check if the variant for the AINV is known to the library select case (prec%iprcparm(psb_f_type_))
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(& case (psb_f_ainv_)
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. & ! Check if the variant for the AINV is known to the library
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.& select case (iinvalg)
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then case(psb_ainv_llk_,psb_ainv_s_llk_,psb_ainv_s_ft_llk_,psb_ainv_llk_noth_,&
! Do nothing, these are okay & psb_ainv_mlk_)
else ! Do nothing these are okay
info=psb_err_from_subroutine_ case default
ch_err='psb_ainv_alg_' info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err=ch_err) ch_err='psb_ainv_alg_'
goto 9999 call psb_errpush(info,name,a_err=ch_err)
end if goto 9999
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring end select ! AINV Variant
! either ILUT, or INVT we give an error. ! Check if the drop-tolerance make sense
if( (fact_eps > 1).and.( & if( inv_thresh > 1) then
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& info=psb_err_from_subroutine_
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then ch_err='psb_inv_thresh_'
info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err=ch_err)
ch_err='psb_fact_eps_' goto 9999
call psb_errpush(info,name,a_err=ch_err) end if
goto 9999 case (psb_f_ilu_t_)
end if if (fact_eps > 1) then
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are ! Check if the drop-tolerance make sense
! requiring AINV or, or INVT we give an error info=psb_err_from_subroutine_
if( (inv_thresh > 1).and.( & ch_err='psb_fact_eps_'
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& call psb_errpush(info,name,a_err=ch_err)
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then goto 9999
info=psb_err_from_subroutine_ end if
ch_err='psb_inv_thresh_' case (psb_f_invt_)
call psb_errpush(info,name,a_err=ch_err) ! Check both tolerances
goto 9999 if (fact_eps > 1) then
end if info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if( inv_thresh > 1) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
case default
end select
! Checks relative to the fill-in parameters ! 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

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

@ -566,38 +566,52 @@ 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
! Check if the variant for the AINV is known to the library select case (prec%iprcparm(psb_f_type_))
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(& case (psb_f_ainv_)
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. & ! Check if the variant for the AINV is known to the library
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.& select case (iinvalg)
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then case(psb_ainv_llk_,psb_ainv_s_llk_,psb_ainv_s_ft_llk_,psb_ainv_llk_noth_,&
! Do nothing, these are okay & psb_ainv_mlk_)
else ! Do nothing these are okay
info=psb_err_from_subroutine_ case default
ch_err='psb_ainv_alg_' info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err=ch_err) ch_err='psb_ainv_alg_'
goto 9999 call psb_errpush(info,name,a_err=ch_err)
end if goto 9999
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring end select ! AINV Variant
! either ILUT, or INVT we give an error. ! Check if the drop-tolerance make sense
if( (fact_eps > 1).and.( & if( inv_thresh > 1) then
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& info=psb_err_from_subroutine_
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then ch_err='psb_inv_thresh_'
info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err=ch_err)
ch_err='psb_fact_eps_' goto 9999
call psb_errpush(info,name,a_err=ch_err) end if
goto 9999 case (psb_f_ilu_t_)
end if if (fact_eps > 1) then
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are ! Check if the drop-tolerance make sense
! requiring AINV or, or INVT we give an error info=psb_err_from_subroutine_
if( (inv_thresh > 1).and.( & ch_err='psb_fact_eps_'
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& call psb_errpush(info,name,a_err=ch_err)
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then goto 9999
info=psb_err_from_subroutine_ end if
ch_err='psb_inv_thresh_' case (psb_f_invt_)
call psb_errpush(info,name,a_err=ch_err) ! Check both tolerances
goto 9999 if (fact_eps > 1) then
end if info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if( inv_thresh > 1) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
case default
end select
! Checks relative to the fill-in parameters ! 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

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

@ -566,38 +566,52 @@ 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
! Check if the variant for the AINV is known to the library select case (prec%iprcparm(psb_f_type_))
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(& case (psb_f_ainv_)
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. & ! Check if the variant for the AINV is known to the library
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.& select case (iinvalg)
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then case(psb_ainv_llk_,psb_ainv_s_llk_,psb_ainv_s_ft_llk_,psb_ainv_llk_noth_,&
! Do nothing, these are okay & psb_ainv_mlk_)
else ! Do nothing these are okay
info=psb_err_from_subroutine_ case default
ch_err='psb_ainv_alg_' info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err=ch_err) ch_err='psb_ainv_alg_'
goto 9999 call psb_errpush(info,name,a_err=ch_err)
end if goto 9999
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring end select ! AINV Variant
! either ILUT, or INVT we give an error. ! Check if the drop-tolerance make sense
if( (fact_eps > 1).and.( & if( inv_thresh > 1) then
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& info=psb_err_from_subroutine_
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then ch_err='psb_inv_thresh_'
info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err=ch_err)
ch_err='psb_fact_eps_' goto 9999
call psb_errpush(info,name,a_err=ch_err) end if
goto 9999 case (psb_f_ilu_t_)
end if if (fact_eps > 1) then
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are ! Check if the drop-tolerance make sense
! requiring AINV or, or INVT we give an error info=psb_err_from_subroutine_
if( (inv_thresh > 1).and.( & ch_err='psb_fact_eps_'
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& call psb_errpush(info,name,a_err=ch_err)
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then goto 9999
info=psb_err_from_subroutine_ end if
ch_err='psb_inv_thresh_' case (psb_f_invt_)
call psb_errpush(info,name,a_err=ch_err) ! Check both tolerances
goto 9999 if (fact_eps > 1) then
end if info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if( inv_thresh > 1) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
case default
end select
! Checks relative to the fill-in parameters ! 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

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

@ -566,38 +566,52 @@ 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
! Check if the variant for the AINV is known to the library select case (prec%iprcparm(psb_f_type_))
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(& case (psb_f_ainv_)
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. & ! Check if the variant for the AINV is known to the library
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.& select case (iinvalg)
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then case(psb_ainv_llk_,psb_ainv_s_llk_,psb_ainv_s_ft_llk_,psb_ainv_llk_noth_,&
! Do nothing, these are okay & psb_ainv_mlk_)
else ! Do nothing these are okay
info=psb_err_from_subroutine_ case default
ch_err='psb_ainv_alg_' info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err=ch_err) ch_err='psb_ainv_alg_'
goto 9999 call psb_errpush(info,name,a_err=ch_err)
end if goto 9999
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring end select ! AINV Variant
! either ILUT, or INVT we give an error. ! Check if the drop-tolerance make sense
if( (fact_eps > 1).and.( & if( inv_thresh > 1) then
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& info=psb_err_from_subroutine_
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then ch_err='psb_inv_thresh_'
info=psb_err_from_subroutine_ call psb_errpush(info,name,a_err=ch_err)
ch_err='psb_fact_eps_' goto 9999
call psb_errpush(info,name,a_err=ch_err) end if
goto 9999 case (psb_f_ilu_t_)
end if if (fact_eps > 1) then
! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are ! Check if the drop-tolerance make sense
! requiring AINV or, or INVT we give an error info=psb_err_from_subroutine_
if( (inv_thresh > 1).and.( & ch_err='psb_fact_eps_'
& (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& call psb_errpush(info,name,a_err=ch_err)
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then goto 9999
info=psb_err_from_subroutine_ end if
ch_err='psb_inv_thresh_' case (psb_f_invt_)
call psb_errpush(info,name,a_err=ch_err) ! Check both tolerances
goto 9999 if (fact_eps > 1) then
end if info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if( inv_thresh > 1) then
info=psb_err_from_subroutine_
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
case default
end select
! Checks relative to the fill-in parameters ! 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

Write Preview
Loading…
Cancel
Save