fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4:

Browse Source 
krylov/psb_prec_mod.F90
 mlprec/mld_daggrmap_bld.f90
 mlprec/mld_prec_type.f90
 test/fileread/cf_sample.f90
 test/fileread/df_bench.f90
 test/fileread/df_sample.f90
 test/fileread/runs/dfs.inp
 test/fileread/sf_sample.f90
 test/fileread/zf_bench.f90
 test/fileread/zf_sample.f90
 test/pargen/ppde.f90
 test/pargen/spde.f90

Changed name mld_prec_descr into mld_precdescr
stopcriterion
Salvatore Filippone 17 years ago
parent fcf632ccdd
commit 70c2e5400e
12 changed files with 185 additions and 189 deletions
Show Stats Download Patch File Download Diff File

4
krylov/psb_prec_mod.F90
Unescape Escape View File

@ -65,7 +65,7 @@ module psb_prec_mod
& psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_prec_descr => mld_prec_descr,&
& psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr
use mld_prec_mod
@ -105,7 +105,7 @@ module psb_prec_mod
& psb_zprec_type => mld_zprec_type,&
& psb_base_precfree => mld_base_precfree,&
& psb_nullify_baseprec => mld_nullify_baseprec,&
& psb_prec_descr => mld_prec_descr,&
& psb_precdescr => mld_precdescr,&
& psb_prec_short_descr => mld_prec_short_descr,&
& psb_precbld => mld_precbld, &
& psb_precinit => mld_precinit, &

2
mlprec/mld_daggrmap_bld.f90
Unescape Escape View File

