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

Changed structure and interface of BJAC_BLD.

Browse Source 
Changed SMOOTH_KIND into AGGR_KIND.
stopcriterion
Salvatore Filippone 17 years ago
parent f1c5dbcb3d
commit b69cc135a9
22 changed files with 272 additions and 312 deletions
Show Stats Download Patch File Download Diff File

2
Make.inc
Unescape Escape View File

@ -4,7 +4,7 @@
# must be specified here with absolute pathnames # # must be specified here with absolute pathnames #
# # # #
########################################################## ##########################################################
PSBLASDIR=$(HOME)/NUMERICAL/PSBLAS2/psblas2-dev PSBLASDIR=$(HOME)/NUMERICAL/PSBLAS2/psblas2
include $(PSBLASDIR)/Make.inc include $(PSBLASDIR)/Make.inc
########################################################## ##########################################################

4
mlprec/mld_daggrmat_asb.f90
Unescape Escape View File

@ -49,7 +49,7 @@
! A mapping from the nodes of the adjacency graph of A to the nodes of the ! 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. ! 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 ! The prolongator P_C is built here from this mapping, according to the
! value of p%iprcparm(mld_smooth_kind_), specified by the user through ! value of p%iprcparm(mld_aggr_kind_), specified by the user through
! mld_dprecinit and mld_dprecset. ! mld_dprecinit and mld_dprecset.
! !
! Currently three different prolongators are implemented, corresponding to ! 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) call psb_info(ictxt, me, np)
select case (p%iprcparm(mld_smooth_kind_)) select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_) case (mld_no_smooth_)
call mld_aggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) call mld_aggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info)

14
mlprec/mld_daggrmat_smth_asb.F90
Unescape Escape View File

@ -169,8 +169,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
naggrm1 = sum(p%nlaggr(1:me)) naggrm1 = sum(p%nlaggr(1:me))
naggrp1 = sum(p%nlaggr(1:me+1)) naggrp1 = sum(p%nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_).or.& ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_).and.& & ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) ) & (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
if (ml_global_nmb) then 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_eig_) == mld_max_norm_) then
if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
! !
! This only works with CSR. ! 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),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2' & 'Done NUMBMM 2'
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
call psb_transp(am1,am2,fmt='COO') call psb_transp(am1,am2,fmt='COO')
nzl = am2%infoa(psb_nnz_) nzl = am2%infoa(psb_nnz_)
i=0 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),& & write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd' & 'starting sphalo/ rwxtd'
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
! am2 = ((i-wDA)Ptilde)^T ! am2 = ((i-wDA)Ptilde)^T
call psb_sphalo(am3,desc_a,am4,info,& call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) & colcnv=.false.,rowscale=.true.)
if (info == 0) call psb_rwextd(ncol,am3,info,b=am4) if (info == 0) call psb_rwextd(ncol,am3,info,b=am4)
if (info == 0) call psb_sp_free(am4,info) if (info == 0) call psb_sp_free(am4,info)
else if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then else if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
call psb_rwextd(ncol,am3,info) call psb_rwextd(ncol,am3,info)
endif endif
if(info /= 0) then 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_smooth_kind_)) select case(p%iprcparm(mld_aggr_kind_))
case(mld_smooth_prol_) case(mld_smooth_prol_)

73
mlprec/mld_das_bld.f90
Unescape Escape View File

