From db9bb6ca778c1d04999d4520d12bae9fd220524c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 23 Nov 2020 10:09:37 +0100 Subject: [PATCH 1/3] Fix problem in logical recv --- base/modules/penv/psi_p2p_mod.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/base/modules/penv/psi_p2p_mod.F90 b/base/modules/penv/psi_p2p_mod.F90 index 84438f96..f7262378 100644 --- a/base/modules/penv/psi_p2p_mod.F90 +++ b/base/modules/penv/psi_p2p_mod.F90 @@ -216,10 +216,11 @@ contains logical, intent(out) :: dat(:) integer(psb_mpk_), intent(in) :: src integer(psb_mpk_) :: info - integer(psb_mpk_) :: status(mpi_status_size) + integer(psb_mpk_) :: status(mpi_status_size), icomm #if defined(SERIAL_MPI) #else - call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,ctxt,status,info) + icomm = psb_get_mpi_comm(ctxt) + call mpi_recv(dat,size(dat),mpi_logical,src,psb_logical_tag,icomm,status,info) call psb_test_nodes(psb_mesg_queue) #endif From b6ebe59ac339aecc22a1bc3010d7fc5e9435b178 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Wed, 25 Nov 2020 11:14:46 +0100 Subject: [PATCH 2/3] Checks for options settings and BJAC setup --- prec/impl/psb_c_bjacprec_impl.f90 | 64 ++++++++++++++++--------- prec/impl/psb_c_prec_type_impl.f90 | 18 +++---- prec/impl/psb_d_bjacprec_impl.f90 | 64 ++++++++++++++++--------- prec/impl/psb_d_prec_type_impl.f90 | 18 +++---- prec/impl/psb_s_bjacprec_impl.f90 | 64 ++++++++++++++++--------- prec/impl/psb_s_prec_type_impl.f90 | 18 +++---- prec/impl/psb_z_bjacprec_impl.f90 | 64 ++++++++++++++++--------- prec/impl/psb_z_prec_type_impl.f90 | 18 +++---- prec/psb_prec_const_mod.f90 | 4 -- test/pargen/psb_d_pde2d.f90 | 70 ++++++++++++++++++++-------- test/pargen/psb_d_pde3d.f90 | 75 ++++++++++++++++-------------- test/pargen/psb_s_pde2d.f90 | 70 ++++++++++++++++++++-------- test/pargen/psb_s_pde3d.f90 | 75 ++++++++++++++++-------------- 13 files changed, 382 insertions(+), 240 deletions(-) diff --git a/prec/impl/psb_c_bjacprec_impl.f90 b/prec/impl/psb_c_bjacprec_impl.f90 index 798cc23a..1d11e60c 100644 --- a/prec/impl/psb_c_bjacprec_impl.f90 +++ b/prec/impl/psb_c_bjacprec_impl.f90 @@ -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_fact_eps_' + ch_err='psb_ainv_alg_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - inv_thresh = prec%rprcparm(psb_inv_thresh_) - if( (inv_thresh > 1) ) then + ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring + ! either ILUT, or INVT we give an error. + if( (fact_eps > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then info=psb_err_from_subroutine_ ch_err='psb_fact_eps_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - fill_in = prec%iprcparm(psb_ilu_fill_in_) + ! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are + ! requiring AINV or, or INVT we give an error + if( (inv_thresh > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then + info=psb_err_from_subroutine_ + ch_err='psb_inv_thresh_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! Checks relative to the fill-in parameters if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then if(fill_in < 0) then info=psb_err_from_subroutine_ @@ -596,8 +611,11 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%iprcparm(psb_f_type_) = psb_f_ilu_n_ end if end if - inv_fill = prec%iprcparm(psb_inv_fillin_) - if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything + ! If no limit on the fill_in is required we allow every fill, this is needed + ! since this quantity is used to allocate the auxiliary vectors for the + ! factorization + if (inv_fill <= 0) inv_fill = m + ! Select on the type of factorization to be used select case(prec%iprcparm(psb_f_type_)) diff --git a/prec/impl/psb_c_prec_type_impl.f90 b/prec/impl/psb_c_prec_type_impl.f90 index 3446a5e0..e82d7dca 100644 --- a/prec/impl/psb_c_prec_type_impl.f90 +++ b/prec/impl/psb_c_prec_type_impl.f90 @@ -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") diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index 2eb320f6..0cb0bdb9 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -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_fact_eps_' + ch_err='psb_ainv_alg_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - inv_thresh = prec%rprcparm(psb_inv_thresh_) - if( (inv_thresh > 1) ) then + ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring + ! either ILUT, or INVT we give an error. + if( (fact_eps > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then info=psb_err_from_subroutine_ ch_err='psb_fact_eps_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - fill_in = prec%iprcparm(psb_ilu_fill_in_) + ! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are + ! requiring AINV or, or INVT we give an error + if( (inv_thresh > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then + info=psb_err_from_subroutine_ + ch_err='psb_inv_thresh_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! Checks relative to the fill-in parameters if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then if(fill_in < 0) then info=psb_err_from_subroutine_ @@ -596,8 +611,11 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%iprcparm(psb_f_type_) = psb_f_ilu_n_ end if end if - inv_fill = prec%iprcparm(psb_inv_fillin_) - if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything + ! If no limit on the fill_in is required we allow every fill, this is needed + ! since this quantity is used to allocate the auxiliary vectors for the + ! factorization + if (inv_fill <= 0) inv_fill = m + ! Select on the type of factorization to be used select case(prec%iprcparm(psb_f_type_)) diff --git a/prec/impl/psb_d_prec_type_impl.f90 b/prec/impl/psb_d_prec_type_impl.f90 index 9f57e1e8..69e48079 100644 --- a/prec/impl/psb_d_prec_type_impl.f90 +++ b/prec/impl/psb_d_prec_type_impl.f90 @@ -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") diff --git a/prec/impl/psb_s_bjacprec_impl.f90 b/prec/impl/psb_s_bjacprec_impl.f90 index dbe6ecdd..ce1f7444 100644 --- a/prec/impl/psb_s_bjacprec_impl.f90 +++ b/prec/impl/psb_s_bjacprec_impl.f90 @@ -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_fact_eps_' + ch_err='psb_ainv_alg_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - inv_thresh = prec%rprcparm(psb_inv_thresh_) - if( (inv_thresh > 1) ) then + ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring + ! either ILUT, or INVT we give an error. + if( (fact_eps > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then info=psb_err_from_subroutine_ ch_err='psb_fact_eps_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - fill_in = prec%iprcparm(psb_ilu_fill_in_) + ! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are + ! requiring AINV or, or INVT we give an error + if( (inv_thresh > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then + info=psb_err_from_subroutine_ + ch_err='psb_inv_thresh_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! Checks relative to the fill-in parameters if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then if(fill_in < 0) then info=psb_err_from_subroutine_ @@ -596,8 +611,11 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%iprcparm(psb_f_type_) = psb_f_ilu_n_ end if end if - inv_fill = prec%iprcparm(psb_inv_fillin_) - if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything + ! If no limit on the fill_in is required we allow every fill, this is needed + ! since this quantity is used to allocate the auxiliary vectors for the + ! factorization + if (inv_fill <= 0) inv_fill = m + ! Select on the type of factorization to be used select case(prec%iprcparm(psb_f_type_)) diff --git a/prec/impl/psb_s_prec_type_impl.f90 b/prec/impl/psb_s_prec_type_impl.f90 index cb2cb0cd..4272ba75 100644 --- a/prec/impl/psb_s_prec_type_impl.f90 +++ b/prec/impl/psb_s_prec_type_impl.f90 @@ -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") diff --git a/prec/impl/psb_z_bjacprec_impl.f90 b/prec/impl/psb_z_bjacprec_impl.f90 index 5c69485f..93d308d4 100644 --- a/prec/impl/psb_z_bjacprec_impl.f90 +++ b/prec/impl/psb_z_bjacprec_impl.f90 @@ -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_fact_eps_' + ch_err='psb_ainv_alg_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - inv_thresh = prec%rprcparm(psb_inv_thresh_) - if( (inv_thresh > 1) ) then + ! Check if the drop-tolerance make sense, if fact_eps > 1 and we are requiring + ! either ILUT, or INVT we give an error. + if( (fact_eps > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ilu_t_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then info=psb_err_from_subroutine_ ch_err='psb_fact_eps_' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - fill_in = prec%iprcparm(psb_ilu_fill_in_) + ! It the drop-tolerance for the inverse factors, inv_thresh > 1 and we are + ! requiring AINV or, or INVT we give an error + if( (inv_thresh > 1).and.( & + & (prec%iprcparm(psb_f_type_) == psb_f_ainv_).or.& + & (prec%iprcparm(psb_f_type_) == psb_f_invt_) )) then + info=psb_err_from_subroutine_ + ch_err='psb_inv_thresh_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! Checks relative to the fill-in parameters if (prec%iprcparm(psb_f_type_) == psb_f_ilu_n_) then if(fill_in < 0) then info=psb_err_from_subroutine_ @@ -596,8 +611,11 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold) prec%iprcparm(psb_f_type_) = psb_f_ilu_n_ end if end if - inv_fill = prec%iprcparm(psb_inv_fillin_) - if (inv_fill <= 0) inv_fill = m ! If no limit on the fill_in is required we allow everything + ! If no limit on the fill_in is required we allow every fill, this is needed + ! since this quantity is used to allocate the auxiliary vectors for the + ! factorization + if (inv_fill <= 0) inv_fill = m + ! Select on the type of factorization to be used select case(prec%iprcparm(psb_f_type_)) diff --git a/prec/impl/psb_z_prec_type_impl.f90 b/prec/impl/psb_z_prec_type_impl.f90 index 7608854d..00f0b05e 100644 --- a/prec/impl/psb_z_prec_type_impl.f90 +++ b/prec/impl/psb_z_prec_type_impl.f90 @@ -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") diff --git a/prec/psb_prec_const_mod.f90 b/prec/psb_prec_const_mod.f90 index 46c0f11b..73c22e58 100644 --- a/prec/psb_prec_const_mod.f90 +++ b/prec/psb_prec_const_mod.f90 @@ -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 diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index 19d75848..1ccd7f32 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -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 diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index e5bc4c24..4630d946 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -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 diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index c3f4f837..f055e5e6 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -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 diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index e8aaf5a3..0bc77248 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -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 From 4674de97cf4242ed00f4e23648482e5c41031ecd Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Wed, 25 Nov 2020 17:48:37 +0100 Subject: [PATCH 3/3] Corrected call to use mpi --- .../{psb_cgetmatinfo.f90 => psb_cgetmatinfo.F90} | 10 +++++++--- .../{psb_dgetmatinfo.f90 => psb_dgetmatinfo.F90} | 10 +++++++--- .../{psb_sgetmatinfo.f90 => psb_sgetmatinfo.F90} | 10 +++++++--- .../{psb_zgetmatinfo.f90 => psb_zgetmatinfo.F90} | 10 +++++++--- 4 files changed, 28 insertions(+), 12 deletions(-) rename base/psblas/{psb_cgetmatinfo.f90 => psb_cgetmatinfo.F90} (96%) rename base/psblas/{psb_dgetmatinfo.f90 => psb_dgetmatinfo.F90} (96%) rename base/psblas/{psb_sgetmatinfo.f90 => psb_sgetmatinfo.F90} (96%) rename base/psblas/{psb_zgetmatinfo.f90 => psb_zgetmatinfo.F90} (96%) diff --git a/base/psblas/psb_cgetmatinfo.f90 b/base/psblas/psb_cgetmatinfo.F90 similarity index 96% rename from base/psblas/psb_cgetmatinfo.f90 rename to base/psblas/psb_cgetmatinfo.F90 index f9c77166..fdfb0cba 100644 --- a/base/psblas/psb_cgetmatinfo.f90 +++ b/base/psblas/psb_cgetmatinfo.F90 @@ -37,9 +37,13 @@ function psb_cget_nnz(a,desc_a,info) result(res) use psb_base_mod, psb_protect_name => psb_cget_nnz use psi_mod - use mpi - - implicit none +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif integer(psb_lpk_) :: res type(psb_cspmat_type), intent(in) :: a diff --git a/base/psblas/psb_dgetmatinfo.f90 b/base/psblas/psb_dgetmatinfo.F90 similarity index 96% rename from base/psblas/psb_dgetmatinfo.f90 rename to base/psblas/psb_dgetmatinfo.F90 index 51ef5ca8..16a1d3ca 100644 --- a/base/psblas/psb_dgetmatinfo.f90 +++ b/base/psblas/psb_dgetmatinfo.F90 @@ -37,9 +37,13 @@ function psb_dget_nnz(a,desc_a,info) result(res) use psb_base_mod, psb_protect_name => psb_dget_nnz use psi_mod - use mpi - - implicit none +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif integer(psb_lpk_) :: res type(psb_dspmat_type), intent(in) :: a diff --git a/base/psblas/psb_sgetmatinfo.f90 b/base/psblas/psb_sgetmatinfo.F90 similarity index 96% rename from base/psblas/psb_sgetmatinfo.f90 rename to base/psblas/psb_sgetmatinfo.F90 index 2da00f27..abf1210c 100644 --- a/base/psblas/psb_sgetmatinfo.f90 +++ b/base/psblas/psb_sgetmatinfo.F90 @@ -37,9 +37,13 @@ function psb_sget_nnz(a,desc_a,info) result(res) use psb_base_mod, psb_protect_name => psb_sget_nnz use psi_mod - use mpi - - implicit none +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif integer(psb_lpk_) :: res type(psb_sspmat_type), intent(in) :: a diff --git a/base/psblas/psb_zgetmatinfo.f90 b/base/psblas/psb_zgetmatinfo.F90 similarity index 96% rename from base/psblas/psb_zgetmatinfo.f90 rename to base/psblas/psb_zgetmatinfo.F90 index 08482963..fab395f2 100644 --- a/base/psblas/psb_zgetmatinfo.f90 +++ b/base/psblas/psb_zgetmatinfo.F90 @@ -37,9 +37,13 @@ function psb_zget_nnz(a,desc_a,info) result(res) use psb_base_mod, psb_protect_name => psb_zget_nnz use psi_mod - use mpi - - implicit none +#ifdef MPI_MOD + use mpi +#endif + implicit none +#ifdef MPI_H + include 'mpif.h' +#endif integer(psb_lpk_) :: res type(psb_zspmat_type), intent(in) :: a