fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 04:12:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

Checks for options settings and BJAC setup

Browse Source
This commit is contained in:
Cirdans-Home
2020-11-25 11:14:46 +01:00
parent 927bf9f103
commit b6ebe59ac3
13 changed files with 382 additions and 240 deletions
Download Patch File Download Diff File Expand all files Collapse all files
prec/impl/psb_c_bjacprec_impl.f90
+41 -23
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
! are meaningful, otherwise we give an error and get out of the build
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@@ -569,21 +566,39 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! 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_fact_eps_'
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@@ -596,8 +611,11 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))
prec/impl/psb_c_prec_type_impl.f90
+10 -8
View File
@@ -295,7 +295,7 @@ subroutine psb_c_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
if (present(trans)) then
trans_=psb_toupper(trans)
else
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
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@@ -391,7 +391,7 @@ subroutine psb_ccprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@@ -427,10 +427,10 @@ subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
@@ -449,14 +449,14 @@ subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@@ -467,11 +467,13 @@ subroutine psb_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")
prec/impl/psb_d_bjacprec_impl.f90
+41 -23
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
! are meaningful, otherwise we give an error and get out of the build
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@@ -569,21 +566,39 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! 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_fact_eps_'
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@@ -596,8 +611,11 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))
prec/impl/psb_d_prec_type_impl.f90
+10 -8
View File
@@ -295,7 +295,7 @@ subroutine psb_d_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
if (present(trans)) then
trans_=psb_toupper(trans)
else
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
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@@ -391,7 +391,7 @@ subroutine psb_dcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@@ -427,10 +427,10 @@ subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
@@ -449,14 +449,14 @@ subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@@ -467,11 +467,13 @@ subroutine psb_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")
prec/impl/psb_s_bjacprec_impl.f90
+41 -23
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
! are meaningful, otherwise we give an error and get out of the build
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@@ -569,21 +566,39 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! 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_fact_eps_'
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@@ -596,8 +611,11 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))
prec/impl/psb_s_prec_type_impl.f90
+10 -8
View File
@@ -295,7 +295,7 @@ subroutine psb_s_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
if (present(trans)) then
trans_=psb_toupper(trans)
else
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
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@@ -391,7 +391,7 @@ subroutine psb_scprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@@ -427,10 +427,10 @@ subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
@@ -449,14 +449,14 @@ subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@@ -467,11 +467,13 @@ subroutine psb_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")
prec/impl/psb_z_bjacprec_impl.f90
+41 -23
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
! are meaningful, otherwise we give an error and get out of the build
! procedure
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
if ((ialg == psb_ilu_n_).or.(ialg == psb_milu_n_).or.&
& (ialg == psb_ilu_t_).or.(iinvalg == psb_ainv_llk_).or.&
& (iinvalg == psb_ainv_s_llk_).or.(iinvalg == psb_ainv_s_ft_llk_).or.&
& (iinvalg == psb_ainv_llk_noth_).or.(iinvalg == psb_ainv_mlk_).or.&
& (iinvalg == psb_ainv_lmx_)) then
! Do nothing: admissible request
else
info=psb_err_from_subroutine_
ch_err='psb_ilu_ialg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
iscale = prec%iprcparm(psb_ilu_scale_)
ialg = prec%iprcparm(psb_ilu_ialg_) ! Integer for ILU type algorithm
iinvalg = prec%iprcparm(psb_ainv_alg_) ! Integer for AINV type algorithm
iscale = prec%iprcparm(psb_ilu_scale_) ! Integer for scaling of matrix
fact_eps = prec%rprcparm(psb_fact_eps_) ! Drop-tolerance for factorization
inv_thresh = prec%rprcparm(psb_inv_thresh_) ! Drop-tolerance for inverse
fill_in = prec%iprcparm(psb_ilu_fill_in_) ! Fill-In for factorization
inv_fill = prec%iprcparm(psb_inv_fillin_) ! Fill-In for inverse factorization
! Check if the type of scaling is known, pay attention that not all the
! scalings make sense for all the factorization, if something that does not
! make sense is required the factorization routine will fail in an
! unnrecoverable way.
if ((iscale == psb_ilu_scale_none_).or.&
(iscale == psb_ilu_scale_maxval_).or.&
(iscale == psb_ilu_scale_diag_).or.&
@@ -569,21 +566,39 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fact_eps = prec%rprcparm(psb_fact_eps_)
if( (fact_eps > 1).and.(prec%iprcparm(psb_f_type_) == psb_f_ainv_) ) then
! Check if the variant for the AINV is known to the library
if( (prec%iprcparm(psb_f_type_) == psb_f_ainv_).and.(&
& (iinvalg == psb_ainv_llk_).or.(iinvalg == psb_ainv_s_llk_).or. &
& (iinvalg == psb_ainv_s_ft_llk_).or.(iinvalg == psb_ainv_llk_noth_).or.&
& (iinvalg == psb_ainv_mlk_).or.(iinvalg == psb_ainv_lmx_ ) ) ) then
! Do nothing, these are okay
else
info=psb_err_from_subroutine_
ch_err='psb_ainv_alg_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring
! either ILUT, or INVT we give an error.
if( (fact_eps > 1).and.( &
& (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.&
& (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then
info=psb_err_from_subroutine_
ch_err='psb_fact_eps_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
inv_thresh = prec%rprcparm(psb_inv_thresh_)
if( (inv_thresh > 1) ) then
! 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_fact_eps_'
ch_err='psb_inv_thresh_'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
fill_in = prec%iprcparm(psb_ilu_fill_in_)
! Checks relative to the fill-in parameters
if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then
if(fill_in < 0) then
info=psb_err_from_subroutine_
@@ -596,8 +611,11 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%iprcparm(psb_f_type_) = psb_f_ilu_n_
end if
end if
inv_fill = prec%iprcparm(psb_inv_fillin_)
if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything
! If no limit on the fill_in is required we allow every fill, this is needed
! since this quantity is used to allocate the auxiliary vectors for the
! factorization
if (inv_fill <= 0) inv_fill = m
! Select on the type of factorization to be used
select case(prec%iprcparm(psb_f_type_))
prec/impl/psb_z_prec_type_impl.f90
+10 -8
View File
@@ -295,7 +295,7 @@ subroutine psb_z_apply1v(prec,x,desc_data,info,trans)
call psb_erractionsave(err_act)
ctxt = desc_data%get_context()
call psb_info(ctxt, me, np)
if (present(trans)) then
if (present(trans)) then
trans_=psb_toupper(trans)
else
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
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_FILLIN')
call prec%prec%precset(psb_ilu_fill_in_,val,info)
case ('INV_FILLIN')
@@ -391,7 +391,7 @@ subroutine psb_zcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case('SUB_ILUTHRS')
call prec%prec%precset(psb_fact_eps_,val,info)
case('INV_THRESH')
@@ -427,10 +427,10 @@ subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
! We need to convert from the 'what' string to the corresponding integer
! value befor passing the call to the set of the inner method.
select case (psb_toupper(what))
select case (psb_toupper(trim(what)))
case ('SUB_SOLVE')
! We select here the type of solver on the block
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("ILU")
call prec%prec%precset(psb_f_type_,psb_f_ilu_k_,info)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
@@ -449,14 +449,14 @@ subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_ialg_,psb_ilu_n_,info)
end select
case ("ILU_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MILU")
call prec%prec%precset(psb_ilu_ialg_,psb_milu_n_,info)
case default
! Do nothing
end select
case ("ILUT_SCALE")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case ("MAXVAL")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_maxval_,info)
case ("DIAG")
@@ -467,11 +467,13 @@ subroutine psb_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx)
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_arcsum_,info)
case ("ACLSUM")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_aclsum_,info)
case ("NONE")
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
case default
call prec%prec%precset(psb_ilu_scale_,psb_ilu_scale_none_,info)
end select
case ("AINV_ALG")
select case (psb_toupper(string))
select case (psb_toupper(trim(string)))
case("LLK")
call prec%prec%precset(psb_ainv_alg_,psb_ainv_llk_,info)
case("SYM-LLK")
prec/psb_prec_const_mod.f90
-4
View File
@@ -83,10 +83,6 @@ module psb_prec_const_mod
integer, parameter :: psb_ainv_llk_noth_ = psb_ainv_s_ft_llk_ + 1
integer, parameter :: psb_ainv_mlk_ = psb_ainv_llk_noth_ + 1
integer, parameter :: psb_ainv_lmx_ = psb_ainv_mlk_
#if defined(HAVE_TUMA_SAINV)
integer, parameter :: psb_ainv_s_tuma_ = psb_ainv_lmx_ + 1
integer, parameter :: psb_ainv_l_tuma_ = psb_ainv_s_tuma_ + 1
#endif
interface psb_check_def
test/pargen/psb_d_pde2d.f90
+50 -20
View File
@@ -265,19 +265,19 @@ contains
end if
nt = nr
call psb_sum(ctxt,nt)
if (nt /= m) then
call psb_sum(ctxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! First example of use of CDALL: specify for each process a number of
! contiguous rows
!
!
call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -291,20 +291,20 @@ contains
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
else
write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! 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)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -349,7 +349,7 @@ contains
!
! Third example of use of CDALL: specify for each process
! the set of global indices it owns.
!
!
call psb_cdall(ctxt,desc_a,info,vl=myidx)
case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here'
@@ -503,7 +503,7 @@ contains
end if
tasb = psb_wtime()-t1
call psb_barrier(ctxt)
ttot = psb_wtime() - t0
ttot = psb_wtime() - t0
call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen)
@@ -608,7 +608,7 @@ program psb_d_pde2d
!
call psb_barrier(ctxt)
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)
t2 = psb_wtime() - t1
if(info /= psb_success_) then
@@ -631,11 +631,26 @@ program psb_d_pde2d
call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg))
case ("ILU")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("AINV")
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
@@ -666,7 +681,7 @@ program psb_d_pde2d
!
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt)
t1 = psb_wtime()
t1 = psb_wtime()
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& 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,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINVT','AORTH')
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
end select
end if
write(psb_out_unit,'("Iterative method : ",a)') kmethd
write(psb_out_unit,'(" ")')
else
! wrong number of parameter, print an error message and exit
call pr_usage(izero)
call pr_usage(izero)
call psb_abort(ctxt)
stop 1
endif
@@ -867,7 +890,14 @@ contains
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,itrace)
call psb_bcast(ctxt,irst)
call psb_bcast(ctxt,parms%alg)
call psb_bcast(ctxt,parms%fill)
call psb_bcast(ctxt,parms%inv_fill)
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return
end subroutine get_parms
test/pargen/psb_d_pde3d.f90
+39 -36
View File
@@ -281,19 +281,19 @@ contains
end if
nt = nr
call psb_sum(ctxt,nt)
if (nt /= m) then
call psb_sum(ctxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! First example of use of CDALL: specify for each process a number of
! contiguous rows
!
!
call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -307,20 +307,20 @@ contains
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
else
write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! 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)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -543,7 +543,7 @@ contains
end if
tasb = psb_wtime()-t1
call psb_barrier(ctxt)
ttot = psb_wtime() - t0
ttot = psb_wtime() - t0
call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen)
@@ -648,7 +648,7 @@ program psb_d_pde3d
!
call psb_barrier(ctxt)
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)
t2 = psb_wtime() - t1
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_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
select case (psb_toupper(parms%orth_alg))
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
@@ -721,7 +721,7 @@ program psb_d_pde3d
!
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt)
t1 = psb_wtime()
t1 = psb_wtime()
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
@@ -884,27 +884,29 @@ contains
if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg))
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case ('INVT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
end if
@@ -912,7 +914,7 @@ contains
write(psb_out_unit,'(" ")')
else
! wrong number of parameter, print an error message and exit
call pr_usage(izero)
call pr_usage(izero)
call psb_abort(ctxt)
stop 1
endif
@@ -937,6 +939,7 @@ contains
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return
test/pargen/psb_s_pde2d.f90
+50 -20
View File
@@ -265,19 +265,19 @@ contains
end if
nt = nr
call psb_sum(ctxt,nt)
if (nt /= m) then
call psb_sum(ctxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! First example of use of CDALL: specify for each process a number of
! contiguous rows
!
!
call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -291,20 +291,20 @@ contains
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
else
write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! 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)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -349,7 +349,7 @@ contains
!
! Third example of use of CDALL: specify for each process
! the set of global indices it owns.
!
!
call psb_cdall(ctxt,desc_a,info,vl=myidx)
case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here'
@@ -503,7 +503,7 @@ contains
end if
tasb = psb_wtime()-t1
call psb_barrier(ctxt)
ttot = psb_wtime() - t0
ttot = psb_wtime() - t0
call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen)
@@ -608,7 +608,7 @@ program psb_s_pde2d
!
call psb_barrier(ctxt)
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)
t2 = psb_wtime() - t1
if(info /= psb_success_) then
@@ -631,11 +631,26 @@ program psb_s_pde2d
call prec%set('sub_solve', parms%alg, info)
select case (psb_toupper(parms%alg))
case ("ILU")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
call prec%set('sub_fillin', parms%fill, info)
call prec%set('ilu_alg', parms%ilu_alg, info)
case ("ILUT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('sub_fillin', parms%fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("AINV")
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
@@ -666,7 +681,7 @@ program psb_s_pde2d
!
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt)
t1 = psb_wtime()
t1 = psb_wtime()
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& 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,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINVT','AORTH')
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
end select
end if
write(psb_out_unit,'("Iterative method : ",a)') kmethd
write(psb_out_unit,'(" ")')
else
! wrong number of parameter, print an error message and exit
call pr_usage(izero)
call pr_usage(izero)
call psb_abort(ctxt)
stop 1
endif
@@ -867,7 +890,14 @@ contains
call psb_bcast(ctxt,itmax)
call psb_bcast(ctxt,itrace)
call psb_bcast(ctxt,irst)
call psb_bcast(ctxt,parms%alg)
call psb_bcast(ctxt,parms%fill)
call psb_bcast(ctxt,parms%inv_fill)
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return
end subroutine get_parms
test/pargen/psb_s_pde3d.f90
+39 -36
View File
@@ -281,19 +281,19 @@ contains
end if
nt = nr
call psb_sum(ctxt,nt)
if (nt /= m) then
call psb_sum(ctxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! First example of use of CDALL: specify for each process a number of
! contiguous rows
!
!
call psb_cdall(ctxt,desc_a,info,nl=nr)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -307,20 +307,20 @@ contains
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
else
write(psb_err_unit,*) iam, 'Initialization error: IV not present'
info = -1
call psb_barrier(ctxt)
call psb_abort(ctxt)
return
return
end if
!
! 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)
myidx = desc_a%get_global_indices()
nlr = size(myidx)
@@ -543,7 +543,7 @@ contains
end if
tasb = psb_wtime()-t1
call psb_barrier(ctxt)
ttot = psb_wtime() - t0
ttot = psb_wtime() - t0
call psb_amx(ctxt,talc)
call psb_amx(ctxt,tgen)
@@ -648,7 +648,7 @@ program psb_s_pde3d
!
call psb_barrier(ctxt)
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)
t2 = psb_wtime() - t1
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_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
call prec%set('ainv_alg', parms%orth_alg, info)
case ("INVK")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case ("INVT")
call prec%set('sub_fillin', parms%fill, info)
call prec%set('inv_fillin', parms%inv_fill, info)
call prec%set('sub_iluthrs', parms%thresh, info)
call prec%set('inv_thresh', parms%inv_thresh, info)
call prec%set('ilut_scale', parms%ilut_scale, info)
case default
! Do nothing, use default setting in the init routine
end select
select case (psb_toupper(parms%orth_alg))
end select
else
! nothing to set for NONE or DIAG preconditioner
end if
@@ -721,7 +721,7 @@ program psb_s_pde3d
!
if(iam == psb_root_) write(psb_out_unit,'("Calling iterative method ",a)')kmethd
call psb_barrier(ctxt)
t1 = psb_wtime()
t1 = psb_wtime()
eps = 1.d-6
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
@@ -884,27 +884,29 @@ contains
if( psb_toupper(ptype) == "BJAC" ) then
write(psb_out_unit,'("Block subsolver : ",a)') parms%alg
select case (psb_toupper(parms%alg))
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
case ('INVT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
case ('ILU')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("MILU : ",a)') parms%ilu_alg
case ('ILUT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVK')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('INVT')
write(psb_out_unit,'("Fill in : ",i0)') parms%fill
write(psb_out_unit,'("Threshold : ",es12.5)') parms%thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case ('AINV','AORTH')
write(psb_out_unit,'("Inverse Threshold : ",es12.5)') parms%inv_thresh
write(psb_out_unit,'("Invese Fill in : ",i0)') parms%inv_fill
write(psb_out_unit,'("Orthogonalization : ",a)') parms%orth_alg
write(psb_out_unit,'("Scaling : ",a)') parms%ilut_scale
case default
write(psb_out_unit,'("Unknown diagonal solver")')
end select
end if
@@ -912,7 +914,7 @@ contains
write(psb_out_unit,'(" ")')
else
! wrong number of parameter, print an error message and exit
call pr_usage(izero)
call pr_usage(izero)
call psb_abort(ctxt)
stop 1
endif
@@ -937,6 +939,7 @@ contains
call psb_bcast(ctxt,parms%thresh)
call psb_bcast(ctxt,parms%inv_thresh)
call psb_bcast(ctxt,parms%orth_alg)
call psb_bcast(ctxt,parms%ilut_scale)
return