@ -45,29 +45,16 @@
! !
! !
! Arguments: ! Arguments:
! ptype - integer, input.
! The type of preconditioner to be built. Only the values
! mld_bjac_ and mld_as_ (see mld_prec_type.f90) are allowed.
! novr - integer, input.
! The number of overlap layers in the AS preconditioner.
! a - type(psb_dspmat_type), input. ! a - type(psb_dspmat_type), input.
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! matrix to be preconditioned. ! matrix to be preconditioned.
! blk - type(psb_dspmat_type), output. ! desc_a - type(psb_desc_type), input.
! The sparse matrix structure containing the remote rows that
! extend the local matrix according to novr. If novr = 0 then
! blk does not contain any row.
! desc_data - type(psb_desc_type), input.
! The communication descriptor of the sparse matrix a. ! The communication descriptor of the sparse matrix a.
! desc_p - type(psb_desc_type), output. ! p - type(mld_dbaseprc_type), input/output.
! The communication descriptor associated to the extended ! The 'base preconditioner' data structure containing the local
! matrices that form the AS preconditioner. ! part of the preconditioner or solver to be built.
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! outfmt - character(len=5), optional.
! The storage format of the local extended matrix for the AS
! preconditioner. Currently outfmt is set to 'CSR' by the
! calling routine mld_bjac_bld.
! !
subroutine mld_das_bld(a,desc_a,p,upd,info) subroutine mld_das_bld(a,desc_a,p,upd,info)
@ -76,7 +63,6 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
Implicit None Implicit None
! Arguments
! Arguments ! Arguments
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a Type(psb_desc_type), Intent(in) :: desc_a
@ -84,13 +70,13 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer, intent(out) :: info
integer :: ptype,novr
! Local variables ! Local variables
integer icomm integer :: ptype,novr
integer :: icomm
Integer :: np,me,nnzero,& Integer :: np,me,nnzero,&
& ictxt, n_col,int_err(5),& & ictxt, n_col,int_err(5),&
& tot_recv, n_row,nhalo, nrow_a,err_act, data_ & tot_recv, n_row,nhalo, nrow_a,err_act, data_
type(psb_dspmat_type) :: blck
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -154,9 +140,18 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0' & 'Early return: P>=3 N_OVR=0'
endif endif
call psb_sp_all(0,0,blck,1,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
blck%fida = 'COO'
blck%infoa(psb_nnz_) = 0
else else
data_ = psb_comm_ext_
If (upd == 'F') Then If (upd == 'F') Then
! !
! Build the auxiliary descriptor desc_p%matrix_data(psb_n_row_). ! Build the auxiliary descriptor desc_p%matrix_data(psb_n_row_).
@ -167,6 +162,11 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
! a descriptor for an extended stencil in a PDE solver. ! a descriptor for an extended stencil in a PDE solver.
! !
call psb_cdbldext(a,desc_a,novr,p%desc_data,info,extype=psb_ovt_asov_) call psb_cdbldext(a,desc_a,novr,p%desc_data,info,extype=psb_ovt_asov_)
if(debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ' From cdbldext _:',p%desc_data%matrix_data(psb_n_row_),&
& p%desc_data%matrix_data(psb_n_col_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_cdbldext' ch_err='psb_cdbldext'
@ -175,14 +175,33 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
end if end if
Endif Endif
End if if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo ',blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
if(debug_level >= psb_debug_outer_) & !
! Retrieve the remote sparse matrix rows required for the AS extended
! matrix
data_ = psb_comm_ext_
Call psb_sphalo(a,p%desc_data,blck,info,data=data_,rowscale=.true.)
if (info /= 0) then
info=4010
ch_err='psb_sphalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' From cdbldext _:',p%desc_data%matrix_data(psb_n_row_),& & 'After psb_sphalo ',&
& p%desc_data%matrix_data(psb_n_col_) & blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
End if
call mld_bjac_bld(a,p,upd,info,blck=blck)
call mld_bjac_bld(a,p,upd,info,data=data_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='mld_bjac_bld' ch_err='mld_bjac_bld'

112
mlprec/mld_dbjac_bld.f90
Unescape Escape View File

@ -39,21 +39,21 @@
! Subroutine: mld_dbjac_bld ! Subroutine: mld_dbjac_bld
! Version: real ! Version: real
! !
! This routine builds the local extended matrix associated to an Additive ! This routine computes an LU or incomplete LU factorization
! Schwarz preconditioner and computes an LU or incomplete LU factorization ! of the input matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! of this matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! set by the user through mld_dprecinit or mld_dprecset. ! set by the user through mld_dprecinit or mld_dprecset.
! Alternatively, it splits the local matrix into its block-diagonal and ! It may also split the local matrix into its block-diagonal and
! off block-diagonal parts, for the future application of multiple ! off block-diagonal parts, for the future application of multiple
! block-Jacobi sweeps. ! block-Jacobi sweeps.
! !
! This routine is used by mld_dbaseprec_bld, to build a 'base' block-Jacobi or ! This routine is used by mld_dbaseprec_bld, to build a 'base' block-Jacobi or
! Additive Schwarz (AS) preconditioner at any level of a multilevel preconditioner, ! Additive Schwarz (AS) preconditioner at any level of a multilevel preconditioner,
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel ! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. More precisely, the routine is used to perform one of the ! preconditioner. For the Additive Schwarz, it is called from mld_as_bld,
! following tasks: ! which prepares the overlap descriptor and retrieves the remote rows into blck.
! More precisely, the routine performs one of the following tasks:
! !
! 1. construction of a block-Jacobi or Additive Schwarz preconditioner associated ! 1. construction of a block-Jacobi preconditioner associated
! to a matrix A distributed among the processes (allowed at any level); ! to a matrix A distributed among the processes (allowed at any level);
! !
! 2. setup of block-Jacobi sweeps to compute an approximate solution of a ! 2. setup of block-Jacobi sweeps to compute an approximate solution of a
@ -75,8 +75,8 @@
! - ILU(k,t), i.e. ILU with threshold (i.e. drop tolerance) t and k additional ! - ILU(k,t), i.e. ILU with threshold (i.e. drop tolerance) t and k additional
! entries in each row of the L and U factors with respect to the initial ! entries in each row of the L and U factors with respect to the initial
! sparsity pattern; ! sparsity pattern;
! - LU implemented in SuperLU version 3.0; ! - serial LU implemented in SuperLU version 3.0;
! - LU implemented in UMFPACK version 4.4; ! - serial LU implemented in UMFPACK version 4.4;
! - distributed LU implemented in SuperLU_DIST version 2.0. ! - distributed LU implemented in SuperLU_DIST version 2.0.
! !
! !
@ -90,14 +90,13 @@
! !
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! data - integer Which index list in desc_a should be used to retrieve ! blck - type(psb_dspmat_type), input, optional.
! rows, default psb_comm_halo_ ! The sparse matrix structure containing the remote rows of the
! psb_no_comm_ don't retrieve remote rows ! matrix to be factorized, that have been retrieved by mld_as_bld
! psb_comm_halo_ use halo_index ! to build an Additive Schwarz base preconditioner with overlap
! psb_comm_ext_ use ext_index ! greater than 0. If the overlap is 0 blck is empty.
! psb_comm_ovrl_ DISABLED for this routine.
! !
subroutine mld_dbjac_bld(a,p,upd,info,data) subroutine mld_dbjac_bld(a,p,upd,info,blck)
use psb_base_mod use psb_base_mod
use mld_prec_mod, mld_protect_name => mld_dbjac_bld use mld_prec_mod, mld_protect_name => mld_dbjac_bld
@ -109,15 +108,16 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
type(mld_dbaseprc_type), intent(inout) :: p type(mld_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(in), optional :: data type(psb_dspmat_type), intent(in), target, optional :: blck
! Local Variables ! Local Variables
integer :: i, k, m integer :: i, k, m
integer :: int_err(5) integer :: int_err(5)
character :: trans, unitd character :: trans, unitd
type(psb_dspmat_type) :: blck, atmp type(psb_dspmat_type), pointer :: blck_
type(psb_dspmat_type) :: atmp
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
integer :: err_act, n_row, nrow_a,n_col, data_ integer :: err_act, n_row, nrow_a,n_col
integer :: ictxt,np,me integer :: ictxt,np,me
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -140,65 +140,22 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
endif endif
trans = 'N' trans = 'N'
unitd = 'U' unitd = 'U'
if (p%iprcparm(mld_n_ovr_) < 0) then
info = 11
int_err(1) = 1
int_err(2) = p%iprcparm(mld_n_ovr_)
call psb_errpush(info,name,i_err=int_err)
goto 9999
endif
call psb_nullify_sp(blck)
call psb_nullify_sp(atmp)
if (debug_level >= psb_debug_outer_) & if (present(blck)) then
& write(debug_unit,*) me,' ',trim(name),': Start',& blck_ => blck
& p%iprcparm(mld_prec_type_),p%iprcparm(mld_n_ovr_)
if (present(data)) then
data_ = data
else else
data_ = psb_no_comm_ allocate(blck_,stat=info)
end if if (info ==0) call psb_sp_all(0,0,blck_,1,info)
select case (data_)
case(psb_no_comm_)
If (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ' calling allocate novr=0'
call psb_sp_all(0,0,blck,1,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
blck%fida = 'COO' blck_%fida = 'COO'
blck%infoa(psb_nnz_) = 0 blck_%infoa(psb_nnz_) = 0
case(psb_comm_halo_,psb_comm_ext_)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo ',blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
Call psb_sphalo(a,p%desc_data,blck,info,data=data_,rowscale=.true.)
if (info /= 0) then
info=4010
ch_err='psb_sphalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if end if
call psb_nullify_sp(atmp)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'After psb_sphalo ',&
& blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
case default
info=35
call psb_errpush(info,name,i_err=(/5,data,0,0,0/))
goto 9999
end select
! !
! Treat separately the case the local matrix has to be reordered ! Treat separately the case the local matrix has to be reordered
@ -216,7 +173,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
! according to the value of p%iprcparm(sub_ren_). The reordered ! according to the value of p%iprcparm(sub_ren_). The reordered
! matrix is stored into atmp, using the COO format. ! matrix is stored into atmp, using the COO format.
! !
call mld_sp_renum(a,blck,p,atmp,info) call mld_sp_renum(a,blck_,p,atmp,info)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='mld_sp_renum') call psb_errpush(4010,name,a_err='mld_sp_renum')
goto 9999 goto 9999
@ -250,7 +207,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
end if end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' Factoring rows ',& & write(debug_unit,*) me,' ',trim(name),' Factoring rows ',&
& atmp%m,a%m,blck%m,atmp%ia2(atmp%m+1)-1 & atmp%m,a%m,blck_%m,atmp%ia2(atmp%m+1)-1
! !
! Compute a factorization of the diagonal block of the local matrix, ! Compute a factorization of the diagonal block of the local matrix,
@ -345,7 +302,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
! given that the output from CLIP is in COO. ! given that the output from CLIP is in COO.
call psb_sp_clip(a,p%av(mld_ap_nd_),info,& call psb_sp_clip(a,p%av(mld_ap_nd_),info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_sp_clip(blck,atmp,info,& if (info == 0) call psb_sp_clip(blck_,atmp,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_rwextd(n_row,p%av(mld_ap_nd_),info,b=atmp) if (info == 0) call psb_rwextd(n_row,p%av(mld_ap_nd_),info,b=atmp)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,& if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,&
@ -386,7 +343,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
! !
! Compute the incomplete LU factorization. ! Compute the incomplete LU factorization.
! !
call mld_ilu_bld(a,p,upd,info,blck=blck) call mld_ilu_bld(a,p,upd,info,blck=blck_)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='mld_ilu_bld') call psb_errpush(4010,name,a_err='mld_ilu_bld')
goto 9999 goto 9999
@ -399,7 +356,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
n_row = psb_cd_get_local_rows(p%desc_data) n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
call psb_spcnv(a,atmp,info,afmt='coo') call psb_spcnv(a,atmp,info,afmt='coo')
if (info == 0) call psb_rwextd(n_row,atmp,info,b=blck) if (info == 0) call psb_rwextd(n_row,atmp,info,b=blck_)
! !
! Compute the LU factorization. ! Compute the LU factorization.
@ -449,7 +406,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
n_row = psb_cd_get_local_rows(p%desc_data) n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
call psb_rwextd(n_row,atmp,info,b=blck) call psb_rwextd(n_row,atmp,info,b=blck_)
! !
! Compute the LU factorization. ! Compute the LU factorization.
@ -490,11 +447,14 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
goto 9999 goto 9999
end select end select
call psb_sp_free(blck,info) if (.not.present(blck)) then
call psb_sp_free(blck_,info)
if (info == 0) deallocate(blck_)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free') call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999 goto 9999
end if end if
end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),'End ' & write(debug_unit,*) me,' ',trim(name),'End '

18
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -223,7 +223,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! each level) ! each level)
! !
! Pre/post-smoothing versions. ! Pre/post-smoothing versions.
! Note that transpose switches pre <-> post. ! Note that the transpose switches pre <-> post.
! !
select case(baseprecv(2)%iprcparm(mld_smooth_pos_)) select case(baseprecv(2)%iprcparm(mld_smooth_pos_))
@ -415,7 +415,7 @@ contains
mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = dzero mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = dzero
mlprec_wrk(ilev)%ty(:) = dzero mlprec_wrk(ilev)%ty(:) = dzero
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
! !
@ -472,7 +472,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
@ -669,7 +669,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
@ -746,7 +746,7 @@ contains
! !
do ilev = nlev-1, 1, -1 do ilev = nlev-1, 1, -1
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
@ -912,7 +912,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
@ -1013,7 +1013,7 @@ contains
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' starting down sweep',ilev & ' starting down sweep',ilev
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
@ -1240,7 +1240,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
@ -1321,7 +1321,7 @@ contains
! !
do ilev=nlev-1, 1, -1 do ilev=nlev-1, 1, -1
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then

6
mlprec/mld_dmlprec_bld.f90
Unescape Escape View File

@ -91,8 +91,8 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_type)
call mld_check_def(p%iprcparm(mld_aggr_alg_),'Aggregation',& call mld_check_def(p%iprcparm(mld_aggr_alg_),'Aggregation',&
& mld_dec_aggr_,is_legal_ml_aggr_alg) & mld_dec_aggr_,is_legal_ml_aggr_alg)
call mld_check_def(p%iprcparm(mld_smooth_kind_),'Smoother',& call mld_check_def(p%iprcparm(mld_aggr_kind_),'Smoother',&
& mld_smooth_prol_,is_legal_ml_smooth_kind) & mld_smooth_prol_,is_legal_ml_aggr_kind)
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',& call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',& call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
@ -124,7 +124,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
! !
! Build the coarse-level matrix from the fine level one, starting from ! Build the coarse-level matrix from the fine level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_smooth_kind_) ! algorithm specified by p%iprcparm(mld_aggr_kind_)
! !
call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info) call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info)
if(info /= 0) then if(info /= 0) then

4
mlprec/mld_dprecinit.f90
Unescape Escape View File

@ -210,7 +210,7 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_ 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_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_ p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ 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_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ 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_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_ 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_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_ p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ 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_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_

8
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then else if (ilev_ > 1) then
select case(what) 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_,& 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_smooth_kind_,& & mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_) & mld_smooth_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
@ -173,7 +173,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
select case(what) 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_,& 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_smooth_kind_,& & mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_) & mld_smooth_pos_,mld_aggr_eig_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then 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 else if (ilev_ > 1) then
select case(what) select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,& & mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_) & mld_smooth_pos_,mld_aggr_eig_)
call get_stringval(string,val,info) call get_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
@ -349,7 +349,7 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
select case(what) select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,& 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_smooth_kind_,& & mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_) & mld_smooth_pos_)
call get_stringval(string,val,info) call get_stringval(string,val,info)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1

