mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
Changed names mld_aggr_kind_ into mld_smooth_kind_ and fixed all files.
This commit is contained in:
@@ -49,7 +49,7 @@
|
||||
! A mapping from the nodes of the adjacency graph of A to the nodes of the
|
||||
! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine.
|
||||
! The prolongator P_C is built here from this mapping, according to the
|
||||
! value of p%iprcparm(mld_aggr_kind_), specified by the user through
|
||||
! value of p%iprcparm(mld_smooth_kind_), specified by the user through
|
||||
! mld_dprecinit and mld_dprecset.
|
||||
!
|
||||
! Currently three different prolongators are implemented, corresponding to
|
||||
@@ -120,7 +120,7 @@ subroutine mld_daggrmat_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
call psb_info(ictxt, me, np)
|
||||
|
||||
select case (p%iprcparm(mld_aggr_kind_))
|
||||
select case (p%iprcparm(mld_smooth_kind_))
|
||||
case (mld_no_smooth_)
|
||||
|
||||
call mld_aggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
@@ -169,8 +169,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
naggrm1 = sum(p%nlaggr(1:me))
|
||||
naggrp1 = sum(p%nlaggr(1:me+1))
|
||||
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
|
||||
& ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
|
||||
ml_global_nmb = ( (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_).or.&
|
||||
& ( (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_).and.&
|
||||
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
|
||||
|
||||
if (ml_global_nmb) then
|
||||
@@ -263,7 +263,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
if (p%iprcparm(mld_aggr_eig_) == mld_max_norm_) then
|
||||
|
||||
if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
|
||||
if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then
|
||||
|
||||
!
|
||||
! This only works with CSR.
|
||||
@@ -380,7 +380,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Done NUMBMM 2'
|
||||
|
||||
if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
|
||||
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then
|
||||
call psb_transp(am1,am2,fmt='COO')
|
||||
nzl = am2%infoa(psb_nnz_)
|
||||
i=0
|
||||
@@ -409,13 +409,13 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'starting sphalo/ rwxtd'
|
||||
|
||||
if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
|
||||
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then
|
||||
! am2 = ((i-wDA)Ptilde)^T
|
||||
call psb_sphalo(am3,desc_a,am4,info,&
|
||||
& colcnv=.false.,rowscale=.true.)
|
||||
if (info == 0) call psb_rwextd(ncol,am3,info,b=am4)
|
||||
if (info == 0) call psb_sp_free(am4,info)
|
||||
else if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
|
||||
else if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then
|
||||
call psb_rwextd(ncol,am3,info)
|
||||
endif
|
||||
if(info /= 0) then
|
||||
@@ -438,7 +438,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
|
||||
|
||||
select case(p%iprcparm(mld_aggr_kind_))
|
||||
select case(p%iprcparm(mld_smooth_kind_))
|
||||
|
||||
case(mld_smooth_prol_)
|
||||
|
||||
|
||||
@@ -306,7 +306,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = dzero
|
||||
mlprec_wrk(ilev)%ty(:) = dzero
|
||||
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
!
|
||||
@@ -363,7 +363,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
@@ -476,7 +476,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
|
||||
if (debug_level >= psb_debug_inner_) &
|
||||
@@ -577,7 +577,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ' starting down sweep',ilev
|
||||
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_)
|
||||
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
@@ -736,7 +736,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
|
||||
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
|
||||
@@ -813,7 +813,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
!
|
||||
do ilev = nlev-1, 1, -1
|
||||
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_)
|
||||
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
@@ -957,7 +957,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
|
||||
& mlprec_wrk(ilev)%x2l(nc2l), stat=info)
|
||||
@@ -1038,7 +1038,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
!
|
||||
do ilev=nlev-1, 1, -1
|
||||
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_)
|
||||
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
|
||||
@@ -91,17 +91,16 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
|
||||
& mld_mult_ml_,is_legal_ml_type)
|
||||
call mld_check_def(p%iprcparm(mld_aggr_alg_),'Aggregation',&
|
||||
& mld_dec_aggr_,is_legal_ml_aggr_alg)
|
||||
call mld_check_def(p%iprcparm(mld_aggr_kind_),'Smoother',&
|
||||
& mld_smooth_prol_,is_legal_ml_smth_kind)
|
||||
call mld_check_def(p%iprcparm(mld_smooth_kind_),'Smoother',&
|
||||
& mld_smooth_prol_,is_legal_ml_smooth_kind)
|
||||
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
|
||||
& mld_distr_mat_,is_legal_ml_coarse_mat)
|
||||
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
|
||||
& mld_pre_smooth_,is_legal_ml_smooth_pos)
|
||||
|
||||
|
||||
!!$ nullify(p%desc_data)
|
||||
select case(p%iprcparm(mld_sub_solve_))
|
||||
case(mld_ilu_n_)
|
||||
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)
|
||||
@@ -125,7 +124,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
|
||||
!
|
||||
! Build the coarse-level matrix from the fine level one, starting from
|
||||
! the mapping defined by mld_aggrmap_bld and applying the aggregation
|
||||
! algorithm specified by p%iprcparm(mld_aggr_kind_)
|
||||
! algorithm specified by p%iprcparm(mld_smooth_kind_)
|
||||
!
|
||||
call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
if(info /= 0) then
|
||||
|
||||
@@ -210,7 +210,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
|
||||
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
|
||||
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
|
||||
@@ -231,7 +231,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
|
||||
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
|
||||
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
|
||||
|
||||
@@ -127,7 +127,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
|
||||
else if (ilev_ > 1) then
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_,mld_aggr_eig_)
|
||||
p%baseprecv(ilev_)%iprcparm(what) = val
|
||||
case(mld_coarse_mat_)
|
||||
@@ -173,7 +173,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
|
||||
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_,mld_aggr_eig_)
|
||||
do ilev_=1,nlev_-1
|
||||
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
|
||||
@@ -315,7 +315,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
|
||||
else if (ilev_ > 1) then
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
|
||||
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_,mld_aggr_eig_)
|
||||
call get_stringval(string,val,info)
|
||||
p%baseprecv(ilev_)%iprcparm(what) = val
|
||||
@@ -349,7 +349,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
|
||||
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_)
|
||||
call get_stringval(string,val,info)
|
||||
do ilev_=1,nlev_-1
|
||||
|
||||
+23
-23
@@ -207,8 +207,8 @@ module mld_prec_type
|
||||
integer, parameter :: mld_smooth_sweeps_=9
|
||||
integer, parameter :: mld_ml_type_=10
|
||||
integer, parameter :: mld_smooth_pos_=11
|
||||
integer, parameter :: mld_aggr_alg_=12
|
||||
integer, parameter :: mld_aggr_kind_=13
|
||||
integer, parameter :: mld_smooth_kind_=12
|
||||
integer, parameter :: mld_aggr_alg_=13
|
||||
integer, parameter :: mld_aggr_eig_=14
|
||||
integer, parameter :: mld_coarse_mat_=16
|
||||
!! 2 ints for 64 bit versions
|
||||
@@ -228,6 +228,15 @@ module mld_prec_type
|
||||
integer, parameter :: mld_min_prec_=0, mld_noprec_=0, mld_diag_=1, mld_bjac_=2,&
|
||||
& mld_as_=3, mld_max_prec_=3
|
||||
!
|
||||
! Legal values for entry: mld_sub_solve_
|
||||
!
|
||||
integer, parameter :: mld_f_none_=0,mld_ilu_n_=1,mld_milu_n_=2, mld_ilu_t_=3
|
||||
integer, parameter :: mld_slu_=4, mld_umf_=5, mld_sludist_=6
|
||||
!
|
||||
! Legal values for entry: mld_sub_ren_
|
||||
!
|
||||
integer, parameter :: mld_renum_none_=0, mld_renum_glb_=1, mld_renum_gps_=2
|
||||
!
|
||||
! Legal values for entry: mld_ml_type_
|
||||
!
|
||||
integer, parameter :: mld_no_ml_=0, mld_add_ml_=1, mld_mult_ml_=2
|
||||
@@ -238,10 +247,9 @@ module mld_prec_type
|
||||
integer, parameter :: mld_pre_smooth_=1, mld_post_smooth_=2,&
|
||||
& mld_twoside_smooth_=3, mld_max_smooth_=mld_twoside_smooth_
|
||||
!
|
||||
! Legal values for entry: mld_sub_solve_
|
||||
! Legal values for entry: mld_smooth_kind_
|
||||
!
|
||||
integer, parameter :: mld_f_none_=0,mld_ilu_n_=1,mld_milu_n_=2, mld_ilu_t_=3
|
||||
integer, parameter :: mld_slu_=4, mld_umf_=5, mld_sludist_=6
|
||||
integer, parameter :: mld_no_smooth_=0, mld_smooth_prol_=1, mld_biz_prol_=2
|
||||
!
|
||||
! Legal values for entry: mld_aggr_alg_
|
||||
!
|
||||
@@ -249,10 +257,6 @@ module mld_prec_type
|
||||
integer, parameter :: mld_glb_aggr_=2, mld_new_dec_aggr_=3
|
||||
integer, parameter :: mld_new_glb_aggr_=4, mld_max_aggr_=mld_new_glb_aggr_
|
||||
!
|
||||
! Legal values for entry: mld_aggr_kind_
|
||||
!
|
||||
integer, parameter :: mld_no_smooth_=0, mld_smooth_prol_=1, mld_biz_prol_=2
|
||||
!
|
||||
! Legal values for entry: mld_aggr_eig_
|
||||
!
|
||||
integer, parameter :: mld_max_norm_=0, mld_user_choice_=999
|
||||
@@ -264,10 +268,6 @@ module mld_prec_type
|
||||
! Legal values for entry: mld_prec_status_
|
||||
!
|
||||
integer, parameter :: mld_prec_built_=98765
|
||||
!
|
||||
! Legal values for entry: mld_sub_ren_
|
||||
!
|
||||
integer, parameter :: mld_renum_none_=0, mld_renum_glb_=1, mld_renum_gps_=2
|
||||
|
||||
!
|
||||
! Entries in dprcparm: ILU(k,t) threshold, smoothed aggregation omega
|
||||
@@ -565,8 +565,8 @@ contains
|
||||
write(iout,*) 'Multilevel aggregation: ', &
|
||||
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
|
||||
write(iout,*) 'Aggregation smoothing: ', &
|
||||
& smooth_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
|
||||
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
|
||||
& smooth_kinds(p%baseprecv(ilev)%iprcparm(mld_smooth_kind_))
|
||||
if (p%baseprecv(ilev)%iprcparm(mld_smooth_kind_) /= mld_no_smooth_) then
|
||||
write(iout,*) 'Damping omega: ', &
|
||||
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_)
|
||||
write(iout,*) 'Multilevel smoother position: ',&
|
||||
@@ -640,7 +640,7 @@ contains
|
||||
!!$ write(iout,*) 'Multilevel aggregation: ', &
|
||||
!!$ & aggr_names(p%baseprecv(2)%iprcparm(mld_aggr_alg_))
|
||||
!!$ write(iout,*) 'Multilevel smoothing: ', &
|
||||
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(mld_aggr_kind_))
|
||||
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(mld_smooth_kind_))
|
||||
!!$ write(iout,*) 'damping omega: ', p%baseprecv(2)%dprcparm(mld_aggr_damp_)
|
||||
!!$ write(iout,*) 'Multilevel smoother position: ',&
|
||||
!!$ & smooth_names(p%baseprecv(2)%iprcparm(mld_smooth_pos_))
|
||||
@@ -751,8 +751,8 @@ contains
|
||||
write(iout,*) 'Multilevel aggregation: ', &
|
||||
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
|
||||
write(iout,*) 'Smoother: ', &
|
||||
& smooth_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
|
||||
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
|
||||
& smooth_kinds(p%baseprecv(ilev)%iprcparm(mld_smooth_kind_))
|
||||
if (p%baseprecv(ilev)%iprcparm(mld_smooth_kind_) /= mld_no_smooth_) then
|
||||
write(iout,*) 'Smoothing omega: ', &
|
||||
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_)
|
||||
write(iout,*) 'Smoothing position: ',&
|
||||
@@ -826,7 +826,7 @@ contains
|
||||
!!$ write(iout,*) 'Multilevel aggregation: ', &
|
||||
!!$ & aggr_names(p%baseprecv(2)%iprcparm(mld_aggr_alg_))
|
||||
!!$ write(iout,*) 'Smoother: ', &
|
||||
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(mld_aggr_kind_))
|
||||
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(mld_smooth_kind_))
|
||||
!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(mld_aggr_damp_)
|
||||
!!$ write(iout,*) 'Smoothing position: ',&
|
||||
!!$ & smooth_names(p%baseprecv(2)%iprcparm(mld_smooth_pos_))
|
||||
@@ -931,14 +931,14 @@ contains
|
||||
is_legal_ml_smooth_pos = ((ip>=mld_pre_smooth_).and.(ip<=mld_max_smooth_))
|
||||
return
|
||||
end function is_legal_ml_smooth_pos
|
||||
function is_legal_ml_smth_kind(ip)
|
||||
function is_legal_ml_smooth_kind(ip)
|
||||
use psb_base_mod
|
||||
integer, intent(in) :: ip
|
||||
logical :: is_legal_ml_smth_kind
|
||||
logical :: is_legal_ml_smooth_kind
|
||||
|
||||
is_legal_ml_smth_kind = ((ip>=mld_no_smooth_).and.(ip<=mld_biz_prol_))
|
||||
is_legal_ml_smooth_kind = ((ip>=mld_no_smooth_).and.(ip<=mld_biz_prol_))
|
||||
return
|
||||
end function is_legal_ml_smth_kind
|
||||
end function is_legal_ml_smooth_kind
|
||||
function is_legal_ml_coarse_mat(ip)
|
||||
use psb_base_mod
|
||||
integer, intent(in) :: ip
|
||||
|
||||
@@ -49,7 +49,7 @@
|
||||
! A mapping from the nodes of the adjacency graph of A to the nodes of the
|
||||
! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine.
|
||||
! The prolongator P_C is built here from this mapping, according to the
|
||||
! value of p%iprcparm(mld_aggr_kind_), specified by the user through
|
||||
! value of p%iprcparm(mld_smooth_kind_), specified by the user through
|
||||
! mld_dprecinit and mld_dprecset.
|
||||
!
|
||||
! Currently three different prolongators are implemented, corresponding to
|
||||
@@ -120,7 +120,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
call psb_info(ictxt, me, np)
|
||||
|
||||
select case (p%iprcparm(mld_aggr_kind_))
|
||||
select case (p%iprcparm(mld_smooth_kind_))
|
||||
case (mld_no_smooth_)
|
||||
|
||||
call mld_aggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
@@ -169,8 +169,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
naggrm1 = sum(p%nlaggr(1:me))
|
||||
naggrp1 = sum(p%nlaggr(1:me+1))
|
||||
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
|
||||
& ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
|
||||
ml_global_nmb = ( (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_).or.&
|
||||
& ( (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_).and.&
|
||||
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
|
||||
|
||||
if (ml_global_nmb) then
|
||||
@@ -263,7 +263,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
if (p%iprcparm(mld_aggr_eig_) == mld_max_norm_) then
|
||||
|
||||
if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
|
||||
if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then
|
||||
|
||||
!
|
||||
! This only works with CSR.
|
||||
@@ -380,7 +380,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'Done NUMBMM 2'
|
||||
|
||||
if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
|
||||
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then
|
||||
call psb_transp(am1,am2,fmt='COO')
|
||||
nzl = am2%infoa(psb_nnz_)
|
||||
i=0
|
||||
@@ -409,13 +409,13 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& 'starting sphalo/ rwxtd'
|
||||
|
||||
if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
|
||||
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then
|
||||
! am2 = ((i-wDA)Ptilde)^T
|
||||
call psb_sphalo(am3,desc_a,am4,info,&
|
||||
& colcnv=.false.,rowscale=.true.)
|
||||
if (info == 0) call psb_rwextd(ncol,am3,info,b=am4)
|
||||
if (info == 0) call psb_sp_free(am4,info)
|
||||
else if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
|
||||
else if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then
|
||||
call psb_rwextd(ncol,am3,info)
|
||||
endif
|
||||
if(info /= 0) then
|
||||
@@ -438,7 +438,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
|
||||
|
||||
|
||||
select case(p%iprcparm(mld_aggr_kind_))
|
||||
select case(p%iprcparm(mld_smooth_kind_))
|
||||
|
||||
case(mld_smooth_prol_)
|
||||
|
||||
|
||||
@@ -308,7 +308,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
mlprec_wrk(ilev)%ty(:) = zzero
|
||||
|
||||
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
!
|
||||
@@ -365,7 +365,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
@@ -478,7 +478,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
|
||||
if (debug_level >= psb_debug_inner_) &
|
||||
@@ -578,7 +578,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ' starting down sweep',ilev
|
||||
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_)
|
||||
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
@@ -737,7 +737,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
|
||||
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
|
||||
@@ -814,7 +814,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
!
|
||||
do ilev = nlev-1, 1, -1
|
||||
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_)
|
||||
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
@@ -959,7 +959,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
|
||||
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
|
||||
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
|
||||
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
|
||||
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
|
||||
& mlprec_wrk(ilev)%x2l(nc2l), stat=info)
|
||||
@@ -1041,7 +1041,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
|
||||
!
|
||||
do ilev=nlev-1, 1, -1
|
||||
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
|
||||
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_)
|
||||
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
|
||||
|
||||
if (ismth /= mld_no_smooth_) then
|
||||
|
||||
@@ -91,8 +91,8 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
|
||||
& mld_mult_ml_,is_legal_ml_type)
|
||||
call mld_check_def(p%iprcparm(mld_aggr_alg_),'Aggregation',&
|
||||
& mld_dec_aggr_,is_legal_ml_aggr_alg)
|
||||
call mld_check_def(p%iprcparm(mld_aggr_kind_),'Smoother',&
|
||||
& mld_smooth_prol_,is_legal_ml_smth_kind)
|
||||
call mld_check_def(p%iprcparm(mld_smooth_kind_),'Smoother',&
|
||||
& mld_smooth_prol_,is_legal_ml_smooth_kind)
|
||||
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
|
||||
& mld_distr_mat_,is_legal_ml_coarse_mat)
|
||||
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
|
||||
@@ -101,7 +101,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
|
||||
|
||||
!!$ nullify(p%desc_data)
|
||||
select case(p%iprcparm(mld_sub_solve_))
|
||||
case(mld_ilu_n_)
|
||||
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)
|
||||
@@ -125,7 +125,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
|
||||
!
|
||||
! Build the coarse-level matrix from the fine level one, starting from
|
||||
! the mapping defined by mld_aggrmap_bld and applying the aggregation
|
||||
! algorithm specified by p%iprcparm(mld_aggr_kind_)
|
||||
! algorithm specified by p%iprcparm(mld_smooth_kind_)
|
||||
!
|
||||
call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
if(info /= 0) then
|
||||
|
||||
@@ -210,7 +210,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
|
||||
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
|
||||
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
|
||||
@@ -231,7 +231,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
|
||||
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
|
||||
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_alg_) = mld_dec_aggr_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_smooth_pos_) = mld_post_smooth_
|
||||
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_
|
||||
|
||||
@@ -127,7 +127,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
|
||||
else if (ilev_ > 1) then
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_,mld_aggr_eig_)
|
||||
p%baseprecv(ilev_)%iprcparm(what) = val
|
||||
case(mld_coarse_mat_)
|
||||
@@ -173,7 +173,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
|
||||
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_,mld_aggr_eig_)
|
||||
do ilev_=1,nlev_-1
|
||||
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
|
||||
@@ -313,7 +313,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
|
||||
else if (ilev_ > 1) then
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
|
||||
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_,mld_aggr_eig_)
|
||||
call get_stringval(string,val,info)
|
||||
p%baseprecv(ilev_)%iprcparm(what) = val
|
||||
@@ -347,7 +347,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
|
||||
|
||||
select case(what)
|
||||
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
|
||||
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,&
|
||||
& mld_smooth_pos_)
|
||||
call get_stringval(string,val,info)
|
||||
do ilev_=1,nlev_-1
|
||||
|
||||
@@ -223,7 +223,7 @@ program df_bench
|
||||
call mld_precset(pre,mld_sub_fill_in_, precs(pp)%fill2, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr2, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_smooth_kind_, precs(pp)%smthkind, info,ilev=nlev)
|
||||
else
|
||||
call mld_precinit(pre,precs(pp)%lv1,info)
|
||||
end if
|
||||
|
||||
@@ -208,7 +208,7 @@ program zf_bench
|
||||
call mld_precset(pre,mld_sub_fill_in_, precs(pp)%fill2, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_fact_thrs_, precs(pp)%thr2, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
|
||||
call mld_precset(pre,mld_smooth_kind_, precs(pp)%smthkind, info,ilev=nlev)
|
||||
else
|
||||
call mld_precinit(pre,precs(pp)%lv1,info)
|
||||
end if
|
||||
|
||||
@@ -183,7 +183,7 @@ program ppde
|
||||
call mld_precset(prec,mld_sub_fill_in_, prectype%fill2, info,ilev=prectype%nlev)
|
||||
call mld_precset(prec,mld_fact_thrs_, prectype%thr2, info,ilev=prectype%nlev)
|
||||
call mld_precset(prec,mld_smooth_sweeps_, prectype%jswp, info,ilev=prectype%nlev)
|
||||
call mld_precset(prec,mld_aggr_kind_, prectype%smthkind, info,ilev=prectype%nlev)
|
||||
call mld_precset(prec,mld_smooth_kind_, prectype%smthkind, info,ilev=prectype%nlev)
|
||||
else
|
||||
call mld_precinit(prec,prectype%lv1,info)
|
||||
endif
|
||||
|
||||
Reference in New Issue
Block a user