mld2p4-dev:

mlprec/Makefile
 mlprec/mld_daggrmat_smth_asb.F90
 mlprec/mld_dilu_bld.f90
 mlprec/mld_dmlprec_aply.f90
 mlprec/mld_dmlprec_bld.f90
 mlprec/mld_dprecinit.f90
 mlprec/mld_dprecset.f90
 mlprec/mld_prec_type.f90
 mlprec/mld_zaggrmat_smth_asb.F90
 mlprec/mld_zilu_bld.f90
 mlprec/mld_zmlprec_aply.f90
 mlprec/mld_zmlprec_bld.f90
 mlprec/mld_zprecinit.f90
 mlprec/mld_zprecset.f90


Changed name of dprcparm into rprcparm.
stopcriterion
Salvatore Filippone 17 years ago
parent 61460bde96
commit 5c7ed88574

@ -34,7 +34,7 @@ COBJS=mld_dslu_interface.o mld_dumf_interface.o mld_zslu_interface.o mld_zumf_in
OBJS=$(F90OBJS) $(COBJS) $(MPFOBJS) $(MPCOBJS) $(MODOBJS) OBJS=$(F90OBJS) $(COBJS) $(MPFOBJS) $(MPCOBJS) $(MODOBJS)
LIBMOD=mld_prec_mod$(.mod) LIBMOD=mld_prec_mod$(.mod)
LOCAL_MODS=$(LIBMOD) mld_prec_type$(.mod) mld_inner_mod$(.mod) LOCAL_MODS=$(LIBMOD) mld_prec_type$(.mod) mld_inner_mod$(.mod) mld_basep_bld_mod$(.mod)
LIBNAME=libmld_prec.a LIBNAME=libmld_prec.a
lib: mpobjs $(OBJS) lib: mpobjs $(OBJS)

@ -295,11 +295,11 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
goto 9999 goto 9999
end if end if
omega = 4.d0/(3.d0*anorm) omega = 4.d0/(3.d0*anorm)
p%dprcparm(mld_aggr_damp_) = omega p%rprcparm(mld_aggr_damp_) = omega
else if (p%iprcparm(mld_aggr_eig_) == mld_user_choice_) then else if (p%iprcparm(mld_aggr_eig_) == mld_user_choice_) then
omega = p%dprcparm(mld_aggr_damp_) omega = p%rprcparm(mld_aggr_damp_)
else if (p%iprcparm(mld_aggr_eig_) /= mld_user_choice_) then else if (p%iprcparm(mld_aggr_eig_) /= mld_user_choice_) then
info = 4001 info = 4001

@ -201,7 +201,7 @@ subroutine mld_dilu_bld(a,p,upd,info,blck)
case(0:) case(0:)
! Fill-in >= 0 ! Fill-in >= 0
call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%dprcparm(mld_fact_thrs_),& call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%rprcparm(mld_fact_thrs_),&
& a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck) & a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select end select
if(info/=0) then if(info/=0) then

@ -111,7 +111,7 @@
! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable. ! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base ! The integer parameters defining the base
! preconditioner K(ilev). ! preconditioner K(ilev).
! baseprecv(ilev)%dprcparm - real(psb_dpk_), dimension(:), allocatable. ! baseprecv(ilev)%rprcparm - real(psb_dpk_), dimension(:), allocatable.
! The real parameters defining the base preconditioner ! The real parameters defining the base preconditioner
! K(ilev). ! K(ilev).
! baseprecv(ilev)%perm - integer, dimension(:), allocatable. ! baseprecv(ilev)%perm - integer, dimension(:), allocatable.

@ -106,9 +106,9 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
case(mld_ilu_n_,mld_milu_n_) case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev) call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
case(mld_ilu_t_) case(mld_ilu_t_)
call mld_check_def(p%dprcparm(mld_fact_thrs_),'Eps',dzero,is_legal_fact_thrs) call mld_check_def(p%rprcparm(mld_fact_thrs_),'Eps',dzero,is_legal_fact_thrs)
end select end select
call mld_check_def(p%dprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega) call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega)
call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',& call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',&
& 1,is_legal_jac_sweeps) & 1,is_legal_jac_sweeps)

@ -115,7 +115,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
@ -131,7 +131,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
@ -147,7 +147,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@ -164,7 +164,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
@ -187,7 +187,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
@ -202,7 +202,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
do ilev_ = 2, nlev_ -1 do ilev_ = 2, nlev_ -1
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@ -219,11 +219,11 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1 p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%dprcparm(mld_aggr_damp_) = 4.d0/3.d0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do end do
ilev_ = nlev_ ilev_ = nlev_
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@ -240,7 +240,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4 p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%dprcparm(mld_aggr_damp_) = 4.d0/3.d0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default case default
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"' write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'