12
mlprec/mld_prec_mod.f90
Unescape Escape View File

@ -394,23 +394,23 @@ module mld_prec_mod
end interface end interface
interface mld_bjac_bld interface mld_bjac_bld
subroutine mld_dbjac_bld(a,p,upd,info,data) subroutine mld_dbjac_bld(a,p,upd,info,blck)
use psb_base_mod use psb_base_mod
use mld_prec_type use mld_prec_type
type(psb_dspmat_type), intent(in), target :: a type(psb_dspmat_type), intent(in), target :: a
type(mld_dbaseprc_type), intent(inout) :: p type(mld_dbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: data character, intent(in) :: upd
type(psb_dspmat_type), intent(in), target, optional :: blck
end subroutine mld_dbjac_bld end subroutine mld_dbjac_bld
subroutine mld_zbjac_bld(a,p,upd,info,data) subroutine mld_zbjac_bld(a,p,upd,info,blck)
use psb_base_mod use psb_base_mod
use mld_prec_type use mld_prec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a type(psb_zspmat_type), intent(in), target :: a
type(mld_zbaseprc_type), intent(inout) :: p type(mld_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(in), optional :: data type(psb_zspmat_type), intent(in), target, optional :: blck
end subroutine mld_zbjac_bld end subroutine mld_zbjac_bld
end interface end interface

26
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -207,7 +207,7 @@ module mld_prec_type
integer, parameter :: mld_smooth_sweeps_=9 integer, parameter :: mld_smooth_sweeps_=9
integer, parameter :: mld_ml_type_=10 integer, parameter :: mld_ml_type_=10
integer, parameter :: mld_smooth_pos_=11 integer, parameter :: mld_smooth_pos_=11
integer, parameter :: mld_smooth_kind_=12 integer, parameter :: mld_aggr_kind_=12
integer, parameter :: mld_aggr_alg_=13 integer, parameter :: mld_aggr_alg_=13
integer, parameter :: mld_aggr_eig_=14 integer, parameter :: mld_aggr_eig_=14
integer, parameter :: mld_coarse_mat_=16 integer, parameter :: mld_coarse_mat_=16
@ -247,7 +247,7 @@ module mld_prec_type
integer, parameter :: mld_pre_smooth_=1, mld_post_smooth_=2,& integer, parameter :: mld_pre_smooth_=1, mld_post_smooth_=2,&
& mld_twoside_smooth_=3, mld_max_smooth_=mld_twoside_smooth_ & mld_twoside_smooth_=3, mld_max_smooth_=mld_twoside_smooth_
! !
! Legal values for entry: mld_smooth_kind_ ! Legal values for entry: mld_aggr_kind_
! !
integer, parameter :: mld_no_smooth_=0, mld_smooth_prol_=1, mld_biz_prol_=2 integer, parameter :: mld_no_smooth_=0, mld_smooth_prol_=1, mld_biz_prol_=2
! !
@ -291,7 +291,7 @@ module mld_prec_type
& smooth_names(1:3)=(/'Pre-smoothing ','Post-smoothing',& & smooth_names(1:3)=(/'Pre-smoothing ','Post-smoothing',&
& 'Smooth both '/) & 'Smooth both '/)
character(len=15), parameter, private :: & character(len=15), parameter, private :: &
& smooth_kinds(0:2)=(/'No smoother ','Omega smoother',& & aggr_kinds(0:2)=(/'No smoother ','Omega smoother',&
& 'Bizr. smoother'/) & 'Bizr. smoother'/)
character(len=15), parameter, private :: & character(len=15), parameter, private :: &
& matrix_names(0:1)=(/'Distributed ','Replicated '/) & matrix_names(0:1)=(/'Distributed ','Replicated '/)
@ -565,8 +565,8 @@ contains
write(iout,*) 'Multilevel aggregation: ', & write(iout,*) 'Multilevel aggregation: ', &
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_)) & aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
write(iout,*) 'Aggregation smoothing: ', & write(iout,*) 'Aggregation smoothing: ', &
& smooth_kinds(p%baseprecv(ilev)%iprcparm(mld_smooth_kind_)) & aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_smooth_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)%dprcparm(mld_aggr_damp_)
write(iout,*) 'Multilevel smoother position: ',& write(iout,*) 'Multilevel smoother position: ',&
@ -640,7 +640,7 @@ contains
!!$ write(iout,*) 'Multilevel aggregation: ', & !!$ write(iout,*) 'Multilevel aggregation: ', &
!!$ & aggr_names(p%baseprecv(2)%iprcparm(mld_aggr_alg_)) !!$ & aggr_names(p%baseprecv(2)%iprcparm(mld_aggr_alg_))
!!$ write(iout,*) 'Multilevel smoothing: ', & !!$ write(iout,*) 'Multilevel smoothing: ', &
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(mld_smooth_kind_)) !!$ & aggr_kinds(p%baseprecv(2)%iprcparm(mld_aggr_kind_))
!!$ write(iout,*) 'damping omega: ', p%baseprecv(2)%dprcparm(mld_aggr_damp_) !!$ write(iout,*) 'damping omega: ', p%baseprecv(2)%dprcparm(mld_aggr_damp_)
!!$ write(iout,*) 'Multilevel smoother position: ',& !!$ write(iout,*) 'Multilevel smoother position: ',&
!!$ & smooth_names(p%baseprecv(2)%iprcparm(mld_smooth_pos_)) !!$ & smooth_names(p%baseprecv(2)%iprcparm(mld_smooth_pos_))
@ -751,8 +751,8 @@ contains
write(iout,*) 'Multilevel aggregation: ', & write(iout,*) 'Multilevel aggregation: ', &
& aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_)) & aggr_names(p%baseprecv(ilev)%iprcparm(mld_aggr_alg_))
write(iout,*) 'Smoother: ', & write(iout,*) 'Smoother: ', &
& smooth_kinds(p%baseprecv(ilev)%iprcparm(mld_smooth_kind_)) & aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_smooth_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)%dprcparm(mld_aggr_damp_)
write(iout,*) 'Smoothing position: ',& write(iout,*) 'Smoothing position: ',&
@ -826,7 +826,7 @@ contains
!!$ write(iout,*) 'Multilevel aggregation: ', & !!$ write(iout,*) 'Multilevel aggregation: ', &
!!$ & aggr_names(p%baseprecv(2)%iprcparm(mld_aggr_alg_)) !!$ & aggr_names(p%baseprecv(2)%iprcparm(mld_aggr_alg_))
!!$ write(iout,*) 'Smoother: ', & !!$ write(iout,*) 'Smoother: ', &
!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(mld_smooth_kind_)) !!$ & aggr_kinds(p%baseprecv(2)%iprcparm(mld_aggr_kind_))
!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(mld_aggr_damp_) !!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(mld_aggr_damp_)
!!$ write(iout,*) 'Smoothing position: ',& !!$ write(iout,*) 'Smoothing position: ',&
!!$ & smooth_names(p%baseprecv(2)%iprcparm(mld_smooth_pos_)) !!$ & 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_)) is_legal_ml_smooth_pos = ((ip>=mld_pre_smooth_).and.(ip<=mld_max_smooth_))
return return
end function is_legal_ml_smooth_pos end function is_legal_ml_smooth_pos
function is_legal_ml_smooth_kind(ip) function is_legal_ml_aggr_kind(ip)
use psb_base_mod use psb_base_mod
integer, intent(in) :: ip integer, intent(in) :: ip
logical :: is_legal_ml_smooth_kind logical :: is_legal_ml_aggr_kind
is_legal_ml_smooth_kind = ((ip>=mld_no_smooth_).and.(ip<=mld_biz_prol_)) is_legal_ml_aggr_kind = ((ip>=mld_no_smooth_).and.(ip<=mld_biz_prol_))
return return
end function is_legal_ml_smooth_kind end function is_legal_ml_aggr_kind
function is_legal_ml_coarse_mat(ip) function is_legal_ml_coarse_mat(ip)
use psb_base_mod use psb_base_mod
integer, intent(in) :: ip integer, intent(in) :: ip

