diff --git a/mlprec/mld_dasmat_bld.f90 b/mlprec/mld_dasmat_bld.f90 index f6081574..ee4542cd 100644 --- a/mlprec/mld_dasmat_bld.f90 +++ b/mlprec/mld_dasmat_bld.f90 @@ -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_) & diff --git a/mlprec/mld_dbaseprec_bld.f90 b/mlprec/mld_dbaseprec_bld.f90 index 8f663a79..1638b86e 100644 --- a/mlprec/mld_dbaseprec_bld.f90 +++ b/mlprec/mld_dbaseprec_bld.f90 @@ -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 diff --git a/mlprec/mld_dbjac_aply.f90 b/mlprec/mld_dbjac_aply.f90 index cd9a5c29..7d65f49e 100644 --- a/mlprec/mld_dbjac_aply.f90 +++ b/mlprec/mld_dbjac_aply.f90 @@ -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 diff --git a/mlprec/mld_dbjac_bld.f90 b/mlprec/mld_dbjac_bld.f90 index c8d3c4ab..80f2d53e 100644 --- a/mlprec/mld_dbjac_bld.f90 +++ b/mlprec/mld_dbjac_bld.f90 @@ -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. diff --git a/mlprec/mld_dilu_bld.f90 b/mlprec/mld_dilu_bld.f90 index 21c06aac..a3380bc8 100644 --- a/mlprec/mld_dilu_bld.f90 +++ b/mlprec/mld_dilu_bld.f90 @@ -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 diff --git a/mlprec/mld_dilu_fct.f90 b/mlprec/mld_dilu_fct.f90 index 38a61d39..839b0901 100644 --- a/mlprec/mld_dilu_fct.f90 +++ b/mlprec/mld_dilu_fct.f90 @@ -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. diff --git a/mlprec/mld_dmlprec_aply.f90 b/mlprec/mld_dmlprec_aply.f90 index a8b25260..2f7b047a 100644 --- a/mlprec/mld_dmlprec_aply.f90 +++ b/mlprec/mld_dmlprec_aply.f90 @@ -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. diff --git a/mlprec/mld_dmlprec_bld.f90 b/mlprec/mld_dmlprec_bld.f90 index 12d46d24..9f1af0ee 100644 --- a/mlprec/mld_dmlprec_bld.f90 +++ b/mlprec/mld_dmlprec_bld.f90 @@ -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 diff --git a/mlprec/mld_dprecbld.f90 b/mlprec/mld_dprecbld.f90 index 0ea01607..51b9232b 100644 --- a/mlprec/mld_dprecbld.f90 +++ b/mlprec/mld_dprecbld.f90 @@ -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 diff --git a/mlprec/mld_dprecinit.f90 b/mlprec/mld_dprecinit.f90 index 12331e83..9c3b02ed 100644 --- a/mlprec/mld_dprecinit.f90 +++ b/mlprec/mld_dprecinit.f90 @@ -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) diff --git a/mlprec/mld_dprecset.f90 b/mlprec/mld_dprecset.f90 index 3def6dae..e3d52980 100644 --- a/mlprec/mld_dprecset.f90 +++ b/mlprec/mld_dprecset.f90 @@ -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 diff --git a/mlprec/mld_dsp_renum.f90 b/mlprec/mld_dsp_renum.f90 index 5bfcc43b..d299a1d3 100644 --- a/mlprec/mld_dsp_renum.f90 +++ b/mlprec/mld_dsp_renum.f90 @@ -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 diff --git a/mlprec/mld_prec_mod.f90 b/mlprec/mld_prec_mod.f90 index e38896cd..d741dc3a 100644 --- a/mlprec/mld_prec_mod.f90 +++ b/mlprec/mld_prec_mod.f90 @@ -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 diff --git a/mlprec/mld_prec_type.f90 b/mlprec/mld_prec_type.f90 index 5c380464..f54e3568 100644 --- a/mlprec/mld_prec_type.f90 +++ b/mlprec/mld_prec_type.f90 @@ -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' diff --git a/mlprec/mld_zasmat_bld.f90 b/mlprec/mld_zasmat_bld.f90 index 76ac5590..4b02036b 100644 --- a/mlprec/mld_zasmat_bld.f90 +++ b/mlprec/mld_zasmat_bld.f90 @@ -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_) & diff --git a/mlprec/mld_zbaseprec_bld.f90 b/mlprec/mld_zbaseprec_bld.f90 index f65d8c61..ba4fd521 100644 --- a/mlprec/mld_zbaseprec_bld.f90 +++ b/mlprec/mld_zbaseprec_bld.f90 @@ -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 diff --git a/mlprec/mld_zbjac_aply.f90 b/mlprec/mld_zbjac_aply.f90 index 4d2aa8ef..efc1ec9d 100644 --- a/mlprec/mld_zbjac_aply.f90 +++ b/mlprec/mld_zbjac_aply.f90 @@ -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 diff --git a/mlprec/mld_zbjac_bld.f90 b/mlprec/mld_zbjac_bld.f90 index 76a18c57..c00317e9 100644 --- a/mlprec/mld_zbjac_bld.f90 +++ b/mlprec/mld_zbjac_bld.f90 @@ -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. diff --git a/mlprec/mld_zilu_bld.f90 b/mlprec/mld_zilu_bld.f90 index ee90397a..0a5290a6 100644 --- a/mlprec/mld_zilu_bld.f90 +++ b/mlprec/mld_zilu_bld.f90 @@ -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 diff --git a/mlprec/mld_zilu_fct.f90 b/mlprec/mld_zilu_fct.f90 index a3fcb3ba..52a3a8e4 100644 --- a/mlprec/mld_zilu_fct.f90 +++ b/mlprec/mld_zilu_fct.f90 @@ -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. diff --git a/mlprec/mld_zmlprec_aply.f90 b/mlprec/mld_zmlprec_aply.f90 index 93662aa1..d97f5745 100644 --- a/mlprec/mld_zmlprec_aply.f90 +++ b/mlprec/mld_zmlprec_aply.f90 @@ -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. diff --git a/mlprec/mld_zmlprec_bld.f90 b/mlprec/mld_zmlprec_bld.f90 index f2c1c8b0..27f3b88b 100644 --- a/mlprec/mld_zmlprec_bld.f90 +++ b/mlprec/mld_zmlprec_bld.f90 @@ -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 diff --git a/mlprec/mld_zprecbld.f90 b/mlprec/mld_zprecbld.f90 index 0ad49125..e0dd27d2 100644 --- a/mlprec/mld_zprecbld.f90 +++ b/mlprec/mld_zprecbld.f90 @@ -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 diff --git a/mlprec/mld_zprecinit.f90 b/mlprec/mld_zprecinit.f90 index efad84d5..85a544f1 100644 --- a/mlprec/mld_zprecinit.f90 +++ b/mlprec/mld_zprecinit.f90 @@ -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) diff --git a/mlprec/mld_zprecset.f90 b/mlprec/mld_zprecset.f90 index dbd5a1f5..b3d4bc48 100644 --- a/mlprec/mld_zprecset.f90 +++ b/mlprec/mld_zprecset.f90 @@ -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 diff --git a/mlprec/mld_zsp_renum.f90 b/mlprec/mld_zsp_renum.f90 index 2f72abca..5d7a79a9 100644 --- a/mlprec/mld_zsp_renum.f90 +++ b/mlprec/mld_zsp_renum.f90 @@ -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