@ -570,7 +570,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
info = -1 info = -1
return return
endif endif
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%rprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = 3111 info = 3111
return return
@ -587,7 +587,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_fact_thrs_) case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
info = -2 info = -2
@ -596,7 +596,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
else if (ilev_ > 1) then else if (ilev_ > 1) then
select case(what) select case(what)
case(mld_aggr_damp_,mld_fact_thrs_) case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
info = -2 info = -2
@ -611,21 +611,21 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
select case(what) select case(what)
case(mld_fact_thrs_) case(mld_fact_thrs_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%rprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
end do end do
case(mld_aggr_damp_) case(mld_aggr_damp_)
do ilev_=2,nlev_-1 do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%rprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
end do end do
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'

@ -126,9 +126,9 @@ module mld_prec_type
! iprcparm - integer, dimension(:), allocatable. ! iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base preconditioner K(ilev) ! The integer parameters defining the base preconditioner K(ilev)
! (the iprcparm entries and values are specified below). ! (the iprcparm entries and values are specified below).
! dprcparm - real(psb_dpk_), dimension(:), allocatable. ! rprcparm - real(psb_dpk_), dimension(:), allocatable.
! The real parameters defining the base preconditioner K(ilev) ! The real parameters defining the base preconditioner K(ilev)
! (the dprcparm entries and values are specified below). ! (the rprcparm entries and values are specified below).
! perm - integer, dimension(:), allocatable. ! perm - integer, dimension(:), allocatable.
! The row and column permutations applied to the local part of ! The row and column permutations applied to the local part of
! A(ilev) (defined only if iprcparm(mld_sub_ren_)>0). ! A(ilev) (defined only if iprcparm(mld_sub_ren_)>0).
@ -164,7 +164,7 @@ module mld_prec_type
real(psb_dpk_), allocatable :: d(:) real(psb_dpk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data , desc_ac type(psb_desc_type) :: desc_data , desc_ac
integer, allocatable :: iprcparm(:) integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: dprcparm(:) real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:) integer, allocatable :: perm(:), invperm(:)
integer, allocatable :: mlia(:), nlaggr(:) integer, allocatable :: mlia(:), nlaggr(:)
type(psb_dspmat_type), pointer :: base_a => null() type(psb_dspmat_type), pointer :: base_a => null()
@ -183,7 +183,7 @@ module mld_prec_type
complex(psb_dpk_), allocatable :: d(:) complex(psb_dpk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data , desc_ac type(psb_desc_type) :: desc_data , desc_ac
integer, allocatable :: iprcparm(:) integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: dprcparm(:) real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:) integer, allocatable :: perm(:), invperm(:)
integer, allocatable :: mlia(:), nlaggr(:) integer, allocatable :: mlia(:), nlaggr(:)
type(psb_zspmat_type), pointer :: base_a => null() type(psb_zspmat_type), pointer :: base_a => null()
@ -278,12 +278,12 @@ module mld_prec_type
integer, parameter :: mld_prec_built_=98765 integer, parameter :: mld_prec_built_=98765
! !
! Entries in dprcparm: ILU(k,t) threshold, smoothed aggregation omega ! Entries in rprcparm: ILU(k,t) threshold, smoothed aggregation omega
! !
integer, parameter :: mld_fact_thrs_=1 integer, parameter :: mld_fact_thrs_=1
integer, parameter :: mld_aggr_damp_=2 integer, parameter :: mld_aggr_damp_=2
integer, parameter :: mld_aggr_thresh_=3 integer, parameter :: mld_aggr_thresh_=3
integer, parameter :: mld_dfpsz_=4 integer, parameter :: mld_rfpsz_=4
! !
! Fields for sparse matrices ensembles stored in av() ! Fields for sparse matrices ensembles stored in av()
@ -409,7 +409,7 @@ contains
end if end if
end if end if
if (allocated(prec%dprcparm)) val = val + psb_sizeof_dp * size(prec%dprcparm) if (allocated(prec%rprcparm)) val = val + psb_sizeof_dp * size(prec%rprcparm)
if (allocated(prec%d)) val = val + psb_sizeof_dp * size(prec%d) if (allocated(prec%d)) val = val + psb_sizeof_dp * size(prec%d)
if (allocated(prec%perm)) val = val + psb_sizeof_int * size(prec%perm) if (allocated(prec%perm)) val = val + psb_sizeof_int * size(prec%perm)
if (allocated(prec%invperm)) val = val + psb_sizeof_int * size(prec%invperm) if (allocated(prec%invperm)) val = val + psb_sizeof_int * size(prec%invperm)
@ -446,7 +446,7 @@ contains
end if end if
end if end if
if (allocated(prec%dprcparm)) val = val + psb_sizeof_dp * size(prec%dprcparm) if (allocated(prec%rprcparm)) val = val + psb_sizeof_dp * size(prec%rprcparm)
if (allocated(prec%d)) val = val + 2 * psb_sizeof_dp * size(prec%d) if (allocated(prec%d)) val = val + 2 * psb_sizeof_dp * size(prec%d)
if (allocated(prec%perm)) val = val + psb_sizeof_int * size(prec%perm) if (allocated(prec%perm)) val = val + psb_sizeof_int * size(prec%perm)
if (allocated(prec%invperm)) val = val + psb_sizeof_int * size(prec%invperm) if (allocated(prec%invperm)) val = val + psb_sizeof_int * size(prec%invperm)
@ -531,7 +531,7 @@ contains
case(mld_ilu_n_,mld_milu_n_) 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_) case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(mld_fact_thrs_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_) case(mld_slu_,mld_umf_,mld_sludist_)
case default case default
write(iout,*) 'Should never get here!' write(iout,*) 'Should never get here!'
@ -543,7 +543,7 @@ contains
case(mld_ilu_n_,mld_milu_n_) 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_) case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(mld_fact_thrs_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_) case(mld_slu_,mld_umf_,mld_sludist_)
case default case default
write(iout,*) 'Should never get here!' write(iout,*) 'Should never get here!'
@ -573,7 +573,7 @@ contains
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_)) & aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Damping omega: ', & write(iout,*) 'Damping omega: ', &
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_) & 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_)) & smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if end if
@ -589,7 +589,7 @@ contains
case(mld_ilu_n_,mld_milu_n_) 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_) case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(mld_fact_thrs_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_) case(mld_slu_,mld_umf_,mld_sludist_)
case default case default
write(iout,*) 'Should never get here!' write(iout,*) 'Should never get here!'
@ -657,7 +657,7 @@ contains
case(mld_ilu_n_,mld_milu_n_) 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_) case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(mld_fact_thrs_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_) case(mld_slu_,mld_umf_,mld_sludist_)
case default case default
write(iout,*) 'Should never get here!' write(iout,*) 'Should never get here!'
@ -669,7 +669,7 @@ contains
case(mld_ilu_n_,mld_milu_n_) 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_) case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(mld_fact_thrs_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_) case(mld_slu_,mld_umf_,mld_sludist_)
case default case default
write(iout,*) 'Should never get here!' write(iout,*) 'Should never get here!'
@ -699,7 +699,7 @@ contains
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_)) & aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Smoothing omega: ', & write(iout,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_) & p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Smoothing position: ',& write(iout,*) 'Smoothing position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_)) & smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if end if
@ -715,7 +715,7 @@ contains
case(mld_ilu_n_,mld_milu_n_) 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_) case(mld_ilu_t_)
write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(mld_fact_thrs_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%rprcparm(mld_fact_thrs_)
case(mld_slu_,mld_umf_,mld_sludist_) case(mld_slu_,mld_umf_,mld_sludist_)
case default case default
write(iout,*) 'Should never get here!' write(iout,*) 'Should never get here!'
@ -946,8 +946,8 @@ contains
if (allocated(p%desc_ac%matrix_data)) & if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info) & call psb_cdfree(p%desc_ac,info)
if (allocated(p%dprcparm)) then if (allocated(p%rprcparm)) then
deallocate(p%dprcparm,stat=info) deallocate(p%rprcparm,stat=info)
end if end if
! This is a pointer to something else, must not free it here. ! This is a pointer to something else, must not free it here.
nullify(p%base_a) nullify(p%base_a)
@ -1029,8 +1029,8 @@ contains
if (allocated(p%desc_ac%matrix_data)) & if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info) & call psb_cdfree(p%desc_ac,info)
if (allocated(p%dprcparm)) then if (allocated(p%rprcparm)) then
deallocate(p%dprcparm,stat=info) deallocate(p%rprcparm,stat=info)
end if end if
! This is a pointer to something else, must not free it here. ! This is a pointer to something else, must not free it here.
nullify(p%base_a) nullify(p%base_a)