4
mlprec/mld_zaggrmat_asb.f90
Unescape Escape View File

@ -49,7 +49,7 @@
! A mapping from the nodes of the adjacency graph of A to the nodes of the ! 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. ! 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 ! The prolongator P_C is built here from this mapping, according to the
! value of p%iprcparm(mld_smooth_kind_), specified by the user through ! value of p%iprcparm(mld_aggr_kind_), specified by the user through
! mld_dprecinit and mld_dprecset. ! mld_dprecinit and mld_dprecset.
! !
! Currently three different prolongators are implemented, corresponding to ! 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) call psb_info(ictxt, me, np)
select case (p%iprcparm(mld_smooth_kind_)) select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_) case (mld_no_smooth_)
call mld_aggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info) call mld_aggrmat_raw_asb(a,desc_a,ac,desc_ac,p,info)

14
mlprec/mld_zaggrmat_smth_asb.F90
Unescape Escape View File

@ -169,8 +169,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
naggrm1 = sum(p%nlaggr(1:me)) naggrm1 = sum(p%nlaggr(1:me))
naggrp1 = sum(p%nlaggr(1:me+1)) naggrp1 = sum(p%nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_).or.& ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_).and.& & ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) ) & (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
if (ml_global_nmb) then 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_eig_) == mld_max_norm_) then
if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
! !
! This only works with CSR. ! 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),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2' & 'Done NUMBMM 2'
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
call psb_transp(am1,am2,fmt='COO') call psb_transp(am1,am2,fmt='COO')
nzl = am2%infoa(psb_nnz_) nzl = am2%infoa(psb_nnz_)
i=0 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),& & write(debug_unit,*) me,' ',trim(name),&
& 'starting sphalo/ rwxtd' & 'starting sphalo/ rwxtd'
if (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_) then if (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_) then
! am2 = ((i-wDA)Ptilde)^T ! am2 = ((i-wDA)Ptilde)^T
call psb_sphalo(am3,desc_a,am4,info,& call psb_sphalo(am3,desc_a,am4,info,&
& colcnv=.false.,rowscale=.true.) & colcnv=.false.,rowscale=.true.)
if (info == 0) call psb_rwextd(ncol,am3,info,b=am4) if (info == 0) call psb_rwextd(ncol,am3,info,b=am4)
if (info == 0) call psb_sp_free(am4,info) if (info == 0) call psb_sp_free(am4,info)
else if (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_) then else if (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_) then
call psb_rwextd(ncol,am3,info) call psb_rwextd(ncol,am3,info)
endif endif
if(info /= 0) then 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_smooth_kind_)) select case(p%iprcparm(mld_aggr_kind_))
case(mld_smooth_prol_) case(mld_smooth_prol_)

