fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merged comments from ICAR/II UnivNaples

Browse Source
This commit is contained in:
Salvatore Filippone
2007-12-26 16:22:44 +00:00
parent 2272f944be
commit 2a712e42fb
26 changed files with 514 additions and 256 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_dasmat_bld.f90
+8 -9
View File
@@ -61,7 +61,7 @@
! blk does not contain any row.
! desc_data - type(psb_desc_type), input.
! The communication descriptor of the sparse matrix a.
! desc_p - type(psb_desc_type), output.
! desc_p - type(psb_desc_type), output.
! The communication descriptor associated to the extended
! matrices that form the AS preconditioner.
! info - integer, output.
@@ -81,7 +81,7 @@ subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
! Arguments
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_dspmat_type), Intent(out) :: blk
integer, intent(out) :: info
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
@@ -93,7 +93,7 @@ subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
Integer :: np,me,nnzero,&
& ictxt, n_col,int_err(5),&
& tot_recv, n_row,nhalo, nrow_a,err_act
integer :: debug_level, debug_unit
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
name='mld_dasmat_bld'
@@ -241,13 +241,12 @@ subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
& write(debug_unit,*) me,' ',trim(name),&
& 'After psb_sphalo ',&
& blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
case default
if(info /= 0) then
info=4001
ch_err='Invalid ptype'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
info=4001
ch_err='Invalid ptype'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
End select
if (debug_level >= psb_debug_outer_) &
mlprec/mld_dbaseprec_bld.f90
+1 -1
View File
@@ -36,7 +36,7 @@
!!$
! File: mld_dbaseprec_bld.f90
!
! Subroutine: mld_dbaseprec_bld
! Subroutine: mld_dbaseprc_bld
! Version: real
!
! This routine builds the 'base preconditioner' corresponding to a certain level
mlprec/mld_dbjac_aply.f90
+5 -7
View File
@@ -111,7 +111,7 @@
! prec - type(mld_dbaseprec_type), input.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver.
! x - real(kind(0.d0)), dimension(:), input/output.
! x - real(kind(0.d0)), dimension(:), input.
! The local part of the vector X.
! beta - real(kind(0.d0)), input.
! The scalar beta.
@@ -193,7 +193,6 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& a_err='real(kind(1.d0))')
goto 9999
end if
endif
else
allocate(ww(n_col),aux(4*n_col),stat=info)
@@ -286,7 +285,6 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! to apply the LU factorization in both cases.
!
select case(toupper(trans))
case('N')
call mld_dumf_solve(0,n_row,ww,x,n_row,prec%iprcparm(mld_umf_numptr_),info)
@@ -382,10 +380,10 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ty(1:n_row) = x(1:n_row)
call psb_spmm(-done,prec%av(mld_ap_nd_),tx,done,ty,&
& prec%desc_data,info,work=aux)
if(info /=0) exit
if(info /= 0) exit
call mld_dslu_solve(0,n_row,1,ty,n_row,prec%iprcparm(mld_slu_ptr_),info)
if(info /=0) exit
if(info /= 0) exit
tx(1:n_row) = ty(1:n_row)
end do
@@ -403,11 +401,11 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ty(1:n_row) = x(1:n_row)
call psb_spmm(-done,prec%av(mld_ap_nd_),tx,done,ty,&
& prec%desc_data,info,work=aux)
if(info /=0) exit
if (info /= 0) exit
call mld_dumf_solve(0,n_row,ww,ty,n_row,&
& prec%iprcparm(mld_umf_numptr_),info)
if(info /=0) exit
if (info /= 0) exit
tx(1:n_row) = ww(1:n_row)
end do
mlprec/mld_dbjac_bld.f90
+1 -5
View File
@@ -67,7 +67,7 @@
!
! 4. LU or incomplete LU factorization of a linear system
! A*Y = X,
! replicated on the processes (allowed only at the coarsest level).
! replicated on the processes (allowed only at the coarsest level).
!
! The following factorizations are available:
! - ILU(k), i.e. ILU factorization with fill-in level k;
@@ -218,7 +218,6 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info)
p%iprcparm(mld_smooth_sweeps_) = 1
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
@@ -240,7 +239,6 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
case(mld_slu_)
!
! LU factorization through the SuperLU package.
@@ -424,7 +422,6 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info)
! LU factorization through the UMFPACK package.
!
call psb_spcnv(a,atmp,info,afmt='coo')
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_spcnv')
@@ -482,7 +479,6 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
case(mld_f_none_)
!
! Error: no factorization required.
mlprec/mld_dilu_bld.f90
+3 -4
View File
@@ -223,11 +223,10 @@ subroutine mld_dilu_bld(a,desc_a,p,upd,info,blck)
goto 9999
case(0)
! Fill-in 0
! Separate implementation of ILU(0) for better performance
! Separate implementation of ILU(0) for better performance.
! There seems to be a problem with the separate implementation of MILU(0),
! contained into mld_ilu_fct. This must be investigated. For the time being,
! resort to the implementation of MILU(k) with k=0.
! resort to the implementation of MILU(k) with k=0.
if (p%iprcparm(mld_sub_solve_) == mld_ilu_n_) then
call mld_ilu_fct(p%iprcparm(mld_sub_solve_),a,p%av(mld_l_pr_),p%av(mld_u_pr_),&
& p%d,info,blck=blck)
@@ -264,7 +263,7 @@ subroutine mld_dilu_bld(a,desc_a,p,upd,info,blck)
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),'End'
& write(debug_unit,*) me,' ',trim(name),' end'
call psb_erractionrestore(err_act)
return
mlprec/mld_dilu_fct.f90
+12 -2
View File
@@ -172,7 +172,7 @@ subroutine mld_dilu_fct(ialg,a,l,u,d,info,blck)
u%k = m
!
! Nullify pointer / deallocate memory
! Nullify pointer / deallocate memory
!
if (present(blck)) then
blck_ => null()
@@ -297,6 +297,16 @@ contains
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
select case(ialg)
case(mld_ilu_n_,mld_milu_n_)
! Ok
case default
info=35
call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/))
goto 9999
end select
call psb_nullify_sp(trw)
trw%m=0
trw%k=0
@@ -469,7 +479,7 @@ contains
! according to the CSR format; the corresponding column indices are stored in
! the arrays lia1 and uia1.
!
! If the sparse matrix is in CSR format, a 'straight' copy is performed;
! If the sparse matrix is in CSR format, a 'straight' copy is performed;
! otherwise psb_sp_getblk is used to extract a block of rows, which is then
! copied into laspk, dia, uaspk row by row, through successive calls to
! ilu_copyin.
mlprec/mld_dmlprec_aply.f90
+23 -24
View File
@@ -50,7 +50,7 @@
! - alpha and beta are scalars.
!
! For each level we have as many subdomains as processes (except for the coarsest
! level where we might have a replicated index space) and each process takes care
! level where we might have a replicated index space) and each process takes care
! of one subdomain.
!
! The multilevel preconditioner M is regarded as an array of 'base preconditioners',
@@ -74,7 +74,7 @@
!
!
! Arguments:
! alpha - real(kind(0.d0)), input.
! alpha - real(kind(0.d0)), input.
! The scalar alpha.
! baseprecv - type(mld_dbaseprc_type), dimension(:), input.
! The array of base preconditioner data structures containing the
@@ -101,20 +101,20 @@
! factorization of A(ilev).
! baseprecv(ilev)%desc_data - type(psb_desc_type).
! The communication descriptor associated to the base
! preconditioner, i.e. to the sparse matrices needed
! preconditioner, i.e. to the sparse matrices needed
! to apply the base preconditioner at the current level.
! baseprecv(ilev)%desc_ac - type(psb_desc_type).
! The communication descriptor associated to the sparse
! The communication descriptor associated to the sparse
! matrix A(ilev), stored in baseprecv(ilev)%av(mld_ac_).
! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base preconditioner
! K(ilev).
! The integer parameters defining the base
! preconditioner K(ilev).
! baseprecv(ilev)%dprcparm - real(kind(1.d0)), dimension(:), allocatable.
! The real parameters defining the base preconditioner
! The real parameters defining the base preconditioner
! K(ilev).
! baseprecv(ilev)%perm - integer, dimension(:), allocatable.
! The row and column permutations applied to the local
! part of A(ilev) (defined only if baseprecv(ilev)%
! part of A(ilev) (defined only if baseprecv(ilev)%
! iprcparm(mld_sub_ren_)>0).
! baseprecv(ilev)%invperm - integer, dimension(:), allocatable.
! The inverse of the permutation stored in
@@ -134,10 +134,10 @@
! A(ilev) to the routine which applies the
! preconditioner.
! baseprecv(ilev)%base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated
! Pointer to the communication descriptor associated
! to the sparse matrix pointed by base_a.
! baseprecv(ilev)%dorig - real(kind(1.d0)), dimension(:), allocatable.
! Diagonal entries of the matrix pointed by base_a.
! Diagonal entries of the matrix pointed by base_a.
!
! x - real(kind(0.d0)), dimension(:), input.
! The local part of the vector X.
@@ -185,7 +185,6 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit
integer :: ismth, nlev, ilev, icm
character(len=20) :: name
type psb_mlprec_wrk_type
real(kind(1.d0)), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type psb_mlprec_wrk_type
@@ -228,7 +227,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! Additive multilevel
!
! 1. ! Apply the base preconditioner at level 1.
! ! The sum over the subdomains is carried out in the
! ! The sum over the subdomains is carried out in the
! ! application of K(1).
! X(1) = Xest
! Y(1) = (K(1)^(-1))*X(1)
@@ -259,7 +258,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 1
!
! Apply the base preconditioner at the finest level
! Apply the base preconditioner at the finest level
!
call mld_baseprec_aply(alpha,baseprecv(1),x,beta,y,&
& baseprecv(1)%base_desc,trans,work,info)
@@ -429,17 +428,17 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! 4. DO ilev=nlev-1,1,-1
!
! ! Transfer Y(ilev+1) to the next finer level.
! ! Transfer Y(ilev+1) to the next finer level.
! Y(ilev) = AV(ilev+1; sm_pr_)*Y(ilev+1)
!
! ! Compute the residual at the current level and apply to it the
! ! Compute the residual at the current level and apply to it the
! ! base preconditioner. The sum over the subdomains is carried out
! ! in the application of K(ilev).
! Y(ilev) = Y(ilev) + (K(ilev)^(-1))*(X(ilev)-A(ilev)*Y(ilev))
!
! ENDDO
!
! 5. Yext = beta*Yext + alpha*Y(1)
! 5. Yext = beta*Yext + alpha*Y(1)
!
!
@@ -468,7 +467,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 2
!
! For each level but the finest one ...
! For each level but the finest one ...
!
do ilev=2, nlev
@@ -569,7 +568,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 4
!
! For each level but the coarsest one ...
! For each level but the coarsest one ...
!
do ilev=nlev-1, 1, -1
@@ -642,17 +641,17 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! Pre-smoothing
!
! 1. X(1) = Xext
! 1. X(1) = Xext
!
! 2. ! Apply the base preconditioner at the finest level.
! Y(1) = (K(1)^(-1))*X(1)
! Y(1) = (K(1)^(-1))*X(1)
!
! 3. ! Compute the residual at the finest level.
! TX(1) = X(1) - A(1)*Y(1)
!
! 4. DO ilev=2, nlev
!
! ! Transfer the residual to the current (coarser) level.
! ! Transfer the residual to the current (coarser) level.
! X(ilev) = AV(ilev; sm_pr_t_)*TX(ilev-1)
!
! ! Apply the base preconditioner at the current level.
@@ -809,7 +808,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 5
!
! For each level but the coarsest one ...
! For each level but the coarsest one ...
!
do ilev = nlev-1, 1, -1
@@ -843,7 +842,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 6
!
! Compute the output vector Y
! Compute the output vector Y
!
call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,&
& baseprecv(1)%base_desc,info)
@@ -869,7 +868,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! 4. DO ilev=2, nlev
!
! ! Transfer the residual to the current (coarser) level
! ! Transfer the residual to the current (coarser) level
! X(ilev) = AV(ilev; sm_pr_t)*TX(ilev-1)
!
! ! Apply the base preconditioner at the current level.
mlprec/mld_dmlprec_bld.f90
-1
View File
@@ -70,7 +70,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
! Local variables
type(psb_desc_type) :: desc_ac
integer :: err_act
character(len=20) :: name, ch_err
type(psb_dspmat_type) :: ac
mlprec/mld_dprecbld.f90
+1 -2
View File
@@ -55,7 +55,7 @@
! matrix to be preconditioned.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of a.
! p - type(mld_dprec_type), input/output.
! p - type(mld_dprec_type), input/output.
! The preconditioner data structure containing the local part
! of the preconditioner to be built.
! info - integer, output.
@@ -79,7 +79,6 @@ subroutine mld_dprecbld(a,desc_a,p,info,upd)
Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: int_err(5)
character :: iupd
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
mlprec/mld_dprecinit.f90
+3 -3
View File
@@ -53,7 +53,7 @@
! on the local blocks
!
! 'AS' - Restricted Additive Schwarz (RAS), with
! overlap 1 and ILU(0) on the local submatrices
! overlap 1 and ILU(0) on the local submatrices
!
! 'ML' - Multilevel hybrid preconditioner (additive on the
! same level and multiplicative through the levels),
@@ -72,7 +72,7 @@
! p - type(mld_dprec_type), input/output.
! The preconditioner data structure.
! ptype - character(len=*), input.
! The type of preconditioner. Its values are 'NONE',
! The type of preconditioner. Its values are 'NONE',
! 'NOPREC', 'DIAG', 'BJAC', 'AS', 'ML' (and the corresponding
! lowercase strings).
! info - integer, output.
@@ -80,7 +80,7 @@
! nlev - integer, optional, input.
! The number of levels of the multilevel preconditioner.
! If nlev is not present and ptype='ML', then nlev=2
! is assumed. If ptype/='ML' nlev is ignored.
! is assumed. If ptype/='ML', nlev is ignored.
!
subroutine mld_dprecinit(p,ptype,info,nlev)
mlprec/mld_dprecset.f90
+166 -48
View File
@@ -37,14 +37,17 @@
! File: mld_dprecset.f90
!
! Subroutine: mld_dprecseti
! Version: real
!
! These routines set the parameters defining the preconditioner. More precisely,
! the parameter identified by 'what' is assigned the value contained in 'val'.
! mld_dprecsetc works on string parameters, mld_dprecseti works on integer
! parameters, while mld_dprecsetd works on real ones.
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_dprecsetc and mld_dprecsetd,
! respectively.
!
!
! Arguments:
! p - type(mld_dprec_type), input/output.
@@ -62,10 +65,7 @@
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the levels but the coarsest one, except when
! 'what' has the values mld_coarse_mat_, mld_coarse_solve_,
! mld_coarse_sweeps_, mld_coarse_fill_in_, which refer to the
! coarsest level.
! is set at all the appropriate levels.
!
subroutine mld_dprecseti(p,what,val,info,ilev)
@@ -127,9 +127,16 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
@@ -159,15 +166,14 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at levels 1,...,nlev_-1,
! except when 'what' has the values mld_coarse_solve_, mld_coarse_sweeps_,
! mld_coarse_fill_in_, which refer to the coarsest level
!
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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
@@ -177,6 +183,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
@@ -209,6 +222,17 @@ end subroutine mld_dprecseti
!
! Subroutine: mld_dprecsetc
! Version: real
! Contains: get_stringval
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_dprecseti and mld_dprecsetd,
! respectively.
!
!
! Arguments:
@@ -218,19 +242,16 @@ end subroutine mld_dprecseti
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in MLD2P4 user's guide.
! val - string(len=*) input.
! string - character(len=*), input.
! The value of the parameter to be set. The list of allowed
! values is reported in MLD2P4 user's guide.
! values is reported in MLD2P4 user's guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the levels but the coarsest one, except when
! 'what' has the values mld_coarse_mat_, mld_coarse_solve_,
! mld_coarse_sweeps_, mld_coarse_fill_in_, which refer to the
! coarsest level.
! is set at all the appropriate levels.
!
subroutine mld_dprecsetc(p,what,string,info,ilev)
@@ -238,11 +259,15 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
use mld_prec_mod, mld_protect_name => mld_dprecsetc
implicit none
! Arguments
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
character(len=*), intent(in) :: string
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
! Local variables
integer :: ilev_, nlev_,val
info = 0
@@ -269,11 +294,15 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call get_stringval(string,val,info)
@@ -282,13 +311,22 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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
case(mld_coarse_mat_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_) then
@@ -304,10 +342,14 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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
@@ -318,6 +360,14 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
call get_stringval(string,val,info)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
@@ -335,7 +385,24 @@ subroutine mld_dprecsetc(p,what,string,info,ilev)
contains
!
! Subroutine: get_stringval
! Note: internal subroutine of mld_dprecsetc
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine get_stringval(string,val,info)
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
@@ -355,10 +422,12 @@ contains
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('UMFP')
val = mld_umf_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
@@ -389,12 +458,22 @@ contains
write(0,*) 'Error in get_Stringval: unknown: "',trim(string),'"'
end if
end subroutine get_stringval
end subroutine mld_dprecsetc
!
! Subroutine: mld_dprecsetd
! Version: real
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and character parameters, see mld_dprecseti and mld_dprecsetc,
! respectively.
!
! Arguments:
! p - type(mld_dprec_type), input/output.
@@ -403,7 +482,7 @@ end subroutine mld_dprecsetc
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in MLD2P4 user's guide.
! val - real(kind(1.d0))
! val - real(kind(1.d0)), input.
! The value of the parameter to be set. The list of allowed
! values is reported in MLD2P4 user's guide.
! info - integer, output.
@@ -412,10 +491,7 @@ end subroutine mld_dprecsetc
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the levels but the coarsest one, except when
! 'what' has the values mld_coarse_mat_, mld_coarse_solve_,
! mld_coarse_sweeps_, mld_coarse_fill_in_, which refer to the
! coarsest level.
! is set at all the appropriate levels.
!
subroutine mld_dprecsetd(p,what,val,info,ilev)
@@ -423,12 +499,15 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
use mld_prec_mod, mld_protect_name => mld_dprecsetd
implicit none
! Arguments
type(mld_dprec_type), intent(inout) :: p
integer, intent(in) :: what
real(kind(1.d0)), intent(in) :: val
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
! Local variables
integer :: ilev_,nlev_
info = 0
@@ -455,23 +534,62 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
return
endif
if (ilev_ == 1) then
! Rules for fine level are slightly different.
select case(what)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate levels
!
select case(what)
case(mld_fact_thrs_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
end do
case(mld_aggr_damp_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
end do
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
endif
end subroutine mld_dprecsetd
mlprec/mld_dsp_renum.f90
+8 -6
View File
@@ -69,7 +69,7 @@
! to build an Additive Schwarz base preconditioner with overlap
! greater than 0.If the overlap is 0, then blck does not contain
! any row.
! p - type(mld_dbaseprc_type), input/output.
! p - type(mld_dbaseprc_type), input/output.
! The base preconditioner data structure containing the local
! part of the base preconditioner to be built. In input it
! contains information on the type of reordering to be applied
@@ -278,7 +278,7 @@ contains
!
! Arguments:
! m - integer, ...
! The number of rows of the matrix to which the renumbering
! The number of rows of the matrix to which the renumbering
! is applied.
! ia - integer, dimension(:), ...
! The indices identifying the first nonzero entry of each row
@@ -296,14 +296,16 @@ contains
!
subroutine gps_reduction(m,ia,ja,perm,iperm,info)
integer i,j,dgConn,Npnt,m
integer n,idpth,ideg,ibw2,ipf2
integer,dimension(:) :: perm,iperm,ia,ja
! Arguments
integer :: m
integer,dimension(:) :: ia,ja,perm,iperm
integer, intent(out) :: info
! Local variables
integer :: i,j,dgConn,Npnt
integer :: n,idpth,ideg,ibw2,ipf2
integer,dimension(:,:),allocatable::NDstk
integer,dimension(:),allocatable::iOld,renum,ndeg,lvl,lvls1,lvls2,ccstor
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
mlprec/mld_prec_mod.f90
+16 -16
View File
@@ -514,26 +514,26 @@ module mld_prec_mod
Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_base_mod
use mld_prec_type
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(out) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine mld_dasmat_bld
Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_base_mod
use mld_prec_type
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(out) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine mld_zasmat_bld
end interface
mlprec/mld_prec_type.f90
+37 -14
View File
@@ -36,7 +36,7 @@
!!$
! File: mld_prec_type.f90
!
! package: mld_prec_type
! Package: mld_prec_type
! Data structure(s) for sparse matrices
!
! This module defines:
@@ -64,31 +64,34 @@ module mld_prec_type
& psb_sizeof
!
! type: mld_dprec_type
! Type: mld_dprec_type, mld_zprec_type
!
! mld_dprec_type and mld_zprec_type are the real and complex preconditioner
! mld_dprec_type and mld_zprec_type are the real and complex preconditioner
! data structures. In the following description 'd' and 'z' are omitted.
!
! The multilevel preconditioner data structure, mld_prec_type, consists
! of an array of 'base preconditioner' data structures, mld_dbaseprc_type,
! each containing the local part of the preconditioner associated to a
! each containing the local part of the preconditioner associated to a
! certain level. For each level ilev, the base preconditioner K(ilev) is
! built from a matrix A(ilev), which is obtained by 'tranferring' the
! original matrix A (i.e. the matrix to be preconditioned) to level ilev,
! through smoothed aggregation.
!
! The levels are numbered in increasing order starting from the finest
! The levels are numbered in increasing order starting from the finest
! one, i.e. level 1 is the finest level and A(1) is the matrix A.
!
!
!| type mld_dprec_type
!| type(mld_dbaseprc_type), allocatable :: baseprecv(:)
!| end type mld_dprec_type
!|
!| type mld_zprec_type
!| type(mld_zbaseprc_type), allocatable :: baseprecv(:)
!| end type mld_zprec_type
!
! baseprecv(ilev) is the base preconditioner at level ilev.
! The number of levels is given by size(baseprecv(:)).
! baseprecv(ilev) is the base preconditioner at level ilev.
! The number of levels is given by size(baseprecv(:)).
!
! type: mld_dbaseprc_type
! Type: mld_dbaseprc_type, mld_zbaseprc_type.
!
! av - type(psb_dspmat_type), dimension(:), allocatable(:).
! The sparse matrices needed to apply the preconditioner at
@@ -152,9 +155,6 @@ module mld_prec_type
! are stored in data structures provided by UMFPACK or SuperLU_dist and pointed by
! iprcparm(mld_umf_ptr) or iprcparm(mld_slu_ptr), respectively.
!
!
! Preconditioner data types
!
type mld_dbaseprc_type
@@ -470,7 +470,7 @@ contains
! preconditioner.
!
! Arguments:
! p - type(mld_dprec_type), input.
! p - type(mld_dprec_type), input.
! The preconditioner data structure to be printed out.
!
subroutine mld_out_prec_descr(p)
@@ -495,13 +495,18 @@ contains
! iout - integer, input.
! The id of the file where the preconditioner description
! will be printed.
! p - type(mld_dprec_type), input.
! p - type(mld_dprec_type), input.
! The preconditioner data structure to be printed out.
!
subroutine mld_file_prec_descr(iout,p)
use psb_base_mod
! Arguments
integer, intent(in) :: iout
type(mld_dprec_type), intent(in) :: p
! Local variables
integer :: ilev
write(iout,*) 'Preconditioner description'
@@ -666,10 +671,28 @@ contains
end function mld_prec_short_descr
!
! Subroutine: mld_zfile_prec_descr
! Version: complex
!
! This routine prints to a file a description of the preconditioner.
!
! Arguments:
! iout - integer, input.
! The id of the file where the preconditioner description
! will be printed.
! p - type(mld_zprec_type), input.
! The preconditioner data structure to be printed out.
!
subroutine mld_zfile_prec_descr(iout,p)
use psb_base_mod
! Arguments
integer, intent(in) :: iout
type(mld_zprec_type), intent(in) :: p
! Local variables
integer :: ilev
write(iout,*) 'Preconditioner description'
mlprec/mld_zasmat_bld.f90
+7 -8
View File
@@ -81,7 +81,7 @@ subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
! Arguments
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(inout) :: blk
Type(psb_zspmat_type), Intent(out) :: blk
integer, intent(out) :: info
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
@@ -93,7 +93,7 @@ subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
Integer :: np,me,nnzero,&
& ictxt, n_col,int_err(5),&
& tot_recv, n_row,nhalo, nrow_a,err_act
integer :: debug_level, debug_unit
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
name='mld_zasmat_bld'
@@ -241,13 +241,12 @@ subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
& write(debug_unit,*) me,' ',trim(name),&
& 'After psb_sphalo ',&
& blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
case default
if(info /= 0) then
info=4001
ch_err='Invalid ptype'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
info=4001
ch_err='Invalid ptype'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
End select
if (debug_level >= psb_debug_outer_) &
mlprec/mld_zbaseprec_bld.f90
+1 -1
View File
@@ -36,7 +36,7 @@
!!$
! File: mld_zbaseprec_bld.f90
!
! Subroutine: mld_zbaseprec_bld
! Subroutine: mld_zbaseprc_bld
! Version: complex
!
! This routine builds the 'base preconditioner' corresponding to a certain level
mlprec/mld_zbjac_aply.f90
+8 -10
View File
@@ -111,7 +111,7 @@
! prec - type(mld_zbaseprec_type), input.
! The 'base preconditioner' data structure containing the local
! part of the preconditioner or solver.
! x - complex(kind(0.d0)), dimension(:), input/output.
! x - complex(kind(0.d0)), dimension(:), input.
! The local part of the vector X.
! beta - complex(kind(0.d0)), input.
! The scalar beta.
@@ -193,7 +193,6 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& a_err='complex(kind(1.d0))')
goto 9999
end if
endif
else
allocate(ww(n_col),aux(4*n_col),stat=info)
@@ -290,7 +289,6 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
! to apply the LU factorization in both cases.
!
select case(toupper(trans))
case('N')
call mld_zumf_solve(0,n_row,ww,x,n_row,prec%iprcparm(mld_umf_numptr_),info)
@@ -365,13 +363,13 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
& trans='N',unit='U',choice=psb_none_,work=aux)
if (info /=0) exit
end do
case(mld_sludist_)
!
! Wrong choice: SuperLU_DIST
!
write(0,*) 'No sense in having SuperLU_DIST with multiple Jacobi sweeps'
info=4010
info = 4001
call psb_errpush(4001,name,a_err='Invalid SuperLU_DIST with Jacobi sweeps >1')
goto 9999
case(mld_slu_)
@@ -388,10 +386,10 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ty(1:n_row) = x(1:n_row)
call psb_spmm(-zone,prec%av(mld_ap_nd_),tx,zone,ty,&
& prec%desc_data,info,work=aux)
if (info /=0) exit
if (info /= 0) exit
call mld_zslu_solve(0,n_row,1,ty,n_row,prec%iprcparm(mld_slu_ptr_),info)
if (info /=0) exit
if (info /= 0) exit
tx(1:n_row) = ty(1:n_row)
end do
@@ -409,11 +407,11 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
ty(1:n_row) = x(1:n_row)
call psb_spmm(-zone,prec%av(mld_ap_nd_),tx,zone,ty,&
& prec%desc_data,info,work=aux)
if (info /=0) exit
if (info /= 0) exit
call mld_zumf_solve(0,n_row,ww,ty,n_row,&
& prec%iprcparm(mld_umf_numptr_),info)
if (info /=0) exit
if (info /= 0) exit
tx(1:n_row) = ww(1:n_row)
end do
mlprec/mld_zbjac_bld.f90
+2 -6
View File
@@ -67,7 +67,7 @@
!
! 4. LU or incomplete LU factorization of a linear system
! A*Y = X,
! replicated on the processes (allowed only at the coarsest level).
! replicated on the processes (allowed only at the coarsest level).
!
! The following factorizations are available:
! - ILU(k), i.e. ILU factorization with fill-in level k;
@@ -114,7 +114,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info)
integer :: debug_level, debug_unit
integer :: err_act, n_row, nrow_a,n_col
integer :: ictxt,np,me
character(len=20) :: name
character(len=20) :: name
character(len=5), parameter :: coofmt='COO', csrfmt='CSR'
if(psb_get_errstatus().ne.0) return
@@ -218,7 +218,6 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info)
p%iprcparm(mld_smooth_sweeps_) = 1
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
@@ -240,7 +239,6 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
case(mld_slu_)
!
! LU factorization through the SuperLU package.
@@ -424,7 +422,6 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info)
! LU factorization through the UMFPACK package.
!
call psb_spcnv(a,atmp,info,afmt='coo')
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_spcnv')
@@ -482,7 +479,6 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info)
goto 9999
end if
case(mld_f_none_)
!
! Error: no factorization required.
mlprec/mld_zilu_bld.f90
+3 -4
View File
@@ -223,11 +223,10 @@ subroutine mld_zilu_bld(a,desc_a,p,upd,info,blck)
goto 9999
case(0)
! Fill-in 0
! Separate implementation of ILU(0) for better performance
! Separate implementation of ILU(0) for better performance.
! There seems to be a problem with the separate implementation of MILU(0),
! contained into mld_ilu_fct. This must be investigated. For the time being,
! resort to the implementation of MILU(k) with k=0.
! resort to the implementation of MILU(k) with k=0.
if (p%iprcparm(mld_sub_solve_) == mld_ilu_n_) then
call mld_ilu_fct(p%iprcparm(mld_sub_solve_),a,p%av(mld_l_pr_),p%av(mld_u_pr_),&
& p%d,info,blck=blck)
@@ -264,7 +263,7 @@ subroutine mld_zilu_bld(a,desc_a,p,upd,info,blck)
endif
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),'End'
& write(debug_unit,*) me,' ',trim(name),' end'
call psb_erractionrestore(err_act)
return
mlprec/mld_zilu_fct.f90
+12 -2
View File
@@ -171,7 +171,7 @@ subroutine mld_zilu_fct(ialg,a,l,u,d,info,blck)
u%k = m
!
! Nullify pointer / deallocate memory
! Nullify pointer / deallocate memory
!
if (present(blck)) then
blck_ => null()
@@ -296,6 +296,16 @@ contains
if(psb_get_errstatus().ne.0) return
info=0
call psb_erractionsave(err_act)
select case(ialg)
case(mld_ilu_n_,mld_milu_n_)
! Ok
case default
info=35
call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/))
goto 9999
end select
call psb_nullify_sp(trw)
trw%m=0
trw%k=0
@@ -468,7 +478,7 @@ contains
! according to the CSR format; the corresponding column indices are stored in
! the arrays lia1 and uia1.
!
! If the sparse matrix is in CSR format, a 'straight' copy is performed;
! If the sparse matrix is in CSR format, a 'straight' copy is performed;
! otherwise psb_sp_getblk is used to extract a block of rows, which is then
! copied into laspk, dia, uaspk row by row, through successive calls to
! ilu_copyin.
mlprec/mld_zmlprec_aply.f90
+21 -21
View File
@@ -50,7 +50,7 @@
! - alpha and beta are scalars.
!
! For each level we have as many subdomains as processes (except for the coarsest
! level where we might have a replicated index space) and each process takes care
! level where we might have a replicated index space) and each process takes care
! of one subdomain.
!
! The multilevel preconditioner M is regarded as an array of 'base preconditioners',
@@ -101,20 +101,20 @@
! factorization of A(ilev).
! baseprecv(ilev)%desc_data - type(psb_desc_type).
! The communication descriptor associated to the base
! preconditioner, i.e. to the sparse matrices needed
! preconditioner, i.e. to the sparse matrices needed
! to apply the base preconditioner at the current level.
! baseprecv(ilev)%desc_ac - type(psb_desc_type).
! The communication descriptor associated to the sparse
! The communication descriptor associated to the sparse
! matrix A(ilev), stored in baseprecv(ilev)%av(mld_ac_).
! baseprecv(ilev)%iprcparm - integer, dimension(:), allocatable.
! The integer parameters defining the base preconditioner
! K(ilev).
! The integer parameters defining the base
! preconditioner K(ilev).
! baseprecv(ilev)%dprcparm - complex(kind(1.d0)), dimension(:), allocatable.
! The real parameters defining the base preconditioner
! K(ilev).
! baseprecv(ilev)%perm - integer, dimension(:), allocatable.
! The row and column permutations applied to the local
! part of A(ilev) (defined only if baseprecv(ilev)%
! part of A(ilev) (defined only if baseprecv(ilev)%
! iprcparm(mld_sub_ren_)>0).
! baseprecv(ilev)%invperm - integer, dimension(:), allocatable.
! The inverse of the permutation stored in
@@ -134,10 +134,10 @@
! A(ilev) to the routine which applies the
! preconditioner.
! baseprecv(ilev)%base_desc - type(psb_desc_type), pointer.
! Pointer to the communication descriptor associated
! Pointer to the communication descriptor associated
! to the sparse matrix pointed by base_a.
! baseprecv(ilev)%dorig - complex(kind(1.d0)), dimension(:), allocatable.
! Diagonal entries of the matrix pointed by base_a.
! Diagonal entries of the matrix pointed by base_a.
!
! x - complex(kind(0.d0)), dimension(:), input.
! The local part of the vector X.
@@ -228,7 +228,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
! Additive multilevel
!
! 1. ! Apply the base preconditioner at level 1.
! ! The sum over the subdomains is carried out in the
! ! The sum over the subdomains is carried out in the
! ! application of K(1).
! X(1) = Xest
! Y(1) = (K(1)^(-1))*X(1)
@@ -259,7 +259,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 1
!
! Apply the base preconditioner at the finest level
! Apply the base preconditioner at the finest level
!
call mld_baseprec_aply(alpha,baseprecv(1),x,beta,y,&
& baseprecv(1)%base_desc,trans,work,info)
@@ -430,17 +430,17 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! 4. DO ilev=nlev-1,1,-1
!
! ! Transfer Y(ilev+1) to the next finer level.
! ! Transfer Y(ilev+1) to the next finer level.
! Y(ilev) = AV(ilev+1; sm_pr_)*Y(ilev+1)
!
! ! Compute the residual at the current level and apply to it the
! ! Compute the residual at the current level and apply to it the
! ! base preconditioner. The sum over the subdomains is carried out
! ! in the application of K(ilev).
! Y(ilev) = Y(ilev) + (K(ilev)^(-1))*(X(ilev)-A(ilev)*Y(ilev))
!
! ENDDO
!
! 5. Yext = beta*Yext + alpha*Y(1)
! 5. Yext = beta*Yext + alpha*Y(1)
!
!
@@ -469,7 +469,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 2
!
! For each level but the finest one ...
! For each level but the finest one ...
!
do ilev=2, nlev
@@ -569,7 +569,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 4
!
! For each level but the coarsest one ...
! For each level but the coarsest one ...
!
do ilev=nlev-1, 1, -1
@@ -642,17 +642,17 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! Pre-smoothing
!
! 1. X(1) = Xext
! 1. X(1) = Xext
!
! 2. ! Apply the base preconditioner at the finest level.
! Y(1) = (K(1)^(-1))*X(1)
! Y(1) = (K(1)^(-1))*X(1)
!
! 3. ! Compute the residual at the finest level.
! TX(1) = X(1) - A(1)*Y(1)
!
! 4. DO ilev=2, nlev
!
! ! Transfer the residual to the current (coarser) level.
! ! Transfer the residual to the current (coarser) level.
! X(ilev) = AV(ilev; sm_pr_t_)*TX(ilev-1)
!
! ! Apply the base preconditioner at the current level.
@@ -809,7 +809,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 5
!
! For each level but the coarsest one ...
! For each level but the coarsest one ...
!
do ilev = nlev-1, 1, -1
@@ -843,7 +843,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! STEP 6
!
! Compute the output vector Y
! Compute the output vector Y
!
call psb_geaxpby(alpha,mlprec_wrk(1)%y2l,beta,y,&
& baseprecv(1)%base_desc,info)
@@ -869,7 +869,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
! 4. DO ilev=2, nlev
!
! ! Transfer the residual to the current (coarser) level
! ! Transfer the residual to the current (coarser) level
! X(ilev) = AV(ilev; sm_pr_t)*TX(ilev-1)
!
! ! Apply the base preconditioner at the current level.
mlprec/mld_zmlprec_bld.f90
+1 -2
View File
@@ -70,8 +70,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
! Local variables
type(psb_desc_type) :: desc_ac
integer :: err_act
integer :: err_act
character(len=20) :: name, ch_err
type(psb_zspmat_type) :: ac
integer :: ictxt, np, me
mlprec/mld_zprecbld.f90
-1
View File
@@ -79,7 +79,6 @@ subroutine mld_zprecbld(a,desc_a,p,info,upd)
Integer :: err,i,k,ictxt, me,np, err_act, iszv
integer :: int_err(5)
character :: iupd
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
mlprec/mld_zprecinit.f90
+3 -3
View File
@@ -53,7 +53,7 @@
! on the local blocks
!
! 'AS' - Restricted Additive Schwarz (RAS), with
! overlap 1 and ILU(0) on the local submatrices
! overlap 1 and ILU(0) on the local submatrices
!
! 'ML' - Multilevel hybrid preconditioner (additive on the
! same level and multiplicative through the levels),
@@ -72,7 +72,7 @@
! p - type(mld_zprec_type), input/output.
! The preconditioner data structure.
! ptype - character(len=*), input.
! The type of preconditioner. Its values are 'NONE',
! The type of preconditioner. Its values are 'NONE',
! 'NOPREC', 'DIAG', 'BJAC', 'AS', 'ML' (and the corresponding
! lowercase strings).
! info - integer, output.
@@ -80,7 +80,7 @@
! nlev - integer, optional, input.
! The number of levels of the multilevel preconditioner.
! If nlev is not present and ptype='ML', then nlev=2
! is assumed. If ptype/='ML' nlev is ignored.
! is assumed. If ptype/='ML', nlev is ignored.
!
subroutine mld_zprecinit(p,ptype,info,nlev)
mlprec/mld_zprecset.f90
+163 -49
View File
@@ -37,14 +37,17 @@
! File: mld_zprecset.f90
!
! Subroutine: mld_zprecseti
! Version: complex
!
! These routines set the parameters defining the preconditioner. More precisely,
! the parameter identified by 'what' is assigned the value contained in 'val'.
! mld_zprecsetc works on string parameters, mld_zprecseti works on integer
! parameters, while mld_zprecsetd works on real ones.
! This routine sets the integer parameters defining the preconditioner. More
! precisely, the integer parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set character and real parameters, see mld_zprecsetc and mld_zprecsetd,
! respectively.
!
!
! Arguments:
! p - type(mld_zprec_type), input/output.
@@ -53,7 +56,7 @@
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in MLD2P4 user's guide.
! val - integer in mld_zprecseti input.
! val - integer, input.
! The value of the parameter to be set. The list of allowed
! values is reported in MLD2P4 user's guide.
! info - integer, output.
@@ -62,10 +65,7 @@
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the levels but the coarsest one, except when
! 'what' has the values mld_coarse_mat_, mld_coarse_solve_,
! mld_coarse_sweeps_, mld_coarse_fill_in_, which refer to the
! coarsest level.
! is set at all the appropriate levels.
!
subroutine mld_zprecseti(p,what,val,info,ilev)
@@ -127,9 +127,16 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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_)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (ilev_ /= nlev_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
@@ -159,15 +166,14 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at levels 1,...,nlev_-1,
! except when 'what' has the values mld_coarse_solve_, mld_coarse_sweeps_,
! mld_coarse_fill_in_, which refer to the coarsest level
!
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,mld_n_ovr_,mld_sub_fill_in_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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
@@ -177,6 +183,13 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
@@ -209,6 +222,17 @@ end subroutine mld_zprecseti
!
! Subroutine: mld_zprecsetc
! Version: complex
! Contains: get_stringval
!
! This routine sets the character parameters defining the preconditioner. More
! precisely, the character parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and real parameters, see mld_zprecseti and mld_zprecsetd,
! respectively.
!
!
! Arguments:
@@ -218,19 +242,16 @@ end subroutine mld_zprecseti
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in MLD2P4 user's guide.
! val - string(len=*) input.
! string - character(len=*), input.
! The value of the parameter to be set. The list of allowed
! values is reported in MLD2P4 user's guide.
! values is reported in MLD2P4 user's guide.
! info - integer, output.
! Error code.
! ilev - integer, optional, input.
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the levels but the coarsest one, except when
! 'what' has the values mld_coarse_mat_, mld_coarse_solve_,
! mld_coarse_sweeps_, mld_coarse_fill_in_, which refer to the
! coarsest level.
! is set at all the appropriate levels.
!
subroutine mld_zprecsetc(p,what,string,info,ilev)
@@ -243,6 +264,8 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
character(len=*), intent(in) :: string
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
! Local variables
integer :: ilev_, nlev_,val
info = 0
@@ -269,11 +292,15 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
return
endif
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_)
call get_stringval(string,val,info)
@@ -282,13 +309,22 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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
case(mld_coarse_mat_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_ .and. val /= mld_distr_mat_) then
write(0,*) 'Inconsistent specification of WHAT vs. ILEV'
info = -2
return
end if
p%baseprecv(ilev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
call get_stringval(string,val,info)
if (ilev_ /= nlev_) then
@@ -304,10 +340,14 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate
! levels
!
select case(what)
case(mld_prec_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,mld_sub_ren_,&
& mld_smooth_sweeps_,mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,mld_coarse_mat_,&
& 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
@@ -318,6 +358,14 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
endif
p%baseprecv(ilev_)%iprcparm(what) = val
end do
case(mld_coarse_mat_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
call get_stringval(string,val,info)
p%baseprecv(nlev_)%iprcparm(mld_coarse_mat_) = val
case(mld_coarse_solve_)
if (.not.allocated(p%baseprecv(nlev_)%iprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
@@ -335,7 +383,24 @@ subroutine mld_zprecsetc(p,what,string,info,ilev)
contains
!
! Subroutine: get_stringval
! Note: internal subroutine of mld_dprecsetc
!
! This routine converts the string contained into string into the corresponding
! integer value.
!
! Arguments:
! string - character(len=*), input.
! The string to be converted.
! val - integer, output.
! The integer value corresponding to the string
! info - integer, output.
! Error code.
!
subroutine get_stringval(string,val,info)
! Arguments
character(len=*), intent(in) :: string
integer, intent(out) :: val, info
@@ -355,10 +420,12 @@ contains
val = mld_milu_n_
case('ILUT')
val = mld_ilu_t_
case('UMF')
val = mld_umf_
case('SLU')
val = mld_slu_
case('UMFP')
val = mld_umf_
case('SLUDIST')
val = mld_sludist_
case('ADD')
val = mld_add_ml_
case('MULT')
@@ -394,6 +461,16 @@ end subroutine mld_zprecsetc
!
! Subroutine: mld_zprecsetd
! Version: complex
!
! This routine sets the real parameters defining the preconditioner. More
! precisely, the real parameter identified by 'what' is assigned the value
! contained in 'val'.
! For the multilevel preconditioners, the levels are numbered in increasing
! order starting from the finest one, i.e. level 1 is the finest level.
!
! To set integer and character parameters, see mld_zprecseti and mld_zprecsetc,
! respectively.
!
!
! Arguments:
@@ -403,7 +480,7 @@ end subroutine mld_zprecsetc
! The number identifying the parameter to be set.
! A mnemonic constant has been associated to each of these
! numbers, as reported in MLD2P4 user's guide.
! val - real(kind(1.d0))
! val - real(kind(1.d0)), input.
! The value of the parameter to be set. The list of allowed
! values is reported in MLD2P4 user's guide.
! info - integer, output.
@@ -412,10 +489,7 @@ end subroutine mld_zprecsetc
! For the multilevel preconditioner, the level at which the
! preconditioner parameter has to be set.
! If nlev is not present, the parameter identified by 'what'
! is set at all the levels but the coarsest one, except when
! 'what' has the values mld_coarse_mat_, mld_coarse_solve_,
! mld_coarse_sweeps_, mld_coarse_fill_in_, which refer to the
! coarsest level.
! is set at all the appropriate levels.
!
subroutine mld_zprecsetd(p,what,val,info,ilev)
@@ -429,6 +503,7 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
integer, intent(out) :: info
integer, optional, intent(in) :: ilev
! Local variables
integer :: ilev_,nlev_
info = 0
@@ -455,23 +530,62 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
return
endif
if (ilev_ == 1) then
! Rules for fine level are slightly different.
select case(what)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
!
! Set preconditioner parameters at level ilev.
!
if (present(ilev)) then
if (ilev_ == 1) then
!
! Rules for fine level are slightly different.
!
select case(what)
case(mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
else if (ilev_ > 1) then
select case(what)
case(mld_aggr_damp_,mld_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
endif
else if (.not.present(ilev)) then
!
! ilev not specified: set preconditioner parameters at all the appropriate levels
!
select case(what)
case(mld_fact_thrs_)
do ilev_=1,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
end do
case(mld_aggr_damp_)
do ilev_=2,nlev_-1
if (.not.allocated(p%baseprecv(ilev_)%dprcparm)) then
write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner'
info = -1
return
endif
p%baseprecv(ilev_)%dprcparm(what) = val
end do
case default
write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'
info = -2
end select
endif
end subroutine mld_zprecsetd
mlprec/mld_zsp_renum.f90
+9 -7
View File
@@ -37,7 +37,7 @@
! File: mld_zsp_renum.f90
!
! Subroutine: mld_zsp_renum
! Version: real
! Version: complex
! Contains: gps_reduction
!
! This routine reorders the rows and the columns of the local part of a sparse
@@ -278,7 +278,7 @@ contains
!
! Arguments:
! m - integer, ...
! The number of rows of the matrix to which the renumbering
! The number of rows of the matrix to which the renumbering
! is applied.
! ia - integer, dimension(:), ...
! The indices identifying the first nonzero entry of each row
@@ -296,15 +296,17 @@ contains
!
subroutine gps_reduction(m,ia,ja,perm,iperm,info)
integer i,j,dgConn,Npnt,m
integer n,idpth,ideg,ibw2,ipf2
integer,dimension(:) :: perm,iperm,ia,ja
! Arguments
integer :: m
integer,dimension(:) :: ia,ja,perm,iperm
integer, intent(out) :: info
! Local variables
integer :: i,j,dgConn,Npnt
integer :: n,idpth,ideg,ibw2,ipf2
integer,dimension(:,:),allocatable::NDstk
integer,dimension(:),allocatable::iOld,renum,ndeg,lvl,lvls1,lvls2,ccstor
character(len=20) :: name
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=0