@ -295,11 +295,11 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
goto 9999 goto 9999
end if end if
omega = 4.d0/(3.d0*anorm) omega = 4.d0/(3.d0*anorm)
p%dprcparm(mld_aggr_damp_) = omega p%rprcparm(mld_aggr_damp_) = omega
else if (p%iprcparm(mld_aggr_eig_) == mld_user_choice_) then else if (p%iprcparm(mld_aggr_eig_) == mld_user_choice_) then
omega = p%dprcparm(mld_aggr_damp_) omega = p%rprcparm(mld_aggr_damp_)
else if (p%iprcparm(mld_aggr_eig_) /= mld_user_choice_) then else if (p%iprcparm(mld_aggr_eig_) /= mld_user_choice_) then
info = 4001 info = 4001

@ -201,7 +201,7 @@ subroutine mld_zilu_bld(a,p,upd,info,blck)
case(0:) case(0:)
! Fill-in >= 0 ! Fill-in >= 0
call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%dprcparm(mld_fact_thrs_),& call mld_ilut_fact(p%iprcparm(mld_sub_fill_in_),p%rprcparm(mld_fact_thrs_),&
& a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck) & a, p%av(mld_l_pr_),p%av(mld_u_pr_),p%d,info,blck=blck)
end select end select
if(info/=0) then if(info/=0) then