66
mlprec/mld_zas_bld.f90
Unescape Escape View File

@ -45,25 +45,16 @@
! !
! !
! Arguments: ! Arguments:
! ptype - integer, input.
! The type of preconditioner to be built. Only the values
! mld_bjac_ and mld_as_ (see mld_prec_type.f90) are allowed.
! novr - integer, input.
! The number of overlap layers in the AS preconditioner.
! a - type(psb_zspmat_type), input. ! a - type(psb_zspmat_type), input.
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! matrix to be preconditioned. ! matrix to be preconditioned.
! desc_a - type(psb_desc_type), input. ! desc_a - type(psb_desc_type), input.
! The communication descriptor of the sparse matrix a. ! The communication descriptor of the sparse matrix a.
! desc_p - type(psb_desc_type), output. ! p - type(mld_zbaseprc_type), input/output.
! The communication descriptor associated to the extended ! The 'base preconditioner' data structure containing the local
! matrices that form the AS preconditioner. ! part of the preconditioner or solver to be built.
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! outfmt - character(len=5), optional.
! The storage format of the local extended matrix for the AS
! preconditioner. Currently outfmt is set to 'CSR' by the
! calling routine mld_bjac_bld.
! !
subroutine mld_zas_bld(a,desc_a,p,upd,info) subroutine mld_zas_bld(a,desc_a,p,upd,info)
@ -80,13 +71,13 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(out) :: info integer, intent(out) :: info
integer :: ptype,novr
! Local variables ! Local variables
integer icomm integer :: ptype,novr
integer :: icomm
Integer :: np,me,nnzero,& Integer :: np,me,nnzero,&
& ictxt, n_col,int_err(5),& & ictxt, n_col,int_err(5),&
& tot_recv, n_row,nhalo, nrow_a,err_act, data_ & tot_recv, n_row,nhalo, nrow_a,err_act, data_
type(psb_zspmat_type) :: blck
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -150,9 +141,18 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0' & 'Early return: P>=3 N_OVR=0'
endif endif
call psb_sp_all(0,0,blck,1,info)
if(info /= 0) then
info=4010
ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
blck%fida = 'COO'
blck%infoa(psb_nnz_) = 0
else else
data_ = psb_comm_ext_
If (upd == 'F') Then If (upd == 'F') Then
! !
! Build the auxiliary descriptor desc_p%matrix_data(psb_n_row_). ! Build the auxiliary descriptor desc_p%matrix_data(psb_n_row_).
@ -163,6 +163,11 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
! a descriptor for an extended stencil in a PDE solver. ! a descriptor for an extended stencil in a PDE solver.
! !
call psb_cdbldext(a,desc_a,novr,p%desc_data,info,extype=psb_ovt_asov_) call psb_cdbldext(a,desc_a,novr,p%desc_data,info,extype=psb_ovt_asov_)
if(debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ' From cdbldext _:',p%desc_data%matrix_data(psb_n_row_),&
& p%desc_data%matrix_data(psb_n_col_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_cdbldext' ch_err='psb_cdbldext'
@ -171,14 +176,33 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
end if end if
Endif Endif
End if if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo ',blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
if(debug_level >= psb_debug_outer_) & !
! Retrieve the remote sparse matrix rows required for the AS extended
! matrix
data_ = psb_comm_ext_
Call psb_sphalo(a,p%desc_data,blck,info,data=data_,rowscale=.true.)
if (info /= 0) then
info=4010
ch_err='psb_sphalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' From cdbldext _:',p%desc_data%matrix_data(psb_n_row_),& & 'After psb_sphalo ',&
& p%desc_data%matrix_data(psb_n_col_) & blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
End if
call mld_bjac_bld(a,p,upd,info,blck=blck)
call mld_bjac_bld(a,p,upd,info,data=data_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='mld_bjac_bld' ch_err='mld_bjac_bld'

115
mlprec/mld_zbjac_bld.f90
Unescape Escape View File

@ -39,21 +39,21 @@
! Subroutine: mld_zbjac_bld ! Subroutine: mld_zbjac_bld
! Version: complex ! Version: complex
! !
! This routine builds the local extended matrix associated to an Additive ! This routine computes an LU or incomplete LU factorization
! Schwarz preconditioner and computes an LU or incomplete LU factorization ! of the input matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! of this matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! set by the user through mld_dprecinit or mld_dprecset. ! set by the user through mld_dprecinit or mld_dprecset.
! Alternatively, it splits the local matrix into its block-diagonal and ! It may also split the local matrix into its block-diagonal and
! off block-diagonal parts, for the future application of multiple ! off block-diagonal parts, for the future application of multiple
! block-Jacobi sweeps. ! block-Jacobi sweeps.
! !
! This routine is used by mld_dbaseprec_bld, to build a 'base' block-Jacobi or ! This routine is used by mld_dbaseprec_bld, to build a 'base' block-Jacobi or
! Additive Schwarz (AS) preconditioner at any level of a multilevel preconditioner, ! Additive Schwarz (AS) preconditioner at any level of a multilevel preconditioner,
! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel ! or a block-Jacobi or LU or ILU solver at the coarsest level of a multilevel
! preconditioner. More precisely, the routine is used to perform one of the ! preconditioner. For the Additive Schwarz, it is called from mld_as_bld,
! following tasks: ! which prepares the overlap descriptor and retrieves the remote rows into blck.
! More precisely, the routine performs one of the following tasks:
! !
! 1. construction of a block-Jacobi or Additive Schwarz preconditioner associated ! 1. construction of a block-Jacobi preconditioner associated
! to a matrix A distributed among the processes (allowed at any level); ! to a matrix A distributed among the processes (allowed at any level);
! !
! 2. setup of block-Jacobi sweeps to compute an approximate solution of a ! 2. setup of block-Jacobi sweeps to compute an approximate solution of a
@ -75,8 +75,8 @@
! - ILU(k,t), i.e. ILU with threshold (i.e. drop tolerance) t and k additional ! - ILU(k,t), i.e. ILU with threshold (i.e. drop tolerance) t and k additional
! entries in each row of the L and U factors with respect to the initial ! entries in each row of the L and U factors with respect to the initial
! sparsity pattern; ! sparsity pattern;
! - LU implemented in SuperLU version 3.0; ! - serial LU implemented in SuperLU version 3.0;
! - LU implemented in UMFPACK version 4.4; ! - serial LU implemented in UMFPACK version 4.4;
! - distributed LU implemented in SuperLU_DIST version 2.0. ! - distributed LU implemented in SuperLU_DIST version 2.0.
! !
! !
@ -84,21 +84,19 @@
! a - type(psb_zspmat_type), input. ! a - type(psb_zspmat_type), input.
! The sparse matrix structure containing the local part of the ! The sparse matrix structure containing the local part of the
! matrix to be preconditioned or factorized. ! matrix to be preconditioned or factorized.
! desc_a - type(psb_desc_type), input.
! The communication descriptor associated to a.
! p - type(mld_zbaseprec_type), input/output. ! p - type(mld_zbaseprec_type), input/output.
! The 'base preconditioner' data structure containing the local ! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver at the current level. ! part of the preconditioner or solver at the current level.
!
! info - integer, output. ! info - integer, output.
! Error code. ! Error code.
! data - integer Which index list in desc_a should be used to retrieve ! blck - type(psb_zspmat_type), input, optional.
! rows, default psb_comm_halo_ ! The sparse matrix structure containing the remote rows of the
! psb_no_comm_ don't retrieve remote rows ! matrix to be factorized, that have been retrieved by mld_as_bld
! psb_comm_halo_ use halo_index ! to build an Additive Schwarz base preconditioner with overlap
! psb_comm_ext_ use ext_index ! greater than 0. If the overlap is 0 blck is empty.
! psb_comm_ovrl_ DISABLED for this routine.
! !
subroutine mld_zbjac_bld(a,p,upd,info,data) subroutine mld_zbjac_bld(a,p,upd,info,blck)
use psb_base_mod use psb_base_mod
use mld_prec_mod, mld_protect_name => mld_zbjac_bld use mld_prec_mod, mld_protect_name => mld_zbjac_bld
@ -110,15 +108,16 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
type(mld_zbaseprc_type), intent(inout) :: p type(mld_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info integer, intent(out) :: info
character, intent(in) :: upd character, intent(in) :: upd
integer, intent(in), optional :: data type(psb_zspmat_type), intent(in), target, optional :: blck
! Local Variables ! Local Variables
integer :: i, k, m integer :: i, k, m
integer :: int_err(5) integer :: int_err(5)
character :: trans, unitd character :: trans, unitd
type(psb_zspmat_type) :: blck, atmp type(psb_zspmat_type), pointer :: blck_
type(psb_zspmat_type) :: atmp
integer :: debug_level, debug_unit integer :: debug_level, debug_unit
integer :: err_act, n_row, nrow_a,n_col, data_ integer :: err_act, n_row, nrow_a,n_col
integer :: ictxt,np,me integer :: ictxt,np,me
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -141,65 +140,22 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
endif endif
trans = 'N' trans = 'N'
unitd = 'U' unitd = 'U'
if (p%iprcparm(mld_n_ovr_) < 0) then
info = 11
int_err(1) = 1
int_err(2) = p%iprcparm(mld_n_ovr_)
call psb_errpush(info,name,i_err=int_err)
goto 9999
endif
call psb_nullify_sp(blck)
call psb_nullify_sp(atmp)
if (debug_level >= psb_debug_outer_) & if (present(blck)) then
& write(debug_unit,*) me,' ',trim(name),': Start',& blck_ => blck
& p%iprcparm(mld_prec_type_),p%iprcparm(mld_n_ovr_)
if (present(data)) then
data_ = data
else else
data_ = psb_no_comm_ allocate(blck_,stat=info)
end if if (info ==0) call psb_sp_all(0,0,blck_,1,info)
select case (data_)
case(psb_no_comm_)
If (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& ' calling allocate novr=0'
call psb_sp_all(0,0,blck,1,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
ch_err='psb_sp_all' ch_err='psb_sp_all'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
blck%fida = 'COO' blck_%fida = 'COO'
blck%infoa(psb_nnz_) = 0 blck_%infoa(psb_nnz_) = 0
case(psb_comm_halo_,psb_comm_ext_)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo ',blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
Call psb_sphalo(a,p%desc_data,blck,info,data=data_,rowscale=.true.)
if (info /= 0) then
info=4010
ch_err='psb_sphalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if end if
call psb_nullify_sp(atmp)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'After psb_sphalo ',&
& blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
case default
info=35
call psb_errpush(info,name,i_err=(/5,data,0,0,0/))
goto 9999
end select
! !
! Treat separately the case the local matrix has to be reordered ! Treat separately the case the local matrix has to be reordered
@ -217,7 +173,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
! according to the value of p%iprcparm(sub_ren_). The reordered ! according to the value of p%iprcparm(sub_ren_). The reordered
! matrix is stored into atmp, using the COO format. ! matrix is stored into atmp, using the COO format.
! !
call mld_sp_renum(a,blck,p,atmp,info) call mld_sp_renum(a,blck_,p,atmp,info)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='mld_sp_renum') call psb_errpush(4010,name,a_err='mld_sp_renum')
goto 9999 goto 9999
@ -251,7 +207,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
end if end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' Factoring rows ',& & write(debug_unit,*) me,' ',trim(name),' Factoring rows ',&
& atmp%m,a%m,blck%m,atmp%ia2(atmp%m+1)-1 & atmp%m,a%m,blck_%m,atmp%ia2(atmp%m+1)-1
! !
! Compute a factorization of the diagonal block of the local matrix, ! Compute a factorization of the diagonal block of the local matrix,
@ -346,7 +302,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
! given that the output from CLIP is in COO. ! given that the output from CLIP is in COO.
call psb_sp_clip(a,p%av(mld_ap_nd_),info,& call psb_sp_clip(a,p%av(mld_ap_nd_),info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_sp_clip(blck,atmp,info,& if (info == 0) call psb_sp_clip(blck_,atmp,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.) & jmin=nrow_a+1,rscale=.false.,cscale=.false.)
if (info == 0) call psb_rwextd(n_row,p%av(mld_ap_nd_),info,b=atmp) if (info == 0) call psb_rwextd(n_row,p%av(mld_ap_nd_),info,b=atmp)
if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,& if (info == 0) call psb_spcnv(p%av(mld_ap_nd_),info,&
@ -387,7 +343,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
! !
! Compute the incomplete LU factorization. ! Compute the incomplete LU factorization.
! !
call mld_ilu_bld(a,p,upd,info,blck=blck) call mld_ilu_bld(a,p,upd,info,blck=blck_)
if (info/=0) then if (info/=0) then
call psb_errpush(4010,name,a_err='mld_ilu_bld') call psb_errpush(4010,name,a_err='mld_ilu_bld')
goto 9999 goto 9999
@ -400,7 +356,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
n_row = psb_cd_get_local_rows(p%desc_data) n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
call psb_spcnv(a,atmp,info,afmt='coo') call psb_spcnv(a,atmp,info,afmt='coo')
if (info == 0) call psb_rwextd(n_row,atmp,info,b=blck) if (info == 0) call psb_rwextd(n_row,atmp,info,b=blck_)
! !
! Compute the LU factorization. ! Compute the LU factorization.
@ -450,7 +406,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
n_row = psb_cd_get_local_rows(p%desc_data) n_row = psb_cd_get_local_rows(p%desc_data)
n_col = psb_cd_get_local_cols(p%desc_data) n_col = psb_cd_get_local_cols(p%desc_data)
call psb_rwextd(n_row,atmp,info,b=blck) call psb_rwextd(n_row,atmp,info,b=blck_)
! !
! Compute the LU factorization. ! Compute the LU factorization.
@ -491,11 +447,14 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
goto 9999 goto 9999
end select end select
call psb_sp_free(blck,info) if (.not.present(blck)) then
call psb_sp_free(blck_,info)
if (info == 0) deallocate(blck_)
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free') call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999 goto 9999
end if end if
end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),'End ' & write(debug_unit,*) me,' ',trim(name),'End '

19
mlprec/mld_zmlprec_aply.f90
Unescape Escape View File

@ -223,7 +223,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! each level) ! each level)
! !
! Pre/post-smoothing versions. ! Pre/post-smoothing versions.
! Note that transpose switches pre <-> post. ! Note that the transpose switches pre <-> post.
! !
select case(baseprecv(2)%iprcparm(mld_smooth_pos_)) select case(baseprecv(2)%iprcparm(mld_smooth_pos_))
@ -415,8 +415,7 @@ contains
mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = zzero mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = zzero
mlprec_wrk(ilev)%ty(:) = zzero 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_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
! !
@ -473,7 +472,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
@ -670,7 +669,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
@ -747,7 +746,7 @@ contains
! !
do ilev = nlev-1, 1, -1 do ilev = nlev-1, 1, -1
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
@ -913,7 +912,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (debug_level >= psb_debug_inner_) & if (debug_level >= psb_debug_inner_) &
@ -1013,7 +1012,7 @@ contains
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ' starting down sweep',ilev & ' starting down sweep',ilev
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then
@ -1241,7 +1240,7 @@ contains
n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data)
nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data)
nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data)
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_) icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
& mlprec_wrk(ilev)%x2l(nc2l), stat=info) & mlprec_wrk(ilev)%x2l(nc2l), stat=info)
@ -1323,7 +1322,7 @@ contains
! !
do ilev=nlev-1, 1, -1 do ilev=nlev-1, 1, -1
ismth = baseprecv(ilev+1)%iprcparm(mld_smooth_kind_) ismth = baseprecv(ilev+1)%iprcparm(mld_aggr_kind_)
n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc)
if (ismth /= mld_no_smooth_) then if (ismth /= mld_no_smooth_) then

