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 #
# #
##########################################################
PSBLASDIR=$(HOME)/NUMERICAL/PSBLAS2/psblas2-dev
PSBLASDIR=$(HOME)/NUMERICAL/PSBLAS2/psblas2
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
! 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_smooth_kind_), specified by the user through
! value of p%iprcparm(mld_aggr_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_smooth_kind_))
select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_)
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))
naggrp1 = sum(p%nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_).and.&
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_biz_prol_) then
if (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_smooth_prol_) then
if (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_smooth_prol_) then
if (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_biz_prol_) then
else if (p%iprcparm(mld_aggr_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_smooth_kind_))
select case(p%iprcparm(mld_aggr_kind_))
case(mld_smooth_prol_)

73
mlprec/mld_das_bld.f90
Unescape Escape View File

@ -45,29 +45,16 @@
!
!
! 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.
! The sparse matrix structure containing the local part of the
! matrix to be preconditioned.
! blk - type(psb_dspmat_type), output.
! 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.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the sparse matrix a.
! desc_p - type(psb_desc_type), output.
! The communication descriptor associated to the extended
! matrices that form the AS preconditioner.
! p - type(mld_dbaseprc_type), input/output.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver to be built.
! info - integer, output.
! 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)
@ -76,7 +63,6 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
Implicit None
! Arguments
! Arguments
type(psb_dspmat_type), intent(in), target :: 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
integer, intent(out) :: info
integer :: ptype,novr
! Local variables
integer icomm
integer :: ptype,novr
integer :: icomm
Integer :: np,me,nnzero,&
& ictxt, n_col,int_err(5),&
& tot_recv, n_row,nhalo, nrow_a,err_act, data_
type(psb_dspmat_type) :: blck
integer :: debug_level, debug_unit
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),&
& 'Early return: P>=3 N_OVR=0'
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
data_ = psb_comm_ext_
If (upd == 'F') Then
!
! 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.
!
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
info=4010
ch_err='psb_cdbldext'
@ -175,14 +175,33 @@ subroutine mld_das_bld(a,desc_a,p,upd,info)
end if
Endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo ',blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
!
! 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),&
& 'After psb_sphalo ',&
& blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
End if
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_)
call mld_bjac_bld(a,p,upd,info,data=data_)
call mld_bjac_bld(a,p,upd,info,blck=blck)
if (info /= 0) then
info=4010
ch_err='mld_bjac_bld'

122
mlprec/mld_dbjac_bld.f90
Unescape Escape View File

