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

Merged comments from ICAR/II UnivNaples

Browse Source
stopcriterion
Salvatore Filippone 17 years ago
parent 2272f944be
commit 2a712e42fb
26 changed files with 514 additions and 256 deletions
Show Stats Download Patch File Download Diff File

17
mlprec/mld_dasmat_bld.f90
Unescape Escape 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_) &

2
mlprec/mld_dbaseprec_bld.f90
Unescape Escape 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

12
mlprec/mld_dbjac_aply.f90
Unescape Escape 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

6
mlprec/mld_dbjac_bld.f90
Unescape Escape 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.

7
mlprec/mld_dilu_bld.f90
Unescape Escape 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

14
mlprec/mld_dilu_fct.f90
Unescape Escape 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.

47
mlprec/mld_dmlprec_aply.f90
Unescape Escape 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.

1
mlprec/mld_dmlprec_bld.f90
Unescape Escape 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

3
mlprec/mld_dprecbld.f90
Unescape Escape 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

6
mlprec/mld_dprecinit.f90
Unescape Escape 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)

214
mlprec/mld_dprecset.f90
Unescape Escape 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

14
mlprec/mld_dsp_renum.f90
Unescape Escape 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

32
mlprec/mld_prec_mod.f90
Unescape Escape 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

51
mlprec/mld_prec_type.f90
Unescape Escape 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'

15
mlprec/mld_zasmat_bld.f90
Unescape Escape 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_) &

2
mlprec/mld_zbaseprec_bld.f90
Unescape Escape 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

18
mlprec/mld_zbjac_aply.f90
Unescape Escape 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

8
mlprec/mld_zbjac_bld.f90
Unescape Escape 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.

7
mlprec/mld_zilu_bld.f90
Unescape Escape 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

14
mlprec/mld_zilu_fct.f90
Unescape Escape 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.

42
mlprec/mld_zmlprec_aply.f90
Unescape Escape 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.

3
mlprec/mld_zmlprec_bld.f90
Unescape Escape 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

1
mlprec/mld_zprecbld.f90
Unescape Escape 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

6
mlprec/mld_zprecinit.f90
Unescape Escape 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)

212
mlprec/mld_zprecset.f90
Unescape Escape 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

16
mlprec/mld_zsp_renum.f90
Unescape Escape 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

Write Preview
Loading…
Cancel
Save