fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
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.
This commit is contained in:
Salvatore Filippone
2008-03-27 11:12:43 +00:00
parent 61460bde96
commit 5c7ed88574
14 changed files with 69 additions and 69 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/Makefile
+1 -1
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)
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
lib: mpobjs $(OBJS)
mlprec/mld_daggrmat_smth_asb.F90
+2 -2
View File
@@ -295,11 +295,11 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
goto 9999
end if
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
omega = p%dprcparm(mld_aggr_damp_)
omega = p%rprcparm(mld_aggr_damp_)
else if (p%iprcparm(mld_aggr_eig_) /= mld_user_choice_) then
info = 4001
mlprec/mld_dilu_bld.f90
+1 -1
View File
@@ -201,7 +201,7 @@ subroutine mld_dilu_bld(a,p,upd,info,blck)
case(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)
end select
if(info/=0) then
mlprec/mld_dmlprec_aply.f90
+1 -1
View File
@@ -111,7 +111,7 @@
! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base
! 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
! K(ilev).
! baseprecv(ilev)%perm - integer, dimension(:), allocatable.
mlprec/mld_dmlprec_bld.f90
+2 -2
View File
@@ -106,9 +106,9 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
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
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',&
& 1,is_legal_jac_sweeps)
mlprec/mld_dprecinit.f90
+9 -9
View File
@@ -115,7 +115,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
@@ -131,7 +131,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
@@ -147,7 +147,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@@ -164,7 +164,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
@@ -187,7 +187,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
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
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
p%baseprecv(ilev_)%iprcparm(:) = 0
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_fill_in_) = 0
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
ilev_ = nlev_
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
p%baseprecv(ilev_)%iprcparm(:) = 0
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_fill_in_) = 0
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
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'
mlprec/mld_dprecset.f90
+7 -7
View File
@@ -570,7 +570,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
info = -1
return
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'
info = 3111
return
@@ -587,7 +587,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
!
select case(what)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@@ -596,7 +596,7 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@@ -611,21 +611,21 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
select case(what)
case(mld_fact_thrs_)
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'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
end do
case(mld_aggr_damp_)
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'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
end do
case default
write(0,*) name,': Error: invalid WHAT'
mlprec/mld_prec_type.f90
+24 -24
View File
@@ -126,9 +126,9 @@ module mld_prec_type
! iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base preconditioner K(ilev)
! (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 dprcparm entries and values are specified below).
! (the rprcparm entries and values are specified below).
! perm - integer, dimension(:), allocatable.
! The row and column permutations applied to the local part of
! A(ilev) (defined only if iprcparm(mld_sub_ren_)>0).
@@ -161,15 +161,15 @@ module mld_prec_type
type mld_dbaseprc_type
type(psb_dspmat_type), allocatable :: av(:)
real(psb_dpk_), allocatable :: d(:)
real(psb_dpk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data , desc_ac
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: dprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:)
integer, allocatable :: mlia(:), nlaggr(:)
type(psb_dspmat_type), pointer :: base_a => 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
end type mld_dbaseprc_type
@@ -180,15 +180,15 @@ module mld_prec_type
type mld_zbaseprc_type
type(psb_zspmat_type), allocatable :: av(:)
complex(psb_dpk_), allocatable :: d(:)
complex(psb_dpk_), allocatable :: d(:)
type(psb_desc_type) :: desc_data , desc_ac
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: dprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
integer, allocatable :: perm(:), invperm(:)
integer, allocatable :: mlia(:), nlaggr(:)
type(psb_zspmat_type), pointer :: base_a => 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
end type mld_zbaseprc_type
@@ -278,12 +278,12 @@ module mld_prec_type
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_aggr_damp_=2
integer, parameter :: mld_aggr_thresh_=3
integer, parameter :: mld_dfpsz_=4
integer, parameter :: mld_rfpsz_=4
!
! Fields for sparse matrices ensembles stored in av()
@@ -409,7 +409,7 @@ contains
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%perm)) val = val + psb_sizeof_int * size(prec%perm)
if (allocated(prec%invperm)) val = val + psb_sizeof_int * size(prec%invperm)
@@ -446,7 +446,7 @@ contains
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%perm)) val = val + psb_sizeof_int * size(prec%perm)
if (allocated(prec%invperm)) val = val + psb_sizeof_int * size(prec%invperm)
@@ -531,7 +531,7 @@ contains
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
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 default
write(iout,*) 'Should never get here!'
@@ -543,7 +543,7 @@ contains
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
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 default
write(iout,*) 'Should never get here!'
@@ -573,7 +573,7 @@ contains
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Damping omega: ', &
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_)
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Multilevel smoother position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if
@@ -589,7 +589,7 @@ contains
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
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 default
write(iout,*) 'Should never get here!'
@@ -657,7 +657,7 @@ contains
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
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 default
write(iout,*) 'Should never get here!'
@@ -669,7 +669,7 @@ contains
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
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 default
write(iout,*) 'Should never get here!'
@@ -699,7 +699,7 @@ contains
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_)
& p%baseprecv(ilev)%rprcparm(mld_aggr_damp_)
write(iout,*) 'Smoothing position: ',&
& smooth_names(p%baseprecv(ilev)%iprcparm(mld_smooth_pos_))
end if
@@ -715,7 +715,7 @@ contains
case(mld_ilu_n_,mld_milu_n_)
write(iout,*) 'Fill level:',p%baseprecv(ilev)%iprcparm(mld_sub_fill_in_)
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 default
write(iout,*) 'Should never get here!'
@@ -946,8 +946,8 @@ contains
if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info)
if (allocated(p%dprcparm)) then
deallocate(p%dprcparm,stat=info)
if (allocated(p%rprcparm)) then
deallocate(p%rprcparm,stat=info)
end if
! This is a pointer to something else, must not free it here.
nullify(p%base_a)
@@ -1029,8 +1029,8 @@ contains
if (allocated(p%desc_ac%matrix_data)) &
& call psb_cdfree(p%desc_ac,info)
if (allocated(p%dprcparm)) then
deallocate(p%dprcparm,stat=info)
if (allocated(p%rprcparm)) then
deallocate(p%rprcparm,stat=info)
end if
! This is a pointer to something else, must not free it here.
nullify(p%base_a)
mlprec/mld_zaggrmat_smth_asb.F90
+2 -2
View File
@@ -295,11 +295,11 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
goto 9999
end if
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
omega = p%dprcparm(mld_aggr_damp_)
omega = p%rprcparm(mld_aggr_damp_)
else if (p%iprcparm(mld_aggr_eig_) /= mld_user_choice_) then
info = 4001
mlprec/mld_zilu_bld.f90
+1 -1
View File
@@ -201,7 +201,7 @@ subroutine mld_zilu_bld(a,p,upd,info,blck)
case(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)
end select
if(info/=0) then
mlprec/mld_zmlprec_aply.f90
+1 -1
View File
@@ -111,7 +111,7 @@
! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base
! 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
! K(ilev).
! baseprecv(ilev)%perm - integer, dimension(:), allocatable.
mlprec/mld_zmlprec_bld.f90
+2 -2
View File
@@ -106,9 +106,9 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
case(mld_ilu_n_,mld_milu_n_)
call mld_check_def(p%iprcparm(mld_sub_fill_in_),'Level',0,is_legal_ml_lev)
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
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',&
& 1,is_legal_jac_sweeps)
mlprec/mld_zprecinit.f90
+9 -9
View File
@@ -115,7 +115,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_noprec_
@@ -131,7 +131,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_diag_
@@ -147,7 +147,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_bjac_
@@ -164,7 +164,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
p%baseprecv(ilev_)%iprcparm(mld_prec_type_) = mld_as_
@@ -187,7 +187,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
ilev_ = 1
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_dfpsz_,p%baseprecv(ilev_)%dprcparm,info)
if (info == 0) call psb_realloc(mld_rfpsz_,p%baseprecv(ilev_)%rprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
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
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
p%baseprecv(ilev_)%iprcparm(:) = 0
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_fill_in_) = 0
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
ilev_ = nlev_
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
p%baseprecv(ilev_)%iprcparm(:) = 0
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_fill_in_) = 0
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
write(0,*) name,': Warning: Unknown preconditioner type request "',ptype,'"'
mlprec/mld_zprecset.f90
+7 -7
View File
@@ -570,7 +570,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
info = -1
return
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'
info = 3111
return
@@ -587,7 +587,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
!
select case(what)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@@ -596,7 +596,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
case default
write(0,*) name,': Error: invalid WHAT'
info = -2
@@ -611,21 +611,21 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
select case(what)
case(mld_fact_thrs_)
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'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
end do
case(mld_aggr_damp_)
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'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
p%baseprecv(ilev_)%rprcparm(what) = val
end do
case default
write(0,*) name,': Error: invalid WHAT'