From 34aeacf28c291546b3c0d2892e87605dfc28c236 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 9 May 2010 10:38:49 +0000 Subject: [PATCH] mld2p4-2: Fixes for compilation and printout of preconditioner description. --- mlprec/mld_base_prec_type.f90 | 81 ++++++++++++++++++++++++++++++ mlprec/mld_d_prec_type.f03 | 92 ++++++++++++++++++----------------- mlprec/mld_dprecaply.f90 | 2 +- 3 files changed, 129 insertions(+), 46 deletions(-) diff --git a/mlprec/mld_base_prec_type.f90 b/mlprec/mld_base_prec_type.f90 index 84047dec..7c720487 100644 --- a/mlprec/mld_base_prec_type.f90 +++ b/mlprec/mld_base_prec_type.f90 @@ -606,6 +606,87 @@ contains end subroutine mld_ml_coarse_descr + subroutine mld_ml_new_coarse_descr(iout,ilev,iprcparm,nlaggr,info,& + & rprcparm,dprcparm) + implicit none + integer, intent(in) :: iprcparm(:),iout,ilev + integer, intent(in), allocatable :: nlaggr(:) + integer, intent(out) :: info + real(psb_spk_), intent(in), optional :: rprcparm(:) + real(psb_dpk_), intent(in), optional :: dprcparm(:) + + info = psb_success_ + if (count((/ present(rprcparm),present(dprcparm) /)) /= 1) then + info=psb_err_no_optional_arg_ +!!$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm") + return + endif +!!$ if (count((/ present(rprcparm2),present(dprcparm2) /)) /= 1) then +!!$ info=psb_err_no_optional_arg_ +! !$ call psb_errpush(info,name,a_err=" rprcparm, dprcparm") +!!$ return +!!$ endif + + if (iprcparm(mld_ml_type_)>mld_no_ml_) then + + write(iout,*) ' Level ',ilev,' (coarsest)' + write(iout,*) ' Coarsest matrix: ',& + & matrix_names(iprcparm(mld_coarse_mat_)) + if (allocated(nlaggr)) then + write(iout,*) ' Size of coarsest matrix: ', & + & sum( nlaggr(:)) + write(iout,*) ' Sizes of aggregates: ', & + & nlaggr(:) + end if + if (iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then + + if (present(rprcparm)) then + write(iout,*) ' Damping omega: ', & + & rprcparm(mld_aggr_omega_val_) + else + write(iout,*) ' Damping omega: ', & + & dprcparm(mld_aggr_omega_val_) + end if + end if +!!$ if (iprcparm(mld_coarse_mat_) == mld_distr_mat_ .and. & +!!$ & iprcparm(mld_sub_solve_) /= mld_sludist_) then +! !$ write(iout,*) ' Coarsest matrix solver: ',& +! !$ & smoother_names(iprcparm2(mld_smoother_type_)) +!!$ select case (iprcparm2(mld_smoother_type_)) +!!$ case(mld_bjac_,mld_as_) +!!$ write(iout,*) ' subdomain solver: ',& +!!$ & fact_names(iprcparm2(mld_sub_solve_)) +!!$ write(iout,*) ' Number of smoother sweeps: ', & +!!$ & (iprcparm2(mld_smoother_sweeps_)) +!!$ case(mld_jac_) +!!$ write(iout,*) ' Number of smoother sweeps: ', & +!!$ & (iprcparm2(mld_smoother_sweeps_)) +!!$ end select +!!$ else +!!$ write(iout,*) ' Coarsest matrix solver: ', & +!!$ & fact_names(iprcparm2(mld_sub_solve_)) +!!$ end if +!!$ select case(iprcparm2(mld_sub_solve_)) +!!$ case(mld_ilu_n_,mld_milu_n_) +!!$ write(iout,*) ' Fill level:',iprcparm2(mld_sub_fillin_) +!!$ case(mld_ilu_t_) +!!$ write(iout,*) ' Fill level:',iprcparm2(mld_sub_fillin_) +!!$ if (present(rprcparm2)) then +!!$ write(iout,*) ' Fill threshold :',rprcparm2(mld_sub_iluthrs_) +!!$ else if (present(dprcparm2)) then +!!$ write(iout,*) ' Fill threshold :',dprcparm2(mld_sub_iluthrs_) +!!$ end if +!!$ case(mld_slu_,mld_umf_,mld_sludist_,mld_diag_scale_) +!!$ case default +!!$ write(iout,*) ' Should never get here!' +!!$ end select + end if + + + return + end subroutine mld_ml_new_coarse_descr + + ! ! Functions/subroutines checking if the preconditioner is correctly defined ! diff --git a/mlprec/mld_d_prec_type.f03 b/mlprec/mld_d_prec_type.f03 index faf23255..9b22278c 100644 --- a/mlprec/mld_d_prec_type.f03 +++ b/mlprec/mld_d_prec_type.f03 @@ -435,13 +435,13 @@ contains ! ! Print description of base preconditioner ! + if (nlev > 1) then + write(iout_,*) 'Multilevel Schwarz' + write(iout_,*) + write(iout_,*) 'Base preconditioner (smoother) details' + endif call p%precv(1)%sm%descr(info,iout=iout_) !!$ -!!$ if (nlev > 1) then -!!$ write(iout_,*) 'Multilevel Schwarz' -!!$ write(iout_,*) -!!$ write(iout_,*) 'Base preconditioner (smoother) details' -!!$ endif !!$ !!$ ilev = 1 !!$ call mld_base_prec_descr(iout_,p%precv(ilev)%prec%iprcparm,info,& @@ -450,56 +450,58 @@ contains end if if (nlev > 1) then -!!$ -!!$ ! -!!$ ! Print multilevel details -!!$ ! -!!$ write(iout_,*) -!!$ write(iout_,*) 'Multilevel details' -!!$ -!!$ do ilev = 2, nlev -!!$ if (.not.allocated(p%precv(ilev)%iprcparm)) then -!!$ info = 3111 -!!$ write(iout_,*) ' ',name,& -!!$ & ': error: inconsistent MLPREC part, should call MLD_PRECINIT' -!!$ return -!!$ endif -!!$ end do -!!$ -!!$ write(iout_,*) ' Number of levels: ',nlev -!!$ -!!$ ! -!!$ ! Currently, all the preconditioner parameters must have -!!$ ! the same value at levels -!!$ ! 2,...,nlev-1, hence only the values at level 2 are printed -!!$ ! -!!$ -!!$ ilev=2 -!!$ call mld_ml_alg_descr(iout_,ilev,p%precv(ilev)%iprcparm, info,& -!!$ & dprcparm=p%precv(ilev)%rprcparm) + + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel details' + + do ilev = 2, nlev + if (.not.allocated(p%precv(ilev)%iprcparm)) then + info = 3111 + write(iout_,*) ' ',name,& + & ': error: inconsistent MLPREC part, should call MLD_PRECINIT' + return + endif + end do + + write(iout_,*) ' Number of levels: ',nlev + + ! + ! Currently, all the preconditioner parameters must have + ! the same value at levels + ! 2,...,nlev-1, hence only the values at level 2 are printed + ! + + ilev=2 + call mld_ml_alg_descr(iout_,ilev,p%precv(ilev)%iprcparm, info,& + & dprcparm=p%precv(ilev)%rprcparm) !!$ !!$ ! !!$ ! Coarse matrices are different at levels 2,...,nlev-1, hence related !!$ ! info is printed separately !!$ ! -!!$ write(iout_,*) -!!$ do ilev = 2, nlev-1 -!!$ call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,& -!!$ & p%precv(ilev)%map%naggr,info,& -!!$ & dprcparm=p%precv(ilev)%rprcparm) -!!$ end do + write(iout_,*) + do ilev = 2, nlev-1 + call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,& + & p%precv(ilev)%map%naggr,info,& + & dprcparm=p%precv(ilev)%rprcparm) + call p%precv(ilev)%sm%descr(info,iout=iout_) + + end do !!$ !!$ ! !!$ ! Print coarsest level details !!$ ! !!$ -!!$ ilev = nlev -!!$ write(iout_,*) -!!$ call mld_ml_coarse_descr(iout_,ilev,& -!!$ & p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,& -!!$ & p%precv(ilev)%map%naggr,info,& -!!$ & dprcparm=p%precv(ilev)%rprcparm,& -!!$ & dprcparm2=p%precv(ilev)%prec%rprcparm) + ilev = nlev + write(iout_,*) + call mld_ml_new_coarse_descr(iout_,ilev,& + & p%precv(ilev)%iprcparm,& + & p%precv(ilev)%map%naggr,info,& + & dprcparm=p%precv(ilev)%rprcparm) + call p%precv(ilev)%sm%descr(info,iout=iout_) end if endif diff --git a/mlprec/mld_dprecaply.f90 b/mlprec/mld_dprecaply.f90 index dd6dc8f8..79f4cee4 100644 --- a/mlprec/mld_dprecaply.f90 +++ b/mlprec/mld_dprecaply.f90 @@ -75,7 +75,7 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) use psb_sparse_mod use mld_inner_mod, mld_protect_name => mld_dprecaply - ! use mld_prec_mod, mld_protect_name => mld_dprecaply + !use mld_prec_mod, mld_protect_name2 => mld_dprecaply implicit none