@ -111,7 +111,7 @@
! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable. ! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base ! The integer parameters defining the base
! preconditioner K(ilev). ! preconditioner K(ilev).
! baseprecv(ilev)%dprcparm - complex(psb_dpk_), dimension(:), allocatable. ! baseprecv(ilev)%rprcparm - complex(psb_dpk_), dimension(:), allocatable.
! The real parameters defining the base preconditioner ! The real parameters defining the base preconditioner
! K(ilev). ! K(ilev).
! baseprecv(ilev)%perm - integer, dimension(:), allocatable. ! baseprecv(ilev)%perm - integer, dimension(:), allocatable.

@ -106,9 +106,9 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
case(mld_ilu_n_,mld_milu_n_) case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev) call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
case(mld_ilu_t_) case(mld_ilu_t_)
call mld_check_def(p%dprcparm(mld_fact_thrs_),'Eps',dzero,is_legal_fact_thrs) call mld_check_def(p%rprcparm(mld_fact_thrs_),'Eps',dzero,is_legal_fact_thrs)
end select end select
call mld_check_def(p%dprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega) call mld_check_def(p%rprcparm(mld_aggr_damp_),'Omega',dzero,is_legal_omega)
call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',& call mld_check_def(p%iprcparm(mld_smooth_sweeps_),'Jacobi sweeps',&
& 1,is_legal_jac_sweeps) & 1,is_legal_jac_sweeps)

@ -115,7 +115,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
@ -131,7 +131,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
@ -147,7 +147,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@ -164,7 +164,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
@ -187,7 +187,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1 ilev_ = 1
allocate(p%baseprecv(nlev_),stat=info) allocate(p%baseprecv(nlev_),stat=info)
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
@ -202,7 +202,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
do ilev_ = 2, nlev_ -1 do ilev_ = 2, nlev_ -1
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@ -219,11 +219,11 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1 p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 1
p%baseprecv(ilev_)%dprcparm(mld_aggr_damp_) = 4.d0/3.d0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
end do end do
ilev_ = nlev_ ilev_ = nlev_
if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(mld_ifpsz_,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(mld_dfpsz_,p%baseprecv(ilev_)%dprcparm,info) if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0 p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_ p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@ -240,7 +240,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_ p%baseprecv(ilev_)%iprcparm(mld_sub_solve_) = mld_ilu_n_
p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0 p%baseprecv(ilev_)%iprcparm(mld_sub_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4 p%baseprecv(ilev_)%iprcparm(mld_smooth_sweeps_) = 4
p%baseprecv(ilev_)%dprcparm(mld_aggr_damp_) = 4.d0/3.d0 p%baseprecv(ilev_)%rprcparm(mld_aggr_damp_) = 4.d0/3.d0
case default case default
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"' write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'

@ -570,7 +570,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
info = -1 info = -1
return return
endif endif
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%rprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = 3111 info = 3111
return return
@ -587,7 +587,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
! !
select case(what) select case(what)
case(mld_fact_thrs_) case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
info = -2 info = -2
@ -596,7 +596,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
else if (ilev_ > 1) then else if (ilev_ > 1) then
select case(what) select case(what)
case(mld_aggr_damp_,mld_fact_thrs_) case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'
info = -2 info = -2
@ -611,21 +611,21 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
select case(what) select case(what)
case(mld_fact_thrs_) case(mld_fact_thrs_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%rprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
end do end do
case(mld_aggr_damp_) case(mld_aggr_damp_)
do ilev_=2,nlev_-1 do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then if (.not.allocated(p%baseprecv(ilev_)%rprcparm)) then
write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT' write(0,*) name,': Error: Uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1 info = -1
return return
endif endif
p%baseprecv(ilev_)%dprcparm(what) = val p%baseprecv(ilev_)%rprcparm(what) = val
end do end do
case default case default
write(0,*) name,': Error: invalid WHAT' write(0,*) name,': Error: invalid WHAT'

Loading…
Cancel
Save