7
mlprec/mld_zmlprec_bld.f90
Unescape Escape View File

@ -91,15 +91,14 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_type)
call mld_check_def(p%iprcparm(mld_aggr_alg_),'Aggregation',& call mld_check_def(p%iprcparm(mld_aggr_alg_),'Aggregation',&
& mld_dec_aggr_,is_legal_ml_aggr_alg) & mld_dec_aggr_,is_legal_ml_aggr_alg)
call mld_check_def(p%iprcparm(mld_smooth_kind_),'Smoother',& call mld_check_def(p%iprcparm(mld_aggr_kind_),'Smoother',&
& mld_smooth_prol_,is_legal_ml_smooth_kind) & mld_smooth_prol_,is_legal_ml_aggr_kind)
call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',& call mld_check_def(p%iprcparm(mld_coarse_mat_),'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',& call mld_check_def(p%iprcparm(mld_smooth_pos_),'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos) & mld_pre_smooth_,is_legal_ml_smooth_pos)
!!$ nullify(p%desc_data)
select case(p%iprcparm(mld_sub_solve_)) select case(p%iprcparm(mld_sub_solve_))
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)
@ -125,7 +124,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
! !
! Build the coarse-level matrix from the fine level one, starting from ! Build the coarse-level matrix from the fine level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_smooth_kind_) ! algorithm specified by p%iprcparm(mld_aggr_kind_)
! !
call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info) call mld_aggrmat_asb(a,desc_a,ac,desc_ac,p,info)
if(info /= 0) then if(info /= 0) then

