*** empty log message ***

psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 432e910566
commit 564eb85765

@ -103,6 +103,10 @@ module psb_prec_type
module procedure psb_file_prec_descr module procedure psb_file_prec_descr
end interface end interface
interface psb_prec_short_descr
module procedure psb_prec_short_descr
end interface
contains contains
subroutine psb_file_prec_descr(iout,p) subroutine psb_file_prec_descr(iout,p)
@ -172,6 +176,74 @@ contains
end subroutine psb_file_prec_descr end subroutine psb_file_prec_descr
function psb_prec_short_descr(p)
type(psb_dprec_type), intent(in) :: p
character(len=20) :: psb_prec_short_descr
psb_prec_short_descr = ' '
!!$ write(iout,*) 'Preconditioner description'
!!$ if (associated(p%baseprecv)) then
!!$ if (size(p%baseprecv)>=1) then
!!$ write(iout,*) 'Base preconditioner'
!!$ select case(p%baseprecv(1)%iprcparm(p_type_))
!!$ case(noprec_)
!!$ write(iout,*) 'No preconditioning'
!!$ case(diagsc_)
!!$ write(iout,*) 'Diagonal scaling'
!!$ case(bja_)
!!$ write(iout,*) 'Block Jacobi with: ',&
!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_))
!!$ case(asm_,ras_,ash_,rash_)
!!$ write(iout,*) 'Additive Schwarz with: ',&
!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_))
!!$ write(iout,*) 'Overlap:',&
!!$ & p%baseprecv(1)%iprcparm(n_ovr_)
!!$ write(iout,*) 'Restriction: ',&
!!$ & restrict_names(p%baseprecv(1)%iprcparm(restr_))
!!$ write(iout,*) 'Prolongation: ',&
!!$ & prolong_names(p%baseprecv(1)%iprcparm(prol_))
!!$ end select
!!$ end if
!!$ if (size(p%baseprecv)>=2) then
!!$ if (.not.associated(p%baseprecv(2)%iprcparm)) then
!!$ write(iout,*) 'Inconsistent MLPREC part!'
!!$ return
!!$ endif
!!$ write(iout,*) 'Multilevel: ',ml_names(p%baseprecv(2)%iprcparm(ml_type_))
!!$ if (p%baseprecv(2)%iprcparm(ml_type_)>no_ml_) then
!!$ write(iout,*) 'Multilevel aggregation: ', &
!!$ & aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_))
!!$ write(iout,*) 'Smoother: ', &
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_))
!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_)
!!$ write(iout,*) 'Smoothing position: ',&
!!$ & smooth_names(p%baseprecv(2)%iprcparm(smth_pos_))
!!$ write(iout,*) 'Coarse matrix: ',&
!!$ & matrix_names(p%baseprecv(2)%iprcparm(coarse_mat_))
!!$ write(iout,*) 'Factorization type: ',&
!!$ & fact_names(p%baseprecv(2)%iprcparm(f_type_))
!!$ select case(p%baseprecv(2)%iprcparm(f_type_))
!!$ case(f_ilu_n_)
!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_)
!!$ case(f_ilu_e_)
!!$ write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_)
!!$ case(f_slu_,f_umf_)
!!$ case default
!!$ write(iout,*) 'Should never get here!'
!!$ end select
!!$ write(iout,*) 'Number of Jacobi sweeps: ', &
!!$ & (p%baseprecv(2)%iprcparm(jac_sweeps_))
!!$
!!$ end if
!!$ end if
!!$
!!$ else
!!$ write(iout,*) 'No Base preconditioner available, something is wrong!'
!!$ return
!!$ endif
end function psb_prec_short_descr
function is_legal_base_prec(ip) function is_legal_base_prec(ip)
integer, intent(in) :: ip integer, intent(in) :: ip
logical :: is_legal_base_prec logical :: is_legal_base_prec

@ -16,7 +16,7 @@ subroutine psb_dneigh(a,idx,neigh,n,info,lev)
integer, pointer :: neigh(:) ! the neighbours integer, pointer :: neigh(:) ! the neighbours
integer, optional :: lev ! level of neighbours to find integer, optional :: lev ! level of neighbours to find
integer, pointer :: tmpn(:) integer, pointer :: tmpn(:)=>null()
integer :: level, dim, i, j, k, r, c, brow,& integer :: level, dim, i, j, k, r, c, brow,&
& elem_pt, ii, n1, col_idx, ne, err_act, nn, nidx & elem_pt, ii, n1, col_idx, ne, err_act, nn, nidx
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

Loading…
Cancel
Save