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

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

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

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

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