4
mlprec/mld_zprecinit.f90
Unescape Escape View File

@ -210,7 +210,7 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0 p%baseprecv(ilev_)%iprcparm(mld_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_ 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_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_ p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ 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_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ 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_n_ovr_) = 0
p%baseprecv(ilev_)%iprcparm(mld_ml_type_) = mld_mult_ml_ 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_alg_) = mld_dec_aggr_
p%baseprecv(ilev_)%iprcparm(mld_smooth_kind_) = mld_smooth_prol_ p%baseprecv(ilev_)%iprcparm(mld_aggr_kind_) = mld_smooth_prol_
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ 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_smooth_pos_) = mld_post_smooth_
p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_ p%baseprecv(ilev_)%iprcparm(mld_aggr_eig_) = mld_max_norm_

8
mlprec/mld_zprecset.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then else if (ilev_ > 1) then
select case(what) 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_,& 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_smooth_kind_,& & mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_) & mld_smooth_pos_,mld_aggr_eig_)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
case(mld_coarse_mat_) case(mld_coarse_mat_)
@ -173,7 +173,7 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
select case(what) 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_,& 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_smooth_kind_,& & mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_) & mld_smooth_pos_,mld_aggr_eig_)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then 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 else if (ilev_ > 1) then
select case(what) select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_smooth_kind_,& & mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_,mld_aggr_eig_) & mld_smooth_pos_,mld_aggr_eig_)
call get_stringval(string,val,info) call get_stringval(string,val,info)
p%baseprecv(ilev_)%iprcparm(what) = val p%baseprecv(ilev_)%iprcparm(what) = val
@ -347,7 +347,7 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
select case(what) select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,& 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_smooth_kind_,& & mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_) & mld_smooth_pos_)
call get_stringval(string,val,info) call get_stringval(string,val,info)
do ilev_=1,nlev_-1 do ilev_=1,nlev_-1

