Merged comments from ICAR/II UnivNaples

stopcriterion
Salvatore Filippone 17 years ago
parent 2272f944be
commit 2a712e42fb

@ -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
@ -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
End select
if (debug_level >= psb_debug_outer_) &

@ -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

@ -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

@ -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.

@ -223,8 +223,7 @@ 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.
@ -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

@ -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

@ -107,8 +107,8 @@
! 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
! K(ilev).
@ -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

@ -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

@ -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

@ -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)

@ -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'
@ -160,14 +167,13 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
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,7 +242,7 @@ 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.
! info - integer, output.
@ -227,10 +251,7 @@ end subroutine mld_dprecseti
! 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,8 +534,15 @@ subroutine mld_dprecsetd(p,what,val,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_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
@ -464,6 +550,7 @@ subroutine mld_dprecsetd(p,what,val,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_aggr_damp_,mld_fact_thrs_)
@ -474,4 +561,35 @@ subroutine mld_dprecsetd(p,what,val,info,ilev)
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

@ -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

@ -516,7 +516,7 @@ module mld_prec_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_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
@ -528,7 +528,7 @@ module mld_prec_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_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

@ -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,7 +64,7 @@ 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
! data structures. In the following description 'd' and 'z' are omitted.
@ -80,15 +80,18 @@ module mld_prec_type
! 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(:)).
!
! 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
@ -499,9 +499,14 @@ contains
! 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'

@ -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
@ -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
End select
if (debug_level >= psb_debug_outer_) &

@ -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

@ -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)
@ -370,8 +368,8 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
!
! 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

@ -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.

@ -223,8 +223,7 @@ 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.
@ -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

@ -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

@ -107,8 +107,8 @@
! 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).

@ -70,7 +70,6 @@ subroutine mld_zmlprec_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_zspmat_type) :: ac

@ -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

@ -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)

@ -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'
@ -160,14 +167,13 @@ subroutine mld_zprecseti(p,what,val,info,ilev)
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,7 +242,7 @@ 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.
! info - integer, output.
@ -227,10 +251,7 @@ end subroutine mld_zprecseti
! 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,8 +530,15 @@ subroutine mld_zprecsetd(p,what,val,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_fact_thrs_)
p%baseprecv(ilev_)%dprcparm(what) = val
@ -464,6 +546,7 @@ subroutine mld_zprecsetd(p,what,val,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_aggr_damp_,mld_fact_thrs_)
@ -474,4 +557,35 @@ subroutine mld_zprecsetd(p,what,val,info,ilev)
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

@ -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
@ -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

Loading…
Cancel
Save