@ -5,7 +5,7 @@
!!$ based on PSBLAS (Parallel Sparse BLAS v.2.0)
!!$
!!$ (C) Copyright 2007 Alfredo Buttari University of Rome Tor Vergata
!!$ Pasqua D'Ambra ICAR-CNR, Naples
!!$ Pasqua D'Ambra ICAR-CNR, Naples
!!$ Daniela di Serafino Second University of Naples
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$
@ -39,21 +39,21 @@
! Subroutine: mld_dbjac_bld
! Version: real
!
! This routine builds the local extended matrix associated to an Additive
! Schwarz preconditioner and computes an LU or incomplete LU factorization
! of this matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! This routine computes an LU or incomplete LU factorization
! of the input matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! 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
! block-Jacobi sweeps.
!
! 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,
! 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
! following tasks:
! preconditioner. For the Additive Schwarz, it is called from mld_as_bld,
! 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);
!
! 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
! entries in each row of the L and U factors with respect to the initial
! sparsity pattern;
! - LU implemented in SuperLU version 3.0;
! - LU implemented in UMFPACK version 4.4;
! - serial LU implemented in SuperLU version 3.0;
! - serial LU implemented in UMFPACK version 4.4;
! - distributed LU implemented in SuperLU_DIST version 2.0.
!
!
@ -90,14 +90,13 @@
!
! info - integer, output.
! Error code.
! data - integer Which index list in desc_a should be used to retrieve
! rows, default psb_comm_halo_
! psb_no_comm_ don't retrieve remote rows
! psb_comm_halo_ use halo_index
! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine.
! blck - type(psb_dspmat_type), input, optional.
! The sparse matrix structure containing the remote rows of the
! matrix to be factorized, that have been retrieved by mld_as_bld
! to build an Additive Schwarz base preconditioner with overlap
! greater than 0. If the overlap is 0 blck is empty.
!
subroutine mld_dbjac_bld(a,p,upd,info,data)
subroutine mld_dbjac_bld(a,p,upd,info,blck)
use psb_base_mod
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
integer, intent(out) :: info
character, intent(in) :: upd
integer, intent(in), optional :: data
type(psb_dspmat_type), intent(in), target, optional :: blck
! Local Variables
integer :: i, k, m
integer :: int_err(5)
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 :: err_act, n_row, nrow_a,n_col, data_
integer :: err_act, n_row, nrow_a,n_col
integer :: ictxt,np,me
character(len=20) :: name, ch_err
@ -140,65 +140,22 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
endif
trans = 'N'
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_) &
& write(debug_unit,*) me,' ',trim(name),': Start',&
& p%iprcparm(mld_prec_type_),p%iprcparm(mld_n_ovr_)
if (present(data)) then
data_ = data
if (present(blck)) then
blck_ => blck
else
data_ = psb_no_comm_
end if
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)
allocate(blck_,stat=info)
if (info ==0) 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
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
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
blck_%fida = 'COO'
blck_%infoa(psb_nnz_) = 0
end if
call psb_nullify_sp(atmp)
!
! 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
! 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
call psb_errpush(4010,name,a_err='mld_sp_renum')
goto 9999
@ -250,7 +207,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
end if
if (debug_level >= psb_debug_outer_) &
& 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,
@ -345,7 +302,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
! given that the output from CLIP is in COO.
call psb_sp_clip(a,p%av(mld_ap_nd_),info,&
& 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.)
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,&
@ -386,7 +343,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
!
! 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
call psb_errpush(4010,name,a_err='mld_ilu_bld')
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_col = psb_cd_get_local_cols(p%desc_data)
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.
@ -449,7 +406,7 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
n_row = psb_cd_get_local_rows(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.
@ -490,10 +447,13 @@ subroutine mld_dbjac_bld(a,p,upd,info,data)
goto 9999
end select
call psb_sp_free(blck,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
if (.not.present(blck)) then
call psb_sp_free(blck_,info)
if (info == 0) deallocate(blck_)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
end if
end if
if (debug_level >= psb_debug_outer_) &

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)
!
! 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_))
@ -415,7 +415,7 @@ contains
mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = 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_)
if (ismth /= mld_no_smooth_) then
!
@ -472,7 +472,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then
@ -669,7 +669,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
@ -746,7 +746,7 @@ contains
!
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)
if (ismth /= mld_no_smooth_) then
@ -912,7 +912,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (debug_level >= psb_debug_inner_) &
@ -1013,7 +1013,7 @@ contains
& write(debug_unit,*) me,' ',trim(name),&
& ' 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)
if (ismth /= mld_no_smooth_) then
@ -1240,7 +1240,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_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)
@ -1321,7 +1321,7 @@ contains
!
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)
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)
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_smooth_kind_),'Smoother',&
& mld_smooth_prol_,is_legal_ml_smooth_kind)
call mld_check_def(p%iprcparm(mld_aggr_kind_),'Smoother',&
& mld_smooth_prol_,is_legal_ml_aggr_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',&
@ -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
! 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)
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_ml_type_) = mld_mult_ml_
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_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_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_smooth_pos_) = mld_post_smooth_
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
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_smooth_kind_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_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_smooth_kind_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_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_smooth_kind_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_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_smooth_kind_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_)
call get_stringval(string,val,info)
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
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 mld_prec_type
type(psb_dspmat_type), intent(in), target :: a
type(mld_dbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
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
subroutine mld_zbjac_bld(a,p,upd,info,data)
subroutine mld_zbjac_bld(a,p,upd,info,blck)
use psb_base_mod
use mld_prec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(mld_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
character, intent(in) :: upd
integer, intent(in), optional :: data
type(psb_zspmat_type), intent(in), target, optional :: blck
end subroutine mld_zbjac_bld
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_ml_type_=10
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_eig_=14
integer, parameter :: mld_coarse_mat_=16
@ -247,7 +247,7 @@ 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_smooth_kind_
! Legal values for entry: mld_aggr_kind_
!
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 both '/)
character(len=15), parameter, private :: &
& smooth_kinds(0:2)=(/'No smoother ','Omega smoother',&
& aggr_kinds(0:2)=(/'No smoother ','Omega smoother',&
& 'Bizr. smoother'/)
character(len=15), parameter, private :: &
& matrix_names(0:1)=(/'Distributed ','Replicated '/)
@ -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_smooth_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_smooth_kind_) /= mld_no_smooth_) then
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Damping omega: ', &
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_)
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_smooth_kind_))
!!$ & aggr_kinds(p%baseprecv(2)%iprcparm(mld_aggr_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_smooth_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_smooth_kind_) /= mld_no_smooth_) then
& aggr_kinds(p%baseprecv(ilev)%iprcparm(mld_aggr_kind_))
if (p%baseprecv(ilev)%iprcparm(mld_aggr_kind_) /= mld_no_smooth_) then
write(iout,*) 'Smoothing omega: ', &
& p%baseprecv(ilev)%dprcparm(mld_aggr_damp_)
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_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 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_smooth_kind(ip)
function is_legal_ml_aggr_kind(ip)
use psb_base_mod
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
end function is_legal_ml_smooth_kind
end function is_legal_ml_aggr_kind
function is_legal_ml_coarse_mat(ip)
use psb_base_mod
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
! 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_smooth_kind_), specified by the user through
! value of p%iprcparm(mld_aggr_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_smooth_kind_))
select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_)
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))
naggrp1 = sum(p%nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_smooth_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_smooth_kind_) == mld_biz_prol_).and.&
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_biz_prol_) then
if (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_smooth_prol_) then
if (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_smooth_prol_) then
if (p%iprcparm(mld_aggr_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_smooth_kind_) == mld_biz_prol_) then
else if (p%iprcparm(mld_aggr_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_smooth_kind_))
select case(p%iprcparm(mld_aggr_kind_))
case(mld_smooth_prol_)

