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

mld2p4-dev:

Browse Source 
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
14 changed files with 69 additions and 69 deletions
Show Stats Download Patch File Download Diff File

2
mlprec/Makefile
Unescape Escape View File

@ -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)

4
mlprec/mld_daggrmat_smth_asb.F90
Unescape Escape View File

@ -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

2
mlprec/mld_dilu_bld.f90
Unescape Escape View File

@ -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

2
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -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.

4
mlprec/mld_dmlprec_bld.f90
Unescape Escape View File

@ -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)

18
mlprec/mld_dprecinit.f90
Unescape Escape View File

@ -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,'"'

14
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -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'

48
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -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).
@ -161,15 +161,15 @@ module mld_prec_type
type mld_dbaseprc_type type mld_dbaseprc_type
type(psb_dspmat_type), allocatable :: av(:) type(psb_dspmat_type), allocatable :: av(:)
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()
type(psb_desc_type), pointer :: base_desc => null() type(psb_desc_type), pointer :: base_desc => null()
real(psb_dpk_), allocatable :: dorig(:) real(psb_dpk_), allocatable :: dorig(:)
type(psb_inter_desc_type) :: map_desc type(psb_inter_desc_type) :: map_desc
end type mld_dbaseprc_type end type mld_dbaseprc_type
@ -180,15 +180,15 @@ module mld_prec_type
type mld_zbaseprc_type type mld_zbaseprc_type
type(psb_zspmat_type), allocatable :: av(:) type(psb_zspmat_type), allocatable :: av(:)
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()
type(psb_desc_type), pointer :: base_desc => null() type(psb_desc_type), pointer :: base_desc => null()
complex(psb_dpk_), allocatable :: dorig(:) complex(psb_dpk_), allocatable :: dorig(:)
type(psb_inter_desc_type) :: map_desc type(psb_inter_desc_type) :: map_desc
end type mld_zbaseprc_type end type mld_zbaseprc_type
@ -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)

4
mlprec/mld_zaggrmat_smth_asb.F90
Unescape Escape View File

@ -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

2
mlprec/mld_zilu_bld.f90
Unescape Escape View File

@ -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

2
mlprec/mld_zmlprec_aply.f90
Unescape Escape View File

@ -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.

4
mlprec/mld_zmlprec_bld.f90
Unescape Escape View File

@ -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)

18
mlprec/mld_zprecinit.f90
Unescape Escape View File

@ -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,'"'

14
mlprec/mld_zprecset.f90
Unescape Escape View File

@ -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'

Write Preview
Loading…
Cancel
Save