Changed option setting to integrate approximate inverses

implement-ainv
Cirdans-Home 6 years ago
parent 086d93dd28
commit 68007052d5

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

@ -1,15 +1,15 @@
!
!
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use amg_c_onelev_mod, amg_protect_name => amg_c_base_onelev_csetc
use amg_c_base_aggregator_mod
@ -49,6 +49,9 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
use amg_c_ilu_solver
use amg_c_id_solver
use amg_c_gs_solver
use amg_c_ainv_solver
use amg_c_invk_solver
use amg_c_invt_solver
#if defined(HAVE_SLU_)
use amg_c_slu_solver
#endif
@ -59,16 +62,16 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_c_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='c_base_onelev_csetc'
integer(psb_ipk_) :: ival
integer(psb_ipk_) :: ival
type(amg_c_base_smoother_type) :: amg_c_base_smoother_mold
type(amg_c_jac_smoother_type) :: amg_c_jac_smoother_mold
type(amg_c_l1_jac_smoother_type) :: amg_c_l1_jac_smoother_mold
@ -79,13 +82,16 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
type(amg_c_id_solver_type) :: amg_c_id_solver_mold
type(amg_c_gs_solver_type) :: amg_c_gs_solver_mold
type(amg_c_bwgs_solver_type) :: amg_c_bwgs_solver_mold
type(amg_c_ainv_solver_type) :: amg_c_ainv_solver_mold
type(amg_c_invk_solver_type) :: amg_c_invk_solver_mold
type(amg_c_invt_solver_type) :: amg_c_invt_solver_mold
#if defined(HAVE_SLU_)
type(amg_c_slu_solver_type) :: amg_c_slu_solver_mold
#endif
#if defined(HAVE_MUMPS_)
type(amg_c_mumps_solver_type) :: amg_c_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
@ -106,14 +112,14 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
else
ipos_ = amg_smooth_both_
end if
select case (psb_toupper(trim(what)))
case ('SMOOTHER_TYPE')
select case (psb_toupper(trim(val)))
case ('NOPREC','NONE')
call lv%set(amg_c_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_id_solver_mold,info,pos=pos)
case ('JAC','JACOBI')
call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_diag_solver_mold,info,pos=pos)
@ -121,11 +127,11 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-JACOBI')
call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
case ('BJAC')
call lv%set(amg_c_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(amg_c_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
@ -154,67 +160,73 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-BWGS')
call lv%set(amg_c_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_c_bwgs_solver_mold,info,pos='pre')
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
case ('L1-FBGS')
call lv%set(amg_c_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_c_gs_solver_mold,info,pos='pre')
call lv%set(amg_c_l1_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_c_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case('SUB_SOLVE')
select case (psb_toupper(trim(val)))
case ('NONE','NOPREC','FACT_NONE')
call lv%set(amg_c_id_solver_mold,info,pos=pos)
case ('DIAG')
call lv%set(amg_c_diag_solver_mold,info,pos=pos)
case ('L1-DIAG')
call lv%set(amg_c_l1_diag_solver_mold,info,pos=pos)
case ('GS','FGS','FWGS')
call lv%set(amg_c_gs_solver_mold,info,pos=pos)
case ('BGS','BWGS')
call lv%set(amg_c_bwgs_solver_mold,info,pos=pos)
case ('AINV')
call lv%set(amg_c_ainv_solver_mold,info,pos=pos)
case ('INVK')
call lv%set(amg_c_invk_solver_mold,info,pos=pos)
case ('INVT')
call lv%set(amg_c_invt_solver_mold,info,pos=pos)
case ('ILU','ILUT','MILU')
call lv%set(amg_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case ('SLU')
case ('SLU')
call lv%set(amg_c_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case ('MUMPS')
case ('MUMPS')
call lv%set(amg_c_mumps_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
case ('ML_CYCLE')
lv%parms%ml_cycle = amg_stringval(val)
@ -229,7 +241,7 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
return
end if
end if
select case(ival)
case(amg_dec_aggr_)
allocate(amg_c_dec_aggregator_type :: lv%aggr, stat=info)
@ -239,7 +251,7 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = amg_stringval(val)
@ -266,13 +278,13 @@ subroutine amg_c_base_onelev_csetc(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = amg_stringval(val)
case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if

@ -1,15 +1,15 @@
!
!
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use amg_d_onelev_mod, amg_protect_name => amg_d_base_onelev_csetc
use amg_d_base_aggregator_mod
@ -49,6 +49,9 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
use amg_d_ilu_solver
use amg_d_id_solver
use amg_d_gs_solver
use amg_d_ainv_solver
use amg_d_invk_solver
use amg_d_invt_solver
#if defined(HAVE_UMF_)
use amg_d_umf_solver
#endif
@ -65,16 +68,16 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_d_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_csetc'
integer(psb_ipk_) :: ival
integer(psb_ipk_) :: ival
type(amg_d_base_smoother_type) :: amg_d_base_smoother_mold
type(amg_d_jac_smoother_type) :: amg_d_jac_smoother_mold
type(amg_d_l1_jac_smoother_type) :: amg_d_l1_jac_smoother_mold
@ -85,6 +88,9 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
type(amg_d_id_solver_type) :: amg_d_id_solver_mold
type(amg_d_gs_solver_type) :: amg_d_gs_solver_mold
type(amg_d_bwgs_solver_type) :: amg_d_bwgs_solver_mold
type(amg_d_ainv_solver_type) :: amg_d_ainv_solver_mold
type(amg_d_invk_solver_type) :: amg_d_invk_solver_mold
type(amg_d_invt_solver_type) :: amg_d_invt_solver_mold
#if defined(HAVE_UMF_)
type(amg_d_umf_solver_type) :: amg_d_umf_solver_mold
#endif
@ -97,7 +103,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
#if defined(HAVE_MUMPS_)
type(amg_d_mumps_solver_type) :: amg_d_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
@ -118,14 +124,14 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
else
ipos_ = amg_smooth_both_
end if
select case (psb_toupper(trim(what)))
case ('SMOOTHER_TYPE')
select case (psb_toupper(trim(val)))
case ('NOPREC','NONE')
call lv%set(amg_d_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_id_solver_mold,info,pos=pos)
case ('JAC','JACOBI')
call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_diag_solver_mold,info,pos=pos)
@ -133,11 +139,11 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-JACOBI')
call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos)
case ('BJAC')
call lv%set(amg_d_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(amg_d_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
@ -166,59 +172,65 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-BWGS')
call lv%set(amg_d_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_d_bwgs_solver_mold,info,pos='pre')
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
case ('L1-FBGS')
call lv%set(amg_d_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_d_gs_solver_mold,info,pos='pre')
call lv%set(amg_d_l1_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_d_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case('SUB_SOLVE')
select case (psb_toupper(trim(val)))
case ('NONE','NOPREC','FACT_NONE')
call lv%set(amg_d_id_solver_mold,info,pos=pos)
case ('DIAG')
call lv%set(amg_d_diag_solver_mold,info,pos=pos)
case ('L1-DIAG')
call lv%set(amg_d_l1_diag_solver_mold,info,pos=pos)
case ('GS','FGS','FWGS')
call lv%set(amg_d_gs_solver_mold,info,pos=pos)
case ('BGS','BWGS')
call lv%set(amg_d_bwgs_solver_mold,info,pos=pos)
case ('AINV')
call lv%set(amg_d_ainv_solver_mold,info,pos=pos)
case ('INVK')
call lv%set(amg_d_invk_solver_mold,info,pos=pos)
case ('INVT')
call lv%set(amg_d_invt_solver_mold,info,pos=pos)
case ('ILU','ILUT','MILU')
call lv%set(amg_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case ('SLU')
case ('SLU')
call lv%set(amg_d_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case ('MUMPS')
case ('MUMPS')
call lv%set(amg_d_mumps_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_SLUDIST_
@ -231,10 +243,10 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
#endif
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
case ('ML_CYCLE')
lv%parms%ml_cycle = amg_stringval(val)
@ -249,7 +261,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
return
end if
end if
select case(ival)
case(amg_dec_aggr_)
allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info)
@ -259,7 +271,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = amg_stringval(val)
@ -286,13 +298,13 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = amg_stringval(val)
case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if

@ -1,15 +1,15 @@
!
!
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use amg_s_onelev_mod, amg_protect_name => amg_s_base_onelev_csetc
use amg_s_base_aggregator_mod
@ -49,6 +49,9 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
use amg_s_ilu_solver
use amg_s_id_solver
use amg_s_gs_solver
use amg_s_ainv_solver
use amg_s_invk_solver
use amg_s_invt_solver
#if defined(HAVE_SLU_)
use amg_s_slu_solver
#endif
@ -59,16 +62,16 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_s_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='s_base_onelev_csetc'
integer(psb_ipk_) :: ival
integer(psb_ipk_) :: ival
type(amg_s_base_smoother_type) :: amg_s_base_smoother_mold
type(amg_s_jac_smoother_type) :: amg_s_jac_smoother_mold
type(amg_s_l1_jac_smoother_type) :: amg_s_l1_jac_smoother_mold
@ -79,13 +82,16 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
type(amg_s_id_solver_type) :: amg_s_id_solver_mold
type(amg_s_gs_solver_type) :: amg_s_gs_solver_mold
type(amg_s_bwgs_solver_type) :: amg_s_bwgs_solver_mold
type(amg_s_ainv_solver_type) :: amg_s_ainv_solver_mold
type(amg_s_invk_solver_type) :: amg_s_invk_solver_mold
type(amg_s_invt_solver_type) :: amg_s_invt_solver_mold
#if defined(HAVE_SLU_)
type(amg_s_slu_solver_type) :: amg_s_slu_solver_mold
#endif
#if defined(HAVE_MUMPS_)
type(amg_s_mumps_solver_type) :: amg_s_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
@ -106,14 +112,14 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
else
ipos_ = amg_smooth_both_
end if
select case (psb_toupper(trim(what)))
case ('SMOOTHER_TYPE')
select case (psb_toupper(trim(val)))
case ('NOPREC','NONE')
call lv%set(amg_s_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_id_solver_mold,info,pos=pos)
case ('JAC','JACOBI')
call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_diag_solver_mold,info,pos=pos)
@ -121,11 +127,11 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-JACOBI')
call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos)
case ('BJAC')
call lv%set(amg_s_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(amg_s_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
@ -154,67 +160,73 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-BWGS')
call lv%set(amg_s_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_s_bwgs_solver_mold,info,pos='pre')
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
case ('L1-FBGS')
call lv%set(amg_s_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_s_gs_solver_mold,info,pos='pre')
call lv%set(amg_s_l1_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_s_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case('SUB_SOLVE')
select case (psb_toupper(trim(val)))
case ('NONE','NOPREC','FACT_NONE')
call lv%set(amg_s_id_solver_mold,info,pos=pos)
case ('DIAG')
call lv%set(amg_s_diag_solver_mold,info,pos=pos)
case ('L1-DIAG')
call lv%set(amg_s_l1_diag_solver_mold,info,pos=pos)
case ('GS','FGS','FWGS')
call lv%set(amg_s_gs_solver_mold,info,pos=pos)
case ('BGS','BWGS')
call lv%set(amg_s_bwgs_solver_mold,info,pos=pos)
case ('AINV')
call lv%set(amg_s_ainv_solver_mold,info,pos=pos)
case ('INVK')
call lv%set(amg_s_invk_solver_mold,info,pos=pos)
case ('INVT')
call lv%set(amg_s_invt_solver_mold,info,pos=pos)
case ('ILU','ILUT','MILU')
call lv%set(amg_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case ('SLU')
case ('SLU')
call lv%set(amg_s_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case ('MUMPS')
case ('MUMPS')
call lv%set(amg_s_mumps_solver_mold,info,pos=pos)
#endif
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
case ('ML_CYCLE')
lv%parms%ml_cycle = amg_stringval(val)
@ -229,7 +241,7 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
return
end if
end if
select case(ival)
case(amg_dec_aggr_)
allocate(amg_s_dec_aggregator_type :: lv%aggr, stat=info)
@ -239,7 +251,7 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = amg_stringval(val)
@ -266,13 +278,13 @@ subroutine amg_s_base_onelev_csetc(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = amg_stringval(val)
case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if

@ -1,15 +1,15 @@
!
!
!
!
! AMG4PSBLAS version 1.0
! Algebraic Multigrid Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
!
! (C) Copyright 2020
!
! Salvatore Filippone
! Pasqua D'Ambra
! Fabio Durastante
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
@ -21,7 +21,7 @@
! 3. The name of the AMG4PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
@ -33,10 +33,10 @@
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
!
!
subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
use psb_base_mod
use amg_z_onelev_mod, amg_protect_name => amg_z_base_onelev_csetc
use amg_z_base_aggregator_mod
@ -49,6 +49,9 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
use amg_z_ilu_solver
use amg_z_id_solver
use amg_z_gs_solver
use amg_z_ainv_solver
use amg_z_invk_solver
use amg_z_invt_solver
#if defined(HAVE_UMF_)
use amg_z_umf_solver
#endif
@ -65,16 +68,16 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
Implicit None
! Arguments
class(amg_z_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
class(amg_z_onelev_type), intent(inout) :: lv
character(len=*), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos
integer(psb_ipk_), intent(in), optional :: idx
! Local
! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='z_base_onelev_csetc'
integer(psb_ipk_) :: ival
integer(psb_ipk_) :: ival
type(amg_z_base_smoother_type) :: amg_z_base_smoother_mold
type(amg_z_jac_smoother_type) :: amg_z_jac_smoother_mold
type(amg_z_l1_jac_smoother_type) :: amg_z_l1_jac_smoother_mold
@ -85,6 +88,9 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
type(amg_z_id_solver_type) :: amg_z_id_solver_mold
type(amg_z_gs_solver_type) :: amg_z_gs_solver_mold
type(amg_z_bwgs_solver_type) :: amg_z_bwgs_solver_mold
type(amg_z_ainv_solver_type) :: amg_z_ainv_solver_mold
type(amg_z_invk_solver_type) :: amg_z_invk_solver_mold
type(amg_z_invt_solver_type) :: amg_z_invt_solver_mold
#if defined(HAVE_UMF_)
type(amg_z_umf_solver_type) :: amg_z_umf_solver_mold
#endif
@ -97,7 +103,7 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
#if defined(HAVE_MUMPS_)
type(amg_z_mumps_solver_type) :: amg_z_mumps_solver_mold
#endif
call psb_erractionsave(err_act)
@ -118,14 +124,14 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
else
ipos_ = amg_smooth_both_
end if
select case (psb_toupper(trim(what)))
case ('SMOOTHER_TYPE')
select case (psb_toupper(trim(val)))
case ('NOPREC','NONE')
call lv%set(amg_z_base_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_id_solver_mold,info,pos=pos)
case ('JAC','JACOBI')
call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_diag_solver_mold,info,pos=pos)
@ -133,11 +139,11 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-JACOBI')
call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos)
case ('BJAC')
call lv%set(amg_z_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
case ('L1-BJAC')
call lv%set(amg_z_l1_jac_smoother_mold,info,pos=pos)
if (info == 0) call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
@ -166,59 +172,65 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
case ('L1-BWGS')
call lv%set(amg_z_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_z_bwgs_solver_mold,info,pos='pre')
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
if (allocated(lv%sm2a)) deallocate(lv%sm2a)
case ('L1-FBGS')
call lv%set(amg_z_l1_jac_smoother_mold,info,pos='pre')
if (info == 0) call lv%set(amg_z_gs_solver_mold,info,pos='pre')
call lv%set(amg_z_l1_jac_smoother_mold,info,pos='post')
if (info == 0) call lv%set(amg_z_bwgs_solver_mold,info,pos='post')
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) call lv%sm%default()
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default()
end if
case('SUB_SOLVE')
select case (psb_toupper(trim(val)))
case ('NONE','NOPREC','FACT_NONE')
call lv%set(amg_z_id_solver_mold,info,pos=pos)
case ('DIAG')
call lv%set(amg_z_diag_solver_mold,info,pos=pos)
case ('L1-DIAG')
call lv%set(amg_z_l1_diag_solver_mold,info,pos=pos)
case ('GS','FGS','FWGS')
call lv%set(amg_z_gs_solver_mold,info,pos=pos)
case ('BGS','BWGS')
call lv%set(amg_z_bwgs_solver_mold,info,pos=pos)
case ('AINV')
call lv%set(amg_z_ainv_solver_mold,info,pos=pos)
case ('INVK')
call lv%set(amg_z_invk_solver_mold,info,pos=pos)
case ('INVT')
call lv%set(amg_z_invt_solver_mold,info,pos=pos)
case ('ILU','ILUT','MILU')
call lv%set(amg_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
call lv%sm%sv%set('SUB_SOLVE',val,info)
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
end if
end if
#ifdef HAVE_SLU_
case ('SLU')
case ('SLU')
call lv%set(amg_z_slu_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_
case ('MUMPS')
case ('MUMPS')
call lv%set(amg_z_mumps_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_SLUDIST_
@ -231,10 +243,10 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
#endif
case default
!
! Do nothing and hope for the best :)
! Do nothing and hope for the best :)
!
end select
case ('ML_CYCLE')
lv%parms%ml_cycle = amg_stringval(val)
@ -249,7 +261,7 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
return
end if
end if
select case(ival)
case(amg_dec_aggr_)
allocate(amg_z_dec_aggregator_type :: lv%aggr, stat=info)
@ -259,7 +271,7 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = amg_stringval(val)
@ -286,13 +298,13 @@ subroutine amg_z_base_onelev_csetc(lv,what,val,info,pos,idx)
lv%parms%coarse_solve = amg_stringval(val)
case default
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
if ((ipos_==amg_smooth_pre_) .or.(ipos_==amg_smooth_both_)) then
if (allocated(lv%sm)) then
call lv%sm%set(what,val,info,idx=idx)
end if
end if
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
if ((ipos_==amg_smooth_post_).or.(ipos_==amg_smooth_both_))then
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info,idx=idx)
end if
end if

@ -112,9 +112,6 @@ program amg_d_pde2d
type(solverdata) :: s_choice
! preconditioner data
type(amg_d_invt_solver_type) :: invtsv
type(amg_d_invk_solver_type) :: invksv
type(amg_d_ainv_solver_type) :: ainvsv
type precdata
! preconditioner type
@ -309,11 +306,11 @@ program amg_d_pde2d
call prec%set('sub_prol', p_choice%prol, info)
select case(trim(psb_toupper(p_choice%solve)))
case('INVK')
call prec%set(invksv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve, info)
@ -336,12 +333,12 @@ program amg_d_pde2d
call prec%set('sub_prol', p_choice%prol2, info,pos='post')
select case(trim(psb_toupper(p_choice%solve2)))
case('INVK')
call prec%set(invksv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info, pos='post')
call prec%set('ainv_alg', p_choice%variant2, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve2, info, pos='post')
end select

@ -113,9 +113,6 @@ program amg_d_pde3d
type(solverdata) :: s_choice
! preconditioner data
type(amg_d_invt_solver_type) :: invtsv
type(amg_d_invk_solver_type) :: invksv
type(amg_d_ainv_solver_type) :: ainvsv
type precdata
! preconditioner type
@ -313,11 +310,11 @@ program amg_d_pde3d
call prec%set('sub_prol', p_choice%prol, info)
select case(trim(psb_toupper(p_choice%solve)))
case('INVK')
call prec%set(invksv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve, info)
@ -340,12 +337,12 @@ program amg_d_pde3d
call prec%set('sub_prol', p_choice%prol2, info,pos='post')
select case(trim(psb_toupper(p_choice%solve2)))
case('INVK')
call prec%set(invksv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info, pos='post')
call prec%set('ainv_alg', p_choice%variant2, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve2, info, pos='post')
end select

@ -112,9 +112,6 @@ program amg_s_pde2d
type(solverdata) :: s_choice
! preconditioner data
type(amg_s_invt_solver_type) :: invtsv
type(amg_s_invk_solver_type) :: invksv
type(amg_s_ainv_solver_type) :: ainvsv
type precdata
! preconditioner type
@ -309,11 +306,11 @@ program amg_s_pde2d
call prec%set('sub_prol', p_choice%prol, info)
select case(trim(psb_toupper(p_choice%solve)))
case('INVK')
call prec%set(invksv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve, info)
@ -336,12 +333,12 @@ program amg_s_pde2d
call prec%set('sub_prol', p_choice%prol2, info,pos='post')
select case(trim(psb_toupper(p_choice%solve2)))
case('INVK')
call prec%set(invksv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info, pos='post')
call prec%set('ainv_alg', p_choice%variant2, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve2, info, pos='post')
end select

@ -113,9 +113,6 @@ program amg_s_pde3d
type(solverdata) :: s_choice
! preconditioner data
type(amg_s_invt_solver_type) :: invtsv
type(amg_s_invk_solver_type) :: invksv
type(amg_s_ainv_solver_type) :: ainvsv
type precdata
! preconditioner type
@ -313,11 +310,11 @@ program amg_s_pde3d
call prec%set('sub_prol', p_choice%prol, info)
select case(trim(psb_toupper(p_choice%solve)))
case('INVK')
call prec%set(invksv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info)
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info)
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve, info)
@ -340,12 +337,12 @@ program amg_s_pde3d
call prec%set('sub_prol', p_choice%prol2, info,pos='post')
select case(trim(psb_toupper(p_choice%solve2)))
case('INVK')
call prec%set(invksv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('INVT')
call prec%set(invtsv, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
case('AINV')
call prec%set(ainvsv, info, pos='post')
call prec%set('ainv_alg', p_choice%variant2, info, pos='post')
call prec%set('sub_solve', p_choice%solve, info)
call prec%set('ainv_alg', p_choice%variant, info)
case default
call prec%set('sub_solve', p_choice%solve2, info, pos='post')
end select

Loading…
Cancel
Save