66
mlprec/mld_zas_bld.f90
Unescape Escape View File

@ -45,25 +45,16 @@
!
!
! 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.
! The sparse matrix structure containing the local part of the
! matrix to be preconditioned.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the sparse matrix a.
! desc_p - type(psb_desc_type), output.
! The communication descriptor associated to the extended
! matrices that form the AS preconditioner.
! p - type(mld_zbaseprc_type), input/output.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver to be built.
! info - integer, output.
! 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)
@ -80,13 +71,13 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
character, intent(in) :: upd
integer, intent(out) :: info
integer :: ptype,novr
! Local variables
integer icomm
integer :: ptype,novr
integer :: icomm
Integer :: np,me,nnzero,&
& ictxt, n_col,int_err(5),&
& tot_recv, n_row,nhalo, nrow_a,err_act, data_
type(psb_zspmat_type) :: blck
integer :: debug_level, debug_unit
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),&
& 'Early return: P>=3 N_OVR=0'
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
data_ = psb_comm_ext_
If (upd == 'F') Then
!
! 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.
!
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
info=4010
ch_err='psb_cdbldext'
@ -171,14 +176,33 @@ subroutine mld_zas_bld(a,desc_a,p,upd,info)
end if
Endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Before sphalo ',blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
!
! 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),&
& 'After psb_sphalo ',&
& blck%fida,blck%m,psb_nnz_,blck%infoa(psb_nnz_)
End if
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_)
call mld_bjac_bld(a,p,upd,info,data=data_)
call mld_bjac_bld(a,p,upd,info,blck=blck)
if (info /= 0) then
info=4010
ch_err='mld_bjac_bld'

125
mlprec/mld_zbjac_bld.f90
Unescape Escape View File

