From 70c2e5400e7d2d55e31f8de7a02ba773d6a9bd4a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 25 Jun 2008 12:18:34 +0000 Subject: [PATCH] mld2p4: 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 --- krylov/psb_prec_mod.F90 | 4 +- mlprec/mld_daggrmap_bld.f90 | 2 - mlprec/mld_prec_type.f90 | 340 ++++++++++++++++++------------------ test/fileread/cf_sample.f90 | 2 +- test/fileread/df_bench.f90 | 4 +- test/fileread/df_sample.f90 | 2 +- test/fileread/runs/dfs.inp | 8 +- test/fileread/sf_sample.f90 | 2 +- test/fileread/zf_bench.f90 | 4 +- test/fileread/zf_sample.f90 | 2 +- test/pargen/ppde.f90 | 2 +- test/pargen/spde.f90 | 2 +- 12 files changed, 185 insertions(+), 189 deletions(-) diff --git a/krylov/psb_prec_mod.F90 b/krylov/psb_prec_mod.F90 index d15a1837..99fc7d92 100644 --- a/krylov/psb_prec_mod.F90 +++ b/krylov/psb_prec_mod.F90 @@ -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, & diff --git a/mlprec/mld_daggrmap_bld.f90 b/mlprec/mld_daggrmap_bld.f90 index 7c1e1c42..90259851 100644 --- a/mlprec/mld_daggrmap_bld.f90 +++ b/mlprec/mld_daggrmap_bld.f90 @@ -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 diff --git a/mlprec/mld_prec_type.f90 b/mlprec/mld_prec_type.f90 index 512577aa..0bef7028 100644 --- a/mlprec/mld_prec_type.f90 +++ b/mlprec/mld_prec_type.f90 @@ -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_ + + 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 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_ + + 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 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 diff --git a/test/fileread/cf_sample.f90 b/test/fileread/cf_sample.f90 index bcdbab83..3c91f9d2 100644 --- a/test/fileread/cf_sample.f90 +++ b/test/fileread/cf_sample.f90 @@ -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 diff --git a/test/fileread/df_bench.f90 b/test/fileread/df_bench.f90 index 4a8999e9..510d6f5c 100644 --- a/test/fileread/df_bench.f90 +++ b/test/fileread/df_bench.f90 @@ -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 diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index 19a197b2..a79efa9e 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -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 diff --git a/test/fileread/runs/dfs.inp b/test/fileread/runs/dfs.inp index 34b16a76..1284d1b0 100644 --- a/test/fileread/runs/dfs.inp +++ b/test/fileread/runs/dfs.inp @@ -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 diff --git a/test/fileread/sf_sample.f90 b/test/fileread/sf_sample.f90 index 6145ec5e..1c74cfd1 100644 --- a/test/fileread/sf_sample.f90 +++ b/test/fileread/sf_sample.f90 @@ -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 diff --git a/test/fileread/zf_bench.f90 b/test/fileread/zf_bench.f90 index b0457d02..cecbebd1 100644 --- a/test/fileread/zf_bench.f90 +++ b/test/fileread/zf_bench.f90 @@ -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 diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index a4838947..16bc9ff6 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -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 diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index f5712d37..b0eac02a 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -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(*,'(" ")') ! diff --git a/test/pargen/spde.f90 b/test/pargen/spde.f90 index 3ae92b0b..8e40b728 100644 --- a/test/pargen/spde.f90 +++ b/test/pargen/spde.f90 @@ -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(*,'(" ")') !