|
|
@ -649,7 +649,7 @@ contains
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
end subroutine ml_parms_mlcycledsc
|
|
|
|
end subroutine ml_parms_mlcycledsc
|
|
|
|
|
|
|
|
|
|
|
|
subroutine ml_parms_mldescr(pm,iout,info)
|
|
|
|
subroutine ml_parms_mldescr(pm,iout,info,prefix)
|
|
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
|
|
@ -657,35 +657,44 @@ contains
|
|
|
|
class(amg_ml_parms), intent(in) :: pm
|
|
|
|
class(amg_ml_parms), intent(in) :: pm
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
|
|
|
character(len=*), intent(in), optional :: prefix
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
character(1024) :: prefix_
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
if (present(prefix)) then
|
|
|
|
|
|
|
|
prefix_ = prefix
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
prefix_ = ""
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
|
|
|
|
if ((pm%ml_cycle>=amg_no_ml_).and.(pm%ml_cycle<=amg_max_ml_cycle_)) then
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
write(iout,*) ' Parallel aggregation algorithm: ',&
|
|
|
|
write(iout,*) trim(prefix),' Parallel aggregation algorithm: ',&
|
|
|
|
& par_aggr_alg_names(pm%par_aggr_alg)
|
|
|
|
& par_aggr_alg_names(pm%par_aggr_alg)
|
|
|
|
if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',&
|
|
|
|
if (pm%aggr_type>0) write(iout,*) trim(prefix),' Aggregation type: ',&
|
|
|
|
& aggr_type_names(pm%aggr_type)
|
|
|
|
& aggr_type_names(pm%aggr_type)
|
|
|
|
!if (pm%par_aggr_alg /= amg_ext_aggr_) then
|
|
|
|
!if (pm%par_aggr_alg /= amg_ext_aggr_) then
|
|
|
|
if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
|
|
|
|
if ( pm%aggr_ord /= amg_aggr_ord_nat_) &
|
|
|
|
& write(iout,*) ' with initial ordering: ',&
|
|
|
|
& write(iout,*) trim(prefix),' with initial ordering: ',&
|
|
|
|
& ord_names(pm%aggr_ord)
|
|
|
|
& ord_names(pm%aggr_ord)
|
|
|
|
write(iout,*) ' Aggregation prolongator: ', &
|
|
|
|
write(iout,*) trim(prefix),' Aggregation prolongator: ', &
|
|
|
|
& aggr_prols(pm%aggr_prol)
|
|
|
|
& aggr_prols(pm%aggr_prol)
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
write(iout,*) ' with: ', aggr_filters(pm%aggr_filter)
|
|
|
|
write(iout,*) trim(prefix),' with: ', aggr_filters(pm%aggr_filter)
|
|
|
|
if (pm%aggr_omega_alg == amg_eig_est_) then
|
|
|
|
if (pm%aggr_omega_alg == amg_eig_est_) then
|
|
|
|
write(iout,*) ' Damping omega computation: spectral radius estimate'
|
|
|
|
write(iout,*) trim(prefix),' Damping omega computation: spectral radius estimate'
|
|
|
|
write(iout,*) ' Spectral radius estimate: ', &
|
|
|
|
write(iout,*) trim(prefix),' Spectral radius estimate: ', &
|
|
|
|
& eigen_estimates(pm%aggr_eig)
|
|
|
|
& eigen_estimates(pm%aggr_eig)
|
|
|
|
else if (pm%aggr_omega_alg == amg_user_choice_) then
|
|
|
|
else if (pm%aggr_omega_alg == amg_user_choice_) then
|
|
|
|
write(iout,*) ' Damping omega computation: user defined value.'
|
|
|
|
write(iout,*) trim(prefix),' Damping omega computation: user defined value.'
|
|
|
|
else
|
|
|
|
else
|
|
|
|
write(iout,*) ' Damping omega computation: unknown value in iprcparm!!'
|
|
|
|
write(iout,*) trim(prefix),' Damping omega computation: unknown value in iprcparm!!'
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
!end if
|
|
|
|
!end if
|
|
|
|
else
|
|
|
|
else
|
|
|
|
write(iout,*) ' Multilevel type: Unkonwn value. Something is amiss....',&
|
|
|
|
write(iout,*) trim(prefix),' Multilevel type: Unkonwn value. Something is amiss....',&
|
|
|
|
& pm%ml_cycle
|
|
|
|
& pm%ml_cycle
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
@ -693,7 +702,7 @@ contains
|
|
|
|
|
|
|
|
|
|
|
|
end subroutine ml_parms_mldescr
|
|
|
|
end subroutine ml_parms_mldescr
|
|
|
|
|
|
|
|
|
|
|
|
subroutine ml_parms_descr(pm,iout,info,coarse)
|
|
|
|
subroutine ml_parms_descr(pm,iout,info,coarse,prefix)
|
|
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
|
|
@ -702,6 +711,7 @@ contains
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
logical, intent(in), optional :: coarse
|
|
|
|
logical, intent(in), optional :: coarse
|
|
|
|
|
|
|
|
character(len=*), intent(in), optional :: prefix
|
|
|
|
logical :: coarse_
|
|
|
|
logical :: coarse_
|
|
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
@ -712,7 +722,7 @@ contains
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
if (coarse_) then
|
|
|
|
if (coarse_) then
|
|
|
|
call pm%coarsedescr(iout,info)
|
|
|
|
call pm%coarsedescr(iout,info,prefix=prefix)
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
return
|
|
|
@ -720,7 +730,7 @@ contains
|
|
|
|
end subroutine ml_parms_descr
|
|
|
|
end subroutine ml_parms_descr
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine ml_parms_coarsedescr(pm,iout,info)
|
|
|
|
subroutine ml_parms_coarsedescr(pm,iout,info,prefix)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
Implicit None
|
|
|
@ -729,54 +739,63 @@ contains
|
|
|
|
class(amg_ml_parms), intent(in) :: pm
|
|
|
|
class(amg_ml_parms), intent(in) :: pm
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
|
|
|
character(len=*), intent(in), optional :: prefix
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
character(1024) :: prefix_
|
|
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
|
write(iout,*) ' Coarse matrix: ',&
|
|
|
|
if (present(prefix)) then
|
|
|
|
|
|
|
|
prefix_ = prefix
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
prefix_ = ""
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
write(iout,*) trim(prefix),' Coarse matrix: ',&
|
|
|
|
& matrix_names(pm%coarse_mat)
|
|
|
|
& matrix_names(pm%coarse_mat)
|
|
|
|
select case(pm%coarse_solve)
|
|
|
|
select case(pm%coarse_solve)
|
|
|
|
case (amg_bjac_,amg_as_)
|
|
|
|
case (amg_bjac_,amg_as_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'Block Jacobi'
|
|
|
|
& 'Block Jacobi'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case (amg_l1_bjac_)
|
|
|
|
case (amg_l1_bjac_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'L1-Block Jacobi'
|
|
|
|
& 'L1-Block Jacobi'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case (amg_jac_)
|
|
|
|
case (amg_jac_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'Point Jacobi'
|
|
|
|
& 'Point Jacobi'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case (amg_l1_jac_)
|
|
|
|
case (amg_l1_jac_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'L1-Jacobi'
|
|
|
|
& 'L1-Jacobi'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case (amg_l1_fbgs_)
|
|
|
|
case (amg_l1_fbgs_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
|
|
|
|
& 'L1 Forward-Backward Gauss-Seidel (Hybrid)'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case (amg_l1_gs_)
|
|
|
|
case (amg_l1_gs_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'L1 Gauss-Seidel (Hybrid)'
|
|
|
|
& 'L1 Gauss-Seidel (Hybrid)'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case (amg_fbgs_)
|
|
|
|
case (amg_fbgs_)
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& 'Forward-Backward Gauss-Seidel (Hybrid)'
|
|
|
|
& 'Forward-Backward Gauss-Seidel (Hybrid)'
|
|
|
|
write(iout,*) ' Number of sweeps : ',&
|
|
|
|
write(iout,*) trim(prefix),' Number of sweeps : ',&
|
|
|
|
& pm%sweeps_pre
|
|
|
|
& pm%sweeps_pre
|
|
|
|
case default
|
|
|
|
case default
|
|
|
|
write(iout,*) ' Coarse solver: ',&
|
|
|
|
write(iout,*) trim(prefix),' Coarse solver: ',&
|
|
|
|
& amg_fact_names(pm%coarse_solve)
|
|
|
|
& amg_fact_names(pm%coarse_solve)
|
|
|
|
end select
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
|
|
|
end subroutine ml_parms_coarsedescr
|
|
|
|
end subroutine ml_parms_coarsedescr
|
|
|
|
|
|
|
|
|
|
|
|
subroutine s_ml_parms_descr(pm,iout,info,coarse)
|
|
|
|
subroutine s_ml_parms_descr(pm,iout,info,coarse,prefix)
|
|
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
|
|
@ -785,20 +804,28 @@ contains
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
logical, intent(in), optional :: coarse
|
|
|
|
logical, intent(in), optional :: coarse
|
|
|
|
|
|
|
|
character(len=*), intent(in), optional :: prefix
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
character(1024) :: prefix_
|
|
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
if (present(prefix)) then
|
|
|
|
|
|
|
|
prefix_ = prefix
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
prefix_ = ""
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
call pm%amg_ml_parms%descr(iout,info,coarse)
|
|
|
|
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
|
|
|
|
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
|
|
|
|
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
|
|
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
|
|
end subroutine s_ml_parms_descr
|
|
|
|
end subroutine s_ml_parms_descr
|
|
|
|
|
|
|
|
|
|
|
|
subroutine d_ml_parms_descr(pm,iout,info,coarse)
|
|
|
|
subroutine d_ml_parms_descr(pm,iout,info,coarse,prefix)
|
|
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
|
|
@ -807,14 +834,22 @@ contains
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(in) :: iout
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
logical, intent(in), optional :: coarse
|
|
|
|
logical, intent(in), optional :: coarse
|
|
|
|
|
|
|
|
character(len=*), intent(in), optional :: prefix
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
character(1024) :: prefix_
|
|
|
|
|
|
|
|
|
|
|
|
info = psb_success_
|
|
|
|
info = psb_success_
|
|
|
|
|
|
|
|
if (present(prefix)) then
|
|
|
|
|
|
|
|
prefix_ = prefix
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
|
|
prefix_ = ""
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
call pm%amg_ml_parms%descr(iout,info,coarse)
|
|
|
|
call pm%amg_ml_parms%descr(iout,info,coarse,prefix=prefix)
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
if (pm%aggr_prol /= amg_no_smooth_) then
|
|
|
|
write(iout,*) ' Damping omega value :',pm%aggr_omega_val
|
|
|
|
write(iout,*) trim(prefix),' Damping omega value :',pm%aggr_omega_val
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
write(iout,*) ' Aggregation threshold:',pm%aggr_thresh
|
|
|
|
write(iout,*) trim(prefix),' Aggregation threshold:',pm%aggr_thresh
|
|
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
|
|