@ -158,8 +158,6 @@ subroutine mld_daggrmap_bld(aggr_type,theta,a,desc_a,nlaggr,ilaggr,info)
contains
subroutine mld_dec_map_bld(theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod

340
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -375,11 +375,11 @@ module mld_prec_type
module procedure mld_icheck_def, mld_scheck_def, mld_dcheck_def
end interface
interface mld_prec_descr
module procedure mld_out_prec_descr, mld_file_prec_descr, &
& mld_zout_prec_descr, mld_zfile_prec_descr,&
& mld_sout_prec_descr, mld_sfile_prec_descr,&
& mld_cout_prec_descr, mld_cfile_prec_descr
interface mld_precdescr
module procedure mld_file_prec_descr, &
& mld_zfile_prec_descr,&
& mld_sfile_prec_descr,&
& mld_cfile_prec_descr
end interface
interface mld_prec_short_descr
@ -603,36 +603,6 @@ contains
! Routines printing out a description of the preconditioner
!
!
! Subroutine: mld_out_prec_descr
! Version: real
!
! This routine prints to the standard output a description of the
! preconditioner.
!
! Arguments:
! p - type(mld_dprec_type), input.
! The preconditioner data structure to be printed out.
!
subroutine mld_out_prec_descr(p)
type(mld_dprec_type), intent(in) :: p
call mld_file_prec_descr(6,p)
end subroutine mld_out_prec_descr
subroutine mld_zout_prec_descr(p)
type(mld_zprec_type), intent(in) :: p
call mld_zfile_prec_descr(6,p)
end subroutine mld_zout_prec_descr
subroutine mld_sout_prec_descr(p)
type(mld_sprec_type), intent(in) :: p
call mld_sfile_prec_descr(6,p)
end subroutine mld_sout_prec_descr
subroutine mld_cout_prec_descr(p)
type(mld_cprec_type), intent(in) :: p
call mld_cfile_prec_descr(6,p)
end subroutine mld_cout_prec_descr
!
! Subroutine: mld_file_prec_descr
! Version: real
@ -640,219 +610,233 @@ contains
! This routine prints to a file a description of the preconditioner.
!
! Arguments:
! p - type(mld_dprec_type), input.
! The preconditioner data structure to be printed out.
! iout - integer, input.
! The id of the file where the preconditioner description
! will be printed.
! p - type(mld_dprec_type), input.
! The preconditioner data structure to be printed out.
!
subroutine mld_file_prec_descr(iout,p)
subroutine mld_file_prec_descr(p,iout)
! Arguments
integer, intent(in) :: iout
type(mld_dprec_type), intent(in) :: p
integer, intent(in), optional :: iout
! Local variables
integer :: ilev
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
write(iout,*) 'Preconditioner description'
if (present(iout)) then
iout_ = iout
else
iout_ = 6
end if
write(iout_,*) 'Preconditioner description'
if (allocated(p%baseprecv)) then
if (size(p%baseprecv)>=1) then
ilev = 1
write(iout,*) 'Base preconditioner'
write(iout_,*) 'Base preconditioner'
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
case(mld_noprec_)
write(iout,*) 'No preconditioning'
write(iout_,*) 'No preconditioning'
case(mld_diag_)
write(iout,*) 'Diagonal scaling'
write(iout_,*) 'Diagonal scaling'
case(mld_bjac_)
write(iout,*) 'Block Jacobi with: ',&
write(iout_,*) 'Block Jacobi with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
case(mld_as_)
write(iout,*) 'Additive Schwarz with: ',&
write(iout_,*) 'Additive Schwarz with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Overlap:',&
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
write(iout,*) 'Restriction: ',&
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout,*) 'Prolongation: ',&
write(iout_,*) 'Prolongation: ',&
& prolong_names(p%baseprecv(ilev)%iprcparm(mld_sub_prol_))
end select
end if
if (size(p%baseprecv)>=2) then
do ilev = 2, size(p%baseprecv)
if (.not.allocated(p%baseprecv(ilev)%iprcparm)) then
write(iout,*) 'Inconsistent MLPREC part!'
write(iout_,*) 'Inconsistent MLPREC part!'
return
endif
write(iout,*) 'Multilevel: Level No', ilev
write(iout,*) 'Multilevel type: ',&
write(iout_,*) 'Multilevel: Level No', ilev
write(iout_,*) 'Multilevel type: ',&
& ml_names(p%baseprecv(ilev)%iprcparm(mld_ml_type_))
if (p%baseprecv(ilev)%iprcparm(mld_ml_type_)>mld_no_ml_) then
write(iout,*) 'Multilevel aggregation: ', &
write(iout_,*) 'Multilevel aggregation: ', &
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
write(iout,*) 'Aggregation smoothing: ', &
write(iout_,*) 'Aggregation smoothing: ', &
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
write(iout,*) 'Aggregation threshold: ', &
write(iout_,*) 'Aggregation threshold: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_thresh_)
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Damping omega: ', &
write(iout_,*) 'Damping omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Multilevel smoother position: ',&
write(iout_,*) 'Multilevel smoother position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if
write(iout,*) 'Coarse matrix: ',&
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
if (allocated(p%baseprecv(ilev)%nlaggr)) then
write(iout,*) 'Sizes of aggregates: ', &
write(iout_,*) 'Sizes of aggregates: ', &
& sum( p%baseprecv(ilev)%nlaggr(:)),' : ',p%baseprecv(ilev)%nlaggr(:)
end if
write(iout,*) 'Factorization type: ',&
write(iout_,*) 'Factorization type: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Number of Jacobi sweeps: ', &
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
end if
end do
end if
else
write(iout,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
write(iout_,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
return
endif
end subroutine mld_file_prec_descr
subroutine mld_sfile_prec_descr(iout,p)
subroutine mld_sfile_prec_descr(p,iout)
! Arguments
integer, intent(in) :: iout
type(mld_sprec_type), intent(in) :: p
integer, intent(in), optional :: iout
! Local variables
integer :: ilev
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
write(iout,*) 'Preconditioner description'
if (present(iout)) then
iout_ = iout
else
iout_ = 6
end if
write(iout_,*) 'Preconditioner description'
if (allocated(p%baseprecv)) then
if (size(p%baseprecv)>=1) then
ilev = 1
write(iout,*) 'Base preconditioner'
write(iout_,*) 'Base preconditioner'
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
case(mld_noprec_)
write(iout,*) 'No preconditioning'
write(iout_,*) 'No preconditioning'
case(mld_diag_)
write(iout,*) 'Diagonal scaling'
write(iout_,*) 'Diagonal scaling'
case(mld_bjac_)
write(iout,*) 'Block Jacobi with: ',&
write(iout_,*) 'Block Jacobi with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
case(mld_as_)
write(iout,*) 'Additive Schwarz with: ',&
write(iout_,*) 'Additive Schwarz with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Overlap:',&
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
write(iout,*) 'Restriction: ',&
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout,*) 'Prolongation: ',&
write(iout_,*) 'Prolongation: ',&
& prolong_names(p%baseprecv(ilev)%iprcparm(mld_sub_prol_))
end select
end if
if (size(p%baseprecv)>=2) then
do ilev = 2, size(p%baseprecv)
if (.not.allocated(p%baseprecv(ilev)%iprcparm)) then
write(iout,*) 'Inconsistent MLPREC part!'
write(iout_,*) 'Inconsistent MLPREC part!'
return
endif
write(iout,*) 'Multilevel: Level No', ilev
write(iout,*) 'Multilevel type: ',&
write(iout_,*) 'Multilevel: Level No', ilev
write(iout_,*) 'Multilevel type: ',&
& ml_names(p%baseprecv(ilev)%iprcparm(mld_ml_type_))
if (p%baseprecv(ilev)%iprcparm(mld_ml_type_)>mld_no_ml_) then
write(iout,*) 'Multilevel aggregation: ', &
write(iout_,*) 'Multilevel aggregation: ', &
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
write(iout,*) 'Aggregation smoothing: ', &
write(iout_,*) 'Aggregation smoothing: ', &
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
write(iout,*) 'Aggregation threshold: ', &
write(iout_,*) 'Aggregation threshold: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_thresh_)
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Damping omega: ', &
write(iout_,*) 'Damping omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Multilevel smoother position: ',&
write(iout_,*) 'Multilevel smoother position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if
write(iout,*) 'Coarse matrix: ',&
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
if (allocated(p%baseprecv(ilev)%nlaggr)) then
write(iout,*) 'Sizes of aggregates: ', &
write(iout_,*) 'Sizes of aggregates: ', &
& sum( p%baseprecv(ilev)%nlaggr(:)),' : ',p%baseprecv(ilev)%nlaggr(:)
end if
write(iout,*) 'Factorization type: ',&
write(iout_,*) 'Factorization type: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Number of Jacobi sweeps: ', &
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
end if
end do
end if
else
write(iout,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
write(iout_,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
return
endif
@ -872,218 +856,232 @@ contains
! This routine prints to a file a description of the preconditioner.
!
! Arguments:
! p - type(mld_zprec_type), input.
! The preconditioner data structure to be printed out.
! iout - integer, input.
! The id of the file where the preconditioner description
! will be printed.
! p - type(mld_zprec_type), input.
! The preconditioner data structure to be printed out.
!
subroutine mld_zfile_prec_descr(iout,p)
subroutine mld_zfile_prec_descr(p,iout)
! Arguments
integer, intent(in) :: iout
type(mld_zprec_type), intent(in) :: p
integer, intent(in), optional :: iout
! Local variables
integer :: ilev
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
if (present(iout)) then
iout_ = iout
else
iout_ = 6
end if
write(iout,*) 'Preconditioner description'
write(iout_,*) 'Preconditioner description'
if (allocated(p%baseprecv)) then
if (size(p%baseprecv)>=1) then
write(iout,*) 'Base preconditioner'
write(iout_,*) 'Base preconditioner'
ilev=1
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
case(mld_noprec_)
write(iout,*) 'No preconditioning'
write(iout_,*) 'No preconditioning'
case(mld_diag_)
write(iout,*) 'Diagonal scaling'
write(iout_,*) 'Diagonal scaling'
case(mld_bjac_)
write(iout,*) 'Block Jacobi with: ',&
write(iout_,*) 'Block Jacobi with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
case(mld_as_)
write(iout,*) 'Additive Schwarz with: ',&
write(iout_,*) 'Additive Schwarz with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Overlap:',&
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
write(iout,*) 'Restriction: ',&
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout,*) 'Prolongation: ',&
write(iout_,*) 'Prolongation: ',&
& prolong_names(p%baseprecv(ilev)%iprcparm(mld_sub_prol_))
end select
end if
if (size(p%baseprecv)>=2) then
do ilev = 2, size(p%baseprecv)
if (.not.allocated(p%baseprecv(ilev)%iprcparm)) then
write(iout,*) 'Inconsistent MLPREC part!'
write(iout_,*) 'Inconsistent MLPREC part!'
return
endif
write(iout,*) 'Multilevel: Level No', ilev
write(iout,*) 'Multilevel type: ',&
write(iout_,*) 'Multilevel: Level No', ilev
write(iout_,*) 'Multilevel type: ',&
& ml_names(p%baseprecv(ilev)%iprcparm(mld_ml_type_))
if (p%baseprecv(ilev)%iprcparm(mld_ml_type_)>mld_no_ml_) then
write(iout,*) 'Multilevel aggregation: ', &
write(iout_,*) 'Multilevel aggregation: ', &
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
write(iout,*) 'Aggregation smoothing: ', &
write(iout_,*) 'Aggregation smoothing: ', &
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
write(iout,*) 'Aggregation threshold: ', &
write(iout_,*) 'Aggregation threshold: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_thresh_)
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Smoothing omega: ', &
write(iout_,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Smoothing position: ',&
write(iout_,*) 'Smoothing position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if
write(iout,*) 'Coarse matrix: ',&
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
if (allocated(p%baseprecv(ilev)%nlaggr)) then
write(iout,*) 'Aggregation sizes: ', &
write(iout_,*) 'Aggregation sizes: ', &
& sum( p%baseprecv(ilev)%nlaggr(:)),' : ',p%baseprecv(ilev)%nlaggr(:)
end if
write(iout,*) 'Factorization type: ',&
write(iout_,*) 'Factorization type: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Number of Jacobi sweeps: ', &
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
end if
end do
end if
else
write(iout,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
write(iout_,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
return
endif
end subroutine mld_zfile_prec_descr
subroutine mld_cfile_prec_descr(iout,p)
subroutine mld_cfile_prec_descr(p,iout)
! Arguments
integer, intent(in) :: iout
type(mld_cprec_type), intent(in) :: p
integer, intent(in), optional :: iout
! Local variables
integer :: ilev
character(len=20), parameter :: name='mld_file_prec_descr'
integer :: iout_
if (present(iout)) then
iout_ = iout
else
iout_ = 6
end if
write(iout,*) 'Preconditioner description'
write(iout_,*) 'Preconditioner description'
if (allocated(p%baseprecv)) then
if (size(p%baseprecv)>=1) then
write(iout,*) 'Base preconditioner'
write(iout_,*) 'Base preconditioner'
ilev=1
select case(p%baseprecv(ilev)%iprcparm(mld_prec_type_))
case(mld_noprec_)
write(iout,*) 'No preconditioning'
write(iout_,*) 'No preconditioning'
case(mld_diag_)
write(iout,*) 'Diagonal scaling'
write(iout_,*) 'Diagonal scaling'
case(mld_bjac_)
write(iout,*) 'Block Jacobi with: ',&
write(iout_,*) 'Block Jacobi with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
case(mld_as_)
write(iout,*) 'Additive Schwarz with: ',&
write(iout_,*) 'Additive Schwarz with: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Overlap:',&
write(iout_,*) 'Overlap:',&
& p%baseprecv(ilev)%iprcparm(mld_n_ovr_)
write(iout,*) 'Restriction: ',&
write(iout_,*) 'Restriction: ',&
& restrict_names(p%baseprecv(ilev)%iprcparm(mld_sub_restr_))
write(iout,*) 'Prolongation: ',&
write(iout_,*) 'Prolongation: ',&
& prolong_names(p%baseprecv(ilev)%iprcparm(mld_sub_prol_))
end select
end if
if (size(p%baseprecv)>=2) then
do ilev = 2, size(p%baseprecv)
if (.not.allocated(p%baseprecv(ilev)%iprcparm)) then
write(iout,*) 'Inconsistent MLPREC part!'
write(iout_,*) 'Inconsistent MLPREC part!'
return
endif
write(iout,*) 'Multilevel: Level No', ilev
write(iout,*) 'Multilevel type: ',&
write(iout_,*) 'Multilevel: Level No', ilev
write(iout_,*) 'Multilevel type: ',&
& ml_names(p%baseprecv(ilev)%iprcparm(mld_ml_type_))
if (p%baseprecv(ilev)%iprcparm(mld_ml_type_)>mld_no_ml_) then
write(iout,*) 'Multilevel aggregation: ', &
write(iout_,*) 'Multilevel aggregation: ', &
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
write(iout,*) 'Aggregation smoothing: ', &
write(iout_,*) 'Aggregation smoothing: ', &
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
write(iout,*) 'Aggregation threshold: ', &
write(iout_,*) 'Aggregation threshold: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_thresh_)
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Smoothing omega: ', &
write(iout_,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Smoothing position: ',&
write(iout_,*) 'Smoothing position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if
write(iout,*) 'Coarse matrix: ',&
write(iout_,*) 'Coarse matrix: ',&
& matrix_names(p%baseprecv(ilev)%iprcparm(mld_coarse_mat_))
if (allocated(p%baseprecv(ilev)%nlaggr)) then
write(iout,*) 'Aggregation sizes: ', &
write(iout_,*) 'Aggregation sizes: ', &
& sum( p%baseprecv(ilev)%nlaggr(:)),' : ',p%baseprecv(ilev)%nlaggr(:)
end if
write(iout,*) 'Factorization type: ',&
write(iout_,*) 'Factorization type: ',&
& fact_names(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
select case(p%baseprecv(ilev)%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
write(iout_,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
write(iout_,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_)
case default
write(iout,*) 'Should never get here!'
write(iout_,*) 'Should never get here!'
end select
write(iout,*) 'Number of Jacobi sweeps: ', &
write(iout_,*) 'Number of Jacobi sweeps: ', &
& (p%baseprecv(ilev)%iprcparm(mld_smooth_sweeps_))
end if
end do
end if
else
write(iout,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
write(iout_,*) trim(name),': Error: No Base preconditioner available, something is wrong!'
return
endif

2
test/fileread/cf_sample.f90
Unescape Escape View File

@ -288,7 +288,7 @@ program cf_sample
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (iam==psb_root_) then
call mld_prec_descr(6,prec)
call mld_precdescr(prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence : ",i6)')iter

4
test/fileread/df_bench.f90
Unescape Escape View File

@ -282,7 +282,7 @@ program df_bench
!!$ write(*,'("RHS : ",a)') rhs(nm)
!!$ write(*,'("Method : ",a)') kmethd
!!$ write(*,'("Preconditioner : ",a)') precs(pp)%descr
!!$ call mld_prec_descr(6,pre)
!!$ call mld_precdescr(pre)
!!$ call flush(6)
!!$ end if
iparm = 0
@ -339,7 +339,7 @@ program df_bench
write(*,'("RHS : ",a)') rhs(nm)
write(*,'("Method : ",a)') kmethd
write(*,'("Preconditioner : ",a)') precs(pp)%descr
call mld_prec_descr(pre)
call mld_precdescr(pre)
write(*,'("Computed solution on ",i4," processors")')np
write(*,'(" ")')
write(*,'("Iterations to convergence: ",i6)') iter

2
test/fileread/df_sample.f90
Unescape Escape View File

@ -288,7 +288,7 @@ program df_sample
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (iam==psb_root_) then
call mld_prec_descr(6,prec)
call mld_precdescr(prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence : ",i6)')iter

8
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -1,11 +1,11 @@
matphi_140x33x45.mtx !A_1M_gps.mtx !thm1000x600.mtx ! les_t4.mtx ! young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
tnoto_phi.mtx !NONE !les_t4.rhs ! rhs.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
thm_3180k.mtx !matphi_140x33x45.mtx !A_1M_gps.mtx !thm1000x600.mtx ! les_t4.mtx ! young1r.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
NONE !tnoto_phi.mtx !NONE !les_t4.rhs ! rhs.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD
0 ! IPART: Partition method 0: BLK 2: graph (with Metis)
2 ! ISTOPC
01000 ! ITMAX
01 ! ITRACE
-1 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-5 ! EPS
3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars)
@ -27,4 +27,4 @@ ILU ! Coarse level: solver ILU ILUT UMF SLU SLUDIST
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps
-1.0d0 ! Smoother Omega: if < 0 means library choice.
0.01d0 ! Smoother Aggregation Threshold: >= 0.0
0.10d0 ! Smoother Aggregation Threshold: >= 0.0

2
test/fileread/sf_sample.f90
Unescape Escape View File

@ -288,7 +288,7 @@ program sf_sample
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (iam==psb_root_) then
call mld_prec_descr(6,prec)
call mld_precdescr(prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence : ",i6)')iter

4
test/fileread/zf_bench.f90
Unescape Escape View File

@ -259,7 +259,7 @@ program zf_bench
!!$ write(*,'("RHS : ",a)') rhs(nm)
!!$ write(*,'("Method : ",a)') kmethd
!!$ write(*,'("Preconditioner : ",a)') precs(pp)%descr
!!$ call mld_prec_descr(6,pre)
!!$ call mld_precdescr(pre)
!!$ end if
iparm = 0
call psb_barrier(ictxt)
@ -314,7 +314,7 @@ program zf_bench
write(*,'("RHS : ",a)') rhs(nm)
write(*,'("Method : ",a)') kmethd
write(*,'("Preconditioner : ",a)') precs(pp)%descr
call mld_prec_descr(pre)
call mld_precdescr(pre)
write(*,'("Computed solution on ",i4," processors")')np
write(*,'(" ")')
write(*,'("Iterations to convergence: ",i6)') iter

2
test/fileread/zf_sample.f90
Unescape Escape View File

@ -288,7 +288,7 @@ program zf_sample
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (iam==psb_root_) then
call mld_prec_descr(6,prec)
call mld_precdescr(prec)
write(*,'("Matrix: ",a)')mtrx_file
write(*,'("Computed solution on ",i8," processors")')np
write(*,'("Iterations to convergence : ",i6)')iter

2
test/pargen/ppde.f90
Unescape Escape View File

@ -266,7 +266,7 @@ program ppde
call psb_amx(ictxt,tprec)
if (iam == psb_root_) write(*,'("Preconditioner time : ",es10.4)')tprec
if (iam == psb_root_) call mld_prec_descr(6,prec)
if (iam == psb_root_) call mld_precdescr(prec)
if (iam == psb_root_) write(*,'(" ")')
!

2
test/pargen/spde.f90
Unescape Escape View File

@ -279,7 +279,7 @@ program spde
call psb_amx(ictxt,tprec)
if (iam == psb_root_) write(*,'("Preconditioner time : ",es10.4)')tprec
if (iam == psb_root_) call mld_prec_descr(6,prec)
if (iam == psb_root_) call mld_precdescr(prec)
if (iam == psb_root_) write(*,'(" ")')
!

Write Preview
Loading…
Cancel
Save