2
test/fileread/df_bench.f90
Unescape Escape View File

@ -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_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_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_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_smooth_kind_, precs(pp)%smthkind, info,ilev=nlev) call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else else
call mld_precinit(pre,precs(pp)%lv1,info) call mld_precinit(pre,precs(pp)%lv1,info)
end if end if

2
test/fileread/zf_bench.f90
Unescape Escape View File

@ -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_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_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_smooth_sweeps_, precs(pp)%jswp, info,ilev=nlev)
call mld_precset(pre,mld_smooth_kind_, precs(pp)%smthkind, info,ilev=nlev) call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else else
call mld_precinit(pre,precs(pp)%lv1,info) call mld_precinit(pre,precs(pp)%lv1,info)
end if end if

2
test/pargen/ppde.f90
Unescape Escape View File

@ -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_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_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_smooth_sweeps_, prectype%jswp, info,ilev=prectype%nlev)
call mld_precset(prec,mld_smooth_kind_, prectype%smthkind, info,ilev=prectype%nlev) call mld_precset(prec,mld_aggr_kind_, prectype%smthkind, info,ilev=prectype%nlev)
else else
call mld_precinit(prec,prectype%lv1,info) call mld_precinit(prec,prectype%lv1,info)
endif endif

Write Preview
Loading…
Cancel
Save