@ -5,7 +5,7 @@
!!$ based on PSBLAS (Parallel Sparse BLAS v.2.0)
!!$
!!$ (C) Copyright 2007 Alfredo Buttari University of Rome Tor Vergata
!!$ Pasqua D'Ambra ICAR-CNR, Naples
!!$ Pasqua D'Ambra ICAR-CNR, Naples
!!$ Daniela di Serafino Second University of Naples
!!$ Salvatore Filippone University of Rome Tor Vergata
!!$
@ -39,21 +39,21 @@
! Subroutine: mld_zbjac_bld
! Version: complex
!
! This routine builds the local extended matrix associated to an Additive
! Schwarz preconditioner and computes an LU or incomplete LU factorization
! of this matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! This routine computes an LU or incomplete LU factorization
! of the input matrix, according to the value of p%iprcparm(iprcparm(sub_solve_),
! 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
! block-Jacobi sweeps.
!
! 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,
! 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
! following tasks:
! preconditioner. For the Additive Schwarz, it is called from mld_as_bld,
! 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);
!
! 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
! entries in each row of the L and U factors with respect to the initial
! sparsity pattern;
! - LU implemented in SuperLU version 3.0;
! - LU implemented in UMFPACK version 4.4;
! - serial LU implemented in SuperLU version 3.0;
! - serial LU implemented in UMFPACK version 4.4;
! - distributed LU implemented in SuperLU_DIST version 2.0.
!
!
@ -84,21 +84,19 @@
! a - type(psb_zspmat_type), input.
! The sparse matrix structure containing the local part of the
! 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.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver at the current level.
!
! info - integer, output.
! Error code.
! data - integer Which index list in desc_a should be used to retrieve
! rows, default psb_comm_halo_
! psb_no_comm_ don't retrieve remote rows
! psb_comm_halo_ use halo_index
! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine.
! blck - type(psb_zspmat_type), input, optional.
! The sparse matrix structure containing the remote rows of the
! matrix to be factorized, that have been retrieved by mld_as_bld
! to build an Additive Schwarz base preconditioner with overlap
! greater than 0. If the overlap is 0 blck is empty.
!
subroutine mld_zbjac_bld(a,p,upd,info,data)
subroutine mld_zbjac_bld(a,p,upd,info,blck)
use psb_base_mod
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
integer, intent(out) :: info
character, intent(in) :: upd
integer, intent(in), optional :: data
type(psb_zspmat_type), intent(in), target, optional :: blck
! Local Variables
integer :: i, k, m
integer :: int_err(5)
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 :: err_act, n_row, nrow_a,n_col, data_
integer :: err_act, n_row, nrow_a,n_col
integer :: ictxt,np,me
character(len=20) :: name, ch_err
@ -141,65 +140,22 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
endif
trans = 'N'
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_) &
& write(debug_unit,*) me,' ',trim(name),': Start',&
& p%iprcparm(mld_prec_type_),p%iprcparm(mld_n_ovr_)
if (present(data)) then
data_ = data
if (present(blck)) then
blck_ => blck
else
data_ = psb_no_comm_
end if
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)
allocate(blck_,stat=info)
if (info ==0) 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
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
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
blck_%fida = 'COO'
blck_%infoa(psb_nnz_) = 0
end if
call psb_nullify_sp(atmp)
!
! 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
! 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
call psb_errpush(4010,name,a_err='mld_sp_renum')
goto 9999
@ -251,7 +207,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
end if
if (debug_level >= psb_debug_outer_) &
& 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,
@ -346,7 +302,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
! given that the output from CLIP is in COO.
call psb_sp_clip(a,p%av(mld_ap_nd_),info,&
& 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.)
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,&
@ -387,7 +343,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
!
! 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
call psb_errpush(4010,name,a_err='mld_ilu_bld')
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_col = psb_cd_get_local_cols(p%desc_data)
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.
@ -450,7 +406,7 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
n_row = psb_cd_get_local_rows(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.
@ -491,10 +447,13 @@ subroutine mld_zbjac_bld(a,p,upd,info,data)
goto 9999
end select
call psb_sp_free(blck,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
if (.not.present(blck)) then
call psb_sp_free(blck_,info)
if (info == 0) deallocate(blck_)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_sp_free')
goto 9999
end if
end if
if (debug_level >= psb_debug_outer_) &

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)
!
! 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_))
@ -415,8 +415,7 @@ contains
mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = zzero
mlprec_wrk(ilev)%ty(:) = zzero
ismth = baseprecv(ilev)%iprcparm(mld_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then
!
@ -473,7 +472,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (ismth /= mld_no_smooth_) then
@ -670,7 +669,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),&
@ -747,7 +746,7 @@ contains
!
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)
if (ismth /= mld_no_smooth_) then
@ -913,7 +912,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_kind_)
icm = baseprecv(ilev)%iprcparm(mld_coarse_mat_)
if (debug_level >= psb_debug_inner_) &
@ -1013,7 +1012,7 @@ contains
& write(debug_unit,*) me,' ',trim(name),&
& ' 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)
if (ismth /= mld_no_smooth_) then
@ -1241,7 +1240,7 @@ contains
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_smooth_kind_)
ismth = baseprecv(ilev)%iprcparm(mld_aggr_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)
@ -1323,7 +1322,7 @@ contains
!
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)
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)
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_smooth_kind_),'Smoother',&
& mld_smooth_prol_,is_legal_ml_smooth_kind)
call mld_check_def(p%iprcparm(mld_aggr_kind_),'Smoother',&
& mld_smooth_prol_,is_legal_ml_aggr_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_,mld_milu_n_)
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
! 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)
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_ml_type_) = mld_mult_ml_
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_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_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_smooth_pos_) = mld_post_smooth_
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
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_smooth_kind_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_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_smooth_kind_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_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_smooth_kind_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_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_smooth_kind_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smooth_pos_)
call get_stringval(string,val,info)
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_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_kind_, precs(pp)%smthkind, info,ilev=nlev)
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else
call mld_precinit(pre,precs(pp)%lv1,info)
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_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_kind_, precs(pp)%smthkind, info,ilev=nlev)
call mld_precset(pre,mld_aggr_kind_, precs(pp)%smthkind, info,ilev=nlev)
else
call mld_precinit(pre,precs(pp)%lv1,info)
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_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_kind_, prectype%smthkind, info,ilev=prectype%nlev)
call mld_precset(prec,mld_aggr_kind_, prectype%smthkind, info,ilev=prectype%nlev)
else
call mld_precinit(prec,prectype%lv1,info)
endif

Write Preview
Loading…
Cancel
Save