diff --git a/mld_daggrmat_asb.F90 b/mld_daggrmat_asb.F90 index 25d6346d..4589e0b5 100644 --- a/mld_daggrmat_asb.F90 +++ b/mld_daggrmat_asb.F90 @@ -62,8 +62,8 @@ subroutine mld_daggrmat_asb(a,desc_a,ac,desc_ac,p,info) call psb_info(ictxt, me, np) - select case (p%iprcparm(smth_kind_)) - case (no_smth_) + select case (p%iprcparm(aggr_kind_)) + case (no_smooth_) call raw_aggregate(info) @@ -73,7 +73,7 @@ subroutine mld_daggrmat_asb(a,desc_a,ac,desc_ac,p,info) end if if (aggr_dump) call psb_csprt(90+me,ac,head='% Raw aggregate.') - case(smth_omg_,smth_biz_) + case(tent_prol,biz_prol_) if (aggr_dump) call psb_csprt(70+me,a,head='% Input matrix') call smooth_aggregate(info) @@ -145,7 +145,7 @@ contains naggrm1=sum(p%nlaggr(1:me)) - if (p%iprcparm(coarse_mat_) == mat_repl_) then + if (p%iprcparm(coarse_mat_) == repl_mat_) then do i=1, nrow p%mlia(i) = p%mlia(i) + naggrm1 end do @@ -202,7 +202,7 @@ contains b%m = naggr b%k = naggr - if (p%iprcparm(coarse_mat_) == mat_repl_) then + if (p%iprcparm(coarse_mat_) == repl_mat_) then call psb_cdrep(ntaggr,ictxt,desc_ac,info) if(info /= 0) then @@ -248,7 +248,7 @@ contains goto 9999 end if - else if (p%iprcparm(coarse_mat_) == mat_distr_) then + else if (p%iprcparm(coarse_mat_) == distr_mat_) then call psb_cdall(ictxt,desc_ac,info,nl=naggr) if(info /= 0) then @@ -364,9 +364,9 @@ contains naggrm1 = sum(p%nlaggr(1:me)) naggrp1 = sum(p%nlaggr(1:me+1)) - ml_global_nmb = ( (p%iprcparm(smth_kind_) == smth_omg_).or.& - & ( (p%iprcparm(smth_kind_) == smth_biz_).and.& - & (p%iprcparm(coarse_mat_) == mat_repl_)) ) + ml_global_nmb = ( (p%iprcparm(aggr_kind_) == tent_prol).or.& + & ( (p%iprcparm(aggr_kind_) == biz_prol_).and.& + & (p%iprcparm(coarse_mat_) == repl_mat_)) ) if (ml_global_nmb) then @@ -475,9 +475,9 @@ contains call psb_sp_scal(am3,p%dorig,info) if(info /= 0) goto 9999 - if (p%iprcparm(om_choice_) == lib_choice_) then + if (p%iprcparm(aggr_eig_) == max_norm_) then - if (p%iprcparm(smth_kind_) == smth_biz_) then + if (p%iprcparm(aggr_kind_) == biz_prol_) then ! ! This only works with CSR. @@ -502,15 +502,15 @@ contains anorm = psb_spnrmi(am3,desc_a,info) endif omega = 4.d0/(3.d0*anorm) - p%dprcparm(smooth_omega_) = omega + p%dprcparm(aggr_damp_) = omega - else if (p%iprcparm(om_choice_) == user_choice_) then + else if (p%iprcparm(aggr_eig_) == user_choice_) then - omega = p%dprcparm(smooth_omega_) + omega = p%dprcparm(aggr_damp_) - else if (p%iprcparm(om_choice_) /= user_choice_) then + else if (p%iprcparm(aggr_eig_) /= user_choice_) then write(0,*) me,'Error: invalid choice for OMEGA in blaggrmat?? ',& - & p%iprcparm(om_choice_) + & p%iprcparm(aggr_eig_) end if @@ -621,7 +621,7 @@ contains call psb_numbmm(a,am1,am3) if (debug) write(0,*) me,'Done NUMBMM 2' - if (p%iprcparm(smth_kind_) == smth_omg_) then + if (p%iprcparm(aggr_kind_) == tent_prol) then call psb_transp(am1,am2,fmt='COO') nzl = am2%infoa(psb_nnz_) i=0 @@ -645,7 +645,7 @@ contains endif if (debug) write(0,*) me,'starting sphalo/ rwxtd' - if (p%iprcparm(smth_kind_) == smth_omg_) then + if (p%iprcparm(aggr_kind_) == tent_prol) then ! am2 = ((i-wDA)Ptilde)^T call psb_sphalo(am3,desc_a,am4,info,clcnv=.false.) @@ -664,7 +664,7 @@ contains goto 9999 end if - else if (p%iprcparm(smth_kind_) == smth_biz_) then + else if (p%iprcparm(aggr_kind_) == biz_prol_) then call psb_rwextd(ncol,am3,info) if(info /= 0) then @@ -706,13 +706,13 @@ contains if (test_dump) call psb_csprt(80+me,b,head='% Smoothed aggregate AC.') - select case(p%iprcparm(smth_kind_)) + select case(p%iprcparm(aggr_kind_)) - case(smth_omg_) + case(tent_prol) select case(p%iprcparm(coarse_mat_)) - case(mat_distr_) + case(distr_mat_) call psb_sp_clone(b,ac,info) if(info /= 0) goto 9999 @@ -802,7 +802,7 @@ contains am2%m=desc_ac%matrix_data(psb_n_col_) if (debug) write(0,*) me,'Done ac ' - case(mat_repl_) + case(repl_mat_) ! ! call psb_cdrep(ntaggr,ictxt,desc_ac,info) @@ -854,11 +854,11 @@ contains end select - case(smth_biz_) + case(biz_prol_) select case(p%iprcparm(coarse_mat_)) - case(mat_distr_) + case(distr_mat_) call psb_sp_clone(b,ac,info) if(info /= 0) then @@ -884,7 +884,7 @@ contains end if - case(mat_repl_) + case(repl_mat_) ! ! diff --git a/mld_dasmat_bld.f90 b/mld_dasmat_bld.f90 index 456add4b..daef38f2 100644 --- a/mld_dasmat_bld.f90 +++ b/mld_dasmat_bld.f90 @@ -124,7 +124,7 @@ Subroutine mld_dasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) end if endif - Else If (ptype == asm_) Then + Else If (ptype == as_) Then ! diff --git a/mld_dbaseprec_aply.f90 b/mld_dbaseprec_aply.f90 index 102e3de7..2dd17eee 100644 --- a/mld_dbaseprec_aply.f90 +++ b/mld_dbaseprec_aply.f90 @@ -83,7 +83,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) goto 9999 end select - select case(prec%iprcparm(p_type_)) + select case(prec%iprcparm(prec_type_)) case(noprec_) @@ -122,7 +122,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) goto 9999 end if - case(asm_,ras_,ash_,rash_) + case(as_) if (prec%iprcparm(n_ovr_)==0) then ! shortcut: this fixes performance for RAS(0) == BJA @@ -180,19 +180,19 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) tx(1:nrow_d) = x(1:nrow_d) tx(nrow_d+1:isz) = dzero - if (prec%iprcparm(restr_)==psb_halo_) then + if (prec%iprcparm(sub_restr_)==psb_halo_) then call psb_halo(tx,prec%desc_data,info,work=aux,data=psb_comm_ext_) if(info /=0) then info=4010 ch_err='psb_halo' goto 9999 end if - else if (prec%iprcparm(restr_) /= psb_none_) then + else if (prec%iprcparm(sub_restr_) /= psb_none_) then write(0,*) 'Problem in PRC_APLY: Unknown value for restriction ',& - &prec%iprcparm(restr_) + &prec%iprcparm(sub_restr_) end if - if (prec%iprcparm(iren_)>0) then + if (prec%iprcparm(sub_ren_)>0) then call dgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) if(info /=0) then info=4010 @@ -208,7 +208,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) goto 9999 end if - if (prec%iprcparm(iren_)>0) then + if (prec%iprcparm(sub_ren_)>0) then call dgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) if(info /=0) then info=4010 @@ -217,7 +217,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if endif - select case (prec%iprcparm(prol_)) + select case (prec%iprcparm(sub_prol_)) case(psb_none_) ! Would work anyway, but since it's supposed to do nothing... @@ -225,7 +225,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) case(psb_sum_,psb_avg_) call psb_ovrl(ty,prec%desc_data,info,& - & update=prec%iprcparm(prol_),work=aux) + & update=prec%iprcparm(sub_prol_),work=aux) if(info /=0) then info=4010 ch_err='psb_ovrl' @@ -234,7 +234,7 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) case default write(0,*) 'Problem in PRC_APLY: Unknown value for prolongation ',& - & prec%iprcparm(prol_) + & prec%iprcparm(sub_prol_) end select call psb_geaxpby(alpha,ty,beta,y,desc_data,info) @@ -250,9 +250,8 @@ subroutine mld_dbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) endif end if case default - write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',& - & min_prec_,noprec_,diag_,bjac_,& - & ras_,asm_,ash_,rash_ + write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(prec_type_),':',& + & min_prec_,noprec_,diag_,bjac_,as_ end select call psb_erractionrestore(err_act) diff --git a/mld_dbaseprec_bld.f90 b/mld_dbaseprec_bld.f90 index 7898bd5c..7ae636da 100644 --- a/mld_dbaseprec_bld.f90 +++ b/mld_dbaseprec_bld.f90 @@ -91,13 +91,13 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) ! Should add check to ensure all procs have the same... ! - call psb_check_def(p%iprcparm(p_type_),'base_prec',& + call psb_check_def(p%iprcparm(prec_type_),'base_prec',& & diag_,is_legal_base_prec) call psb_nullify_desc(p%desc_data) - select case(p%iprcparm(p_type_)) + select case(p%iprcparm(prec_type_)) case (noprec_) ! Do nothing. call psb_cdcpy(desc_a,p%desc_data,info) @@ -119,22 +119,22 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) goto 9999 end if - case(bjac_,asm_) + case(bjac_,as_) call psb_check_def(p%iprcparm(n_ovr_),'overlap',& & 0,is_legal_n_ovr) - call psb_check_def(p%iprcparm(restr_),'restriction',& + call psb_check_def(p%iprcparm(sub_restr_),'restriction',& & psb_halo_,is_legal_restrict) - call psb_check_def(p%iprcparm(prol_),'prolongator',& + call psb_check_def(p%iprcparm(sub_prol_),'prolongator',& & psb_none_,is_legal_prolong) - call psb_check_def(p%iprcparm(iren_),'renumbering',& + call psb_check_def(p%iprcparm(sub_ren_),'renumbering',& & renum_none_,is_legal_renum) - call psb_check_def(p%iprcparm(f_type_),'fact',& - & f_ilu_n_,is_legal_ml_fact) + call psb_check_def(p%iprcparm(sub_solve_),'fact',& + & ilu_n_,is_legal_ml_fact) - if (p%iprcparm(f_type_)==f_slud_) then + if (p%iprcparm(sub_solve_)==sludist_) then p%iprcparm(n_ovr_) = 0 - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if if (debug) write(0,*)me, ': Calling mld_bjac_bld' @@ -149,7 +149,7 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) case default info=4010 - ch_err='Unknown p_type_' + ch_err='Unknown prec_type_' call psb_errpush(info,name,a_err=ch_err) goto 9999 diff --git a/mld_dbjac_aply.f90 b/mld_dbjac_aply.f90 index ca0a232d..10406934 100644 --- a/mld_dbjac_aply.f90 +++ b/mld_dbjac_aply.f90 @@ -108,13 +108,13 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) endif if (debug) then - write(0,*) me,' BJAC_APLY: ',prec%iprcparm(f_type_),prec%iprcparm(jac_sweeps_) + write(0,*) me,' BJAC_APLY: ',prec%iprcparm(sub_solve_),prec%iprcparm(smooth_sweeps_) end if - if (prec%iprcparm(jac_sweeps_) == 1) then + if (prec%iprcparm(smooth_sweeps_) == 1) then - select case(prec%iprcparm(f_type_)) - case(f_ilu_n_,f_ilu_e_) + select case(prec%iprcparm(sub_solve_)) + case(ilu_n_,ilu_t_) select case(toupper(trans)) case('N') @@ -136,7 +136,7 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end select - case(f_slu_) + case(slu_) ww(1:n_row) = x(1:n_row) @@ -150,7 +150,7 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 call psb_geaxpby(alpha,ww,beta,y,desc_data,info) - case(f_slud_) + case(sludist_) !!$ write(0,*) 'Calling SLUDist_solve ',n_row ww(1:n_row) = x(1:n_row) @@ -165,7 +165,7 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 call psb_geaxpby(alpha,ww,beta,y,desc_data,info) - case (f_umf_) + case (umf_) select case(toupper(trans)) @@ -180,11 +180,11 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call psb_geaxpby(alpha,ww,beta,y,desc_data,info) case default - write(0,*) 'Unknown factorization type in bjac_aply',prec%iprcparm(f_type_) + write(0,*) 'Unknown factorization type in bjac_aply',prec%iprcparm(sub_solve_) end select if (debugprt) write(0,*)' Y: ',y(:) - else if (prec%iprcparm(jac_sweeps_) > 1) then + else if (prec%iprcparm(smooth_sweeps_) > 1) then ! Note: we have to add TRANS to this one !!!!!!!!! @@ -203,9 +203,9 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) tx = dzero ty = dzero - select case(prec%iprcparm(f_type_)) - case(f_ilu_n_,f_ilu_e_) - do i=1, prec%iprcparm(jac_sweeps_) + select case(prec%iprcparm(sub_solve_)) + case(ilu_n_,ilu_t_) + do i=1, prec%iprcparm(smooth_sweeps_) ! X(k+1) = M^-1*(b-N*X(k)) ty(1:n_row) = x(1:n_row) call psb_spmm(-done,prec%av(ap_nd_),tx,done,ty,& @@ -221,12 +221,12 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 end do - case(f_slud_) + case(sludist_) write(0,*) 'No sense in having SLUDist with JAC_SWEEPS >1' info=4010 goto 9999 - case(f_slu_) - do i=1, prec%iprcparm(jac_sweeps_) + case(slu_) + do i=1, prec%iprcparm(smooth_sweeps_) ! X(k+1) = M^-1*(b-N*X(k)) ty(1:n_row) = x(1:n_row) call psb_spmm(-done,prec%av(ap_nd_),tx,done,ty,& @@ -237,8 +237,8 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 tx(1:n_row) = ty(1:n_row) end do - case(f_umf_) - do i=1, prec%iprcparm(jac_sweeps_) + case(umf_) + do i=1, prec%iprcparm(smooth_sweeps_) ! X(k+1) = M^-1*(b-N*X(k)) ty(1:n_row) = x(1:n_row) call psb_spmm(-done,prec%av(ap_nd_),tx,done,ty,& @@ -262,7 +262,7 @@ subroutine mld_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else info = 10 call psb_errpush(info,name,& - & i_err=(/2,prec%iprcparm(jac_sweeps_),0,0,0/)) + & i_err=(/2,prec%iprcparm(smooth_sweeps_),0,0,0/)) goto 9999 endif diff --git a/mld_dbjac_bld.f90 b/mld_dbjac_bld.f90 index 2c55943e..cf34b9c9 100644 --- a/mld_dbjac_bld.f90 +++ b/mld_dbjac_bld.f90 @@ -106,9 +106,9 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) t1= psb_wtime() - if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(p_type_),p%iprcparm(n_ovr_) + if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(prec_type_),p%iprcparm(n_ovr_) if (debug) call psb_barrier(ictxt) - call mld_asmat_bld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& + call mld_asmat_bld(p%iprcparm(prec_type_),p%iprcparm(n_ovr_),a,& & blck,desc_a,upd,p%desc_data,info,outfmt=coofmt) if (debugprt) then @@ -130,7 +130,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) if (debug) call psb_barrier(ictxt) - select case(p%iprcparm(iren_)) + select case(p%iprcparm(sub_ren_)) case (1:) @@ -165,7 +165,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if @@ -179,9 +179,9 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) if (debug) write(0,*) me,' Factoring rows ',& &atmp%m,a%m,blck%m,atmp%ia2(atmp%m+1)-1 - select case(p%iprcparm(f_type_)) + select case(p%iprcparm(sub_solve_)) - case(f_ilu_n_,f_ilu_e_) + case(ilu_n_,ilu_t_) call psb_ipcoo2csr(atmp,info) @@ -213,7 +213,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) endif - case(f_slu_) + case(slu_) call psb_ipcoo2csr(atmp,info) if (info /= 0) then @@ -227,7 +227,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) goto 9999 end if - case(f_umf_) + case(umf_) call psb_ipcoo2csc(atmp,info,clshr=.true.) if (info /= 0) then @@ -249,7 +249,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) case default info=4010 - call psb_errpush(info,name,a_err='Unknown f_type_') + call psb_errpush(info,name,a_err='Unknown sub_solve_') goto 9999 end select @@ -266,12 +266,12 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) case(0) ! No renumbering - select case(p%iprcparm(f_type_)) + select case(p%iprcparm(sub_solve_)) - case(f_ilu_n_,f_ilu_e_) + case(ilu_n_,ilu_t_) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then atmp%fida='COO' call psb_csdp(a,atmp,info) if (info /= 0) then @@ -300,7 +300,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if call psb_sp_free(atmp,info) end if @@ -335,7 +335,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) endif - case(f_slu_) + case(slu_) atmp%fida='COO' call psb_csdp(a,atmp,info) @@ -348,7 +348,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) n_col = psb_cd_get_local_cols(p%desc_data) call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ ! Split AC=M+N N off-diagonal part ! Output in COO format. @@ -368,7 +368,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if endif @@ -386,7 +386,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) end if - case(f_slud_) + case(sludist_) atmp%fida='COO' call psb_csdp(a,atmp,info) @@ -399,7 +399,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) n_col = psb_cd_get_local_cols(p%desc_data) call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ ! Split AC=M+N N off-diagonal part ! Output in COO format. @@ -419,7 +419,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if endif @@ -439,7 +439,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) end if !!$ - case(f_umf_) + case(umf_) atmp%fida='COO' @@ -453,7 +453,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) n_col = psb_cd_get_local_cols(p%desc_data) call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ ! Split AC=M+N N off-diagonal part ! Output in COO format. @@ -474,7 +474,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if endif @@ -505,7 +505,7 @@ subroutine mld_dbjac_bld(a,desc_a,p,upd,info) case default info=4010 - call psb_errpush(info,name,a_err='Unknown f_type_') + call psb_errpush(info,name,a_err='Unknown sub_solve_') goto 9999 end select diff --git a/mld_dmlprec_aply.f90 b/mld_dmlprec_aply.f90 index bb307826..729ad91c 100644 --- a/mld_dmlprec_aply.f90 +++ b/mld_dmlprec_aply.f90 @@ -138,7 +138,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) goto 9999 - case(add_ml_prec_) + case(add_ml_) ! @@ -190,9 +190,9 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%tx(n_row+1:max(n_row,n_col)) = dzero mlprec_wrk(ilev)%ty(:) = dzero - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! ! Smoothed aggregation ! @@ -216,9 +216,9 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end if - if (icm ==mat_repl_) Then + if (icm ==repl_mat_) Then call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm/= mat_distr_) Then + else if (icm/= distr_mat_) Then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',icm endif @@ -234,10 +234,10 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then call psb_csmm(done,baseprecv(ilev)%av(sm_pr_),mlprec_wrk(ilev)%y2l,& & done,mlprec_wrk(ilev-1)%y2l,info) @@ -257,14 +257,14 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 - case(mult_ml_prec_) + case(mult_ml) ! ! Multiplicative multilevel ! Pre/post smoothing versions. ! - select case(baseprecv(2)%iprcparm(smth_pos_)) + select case(baseprecv(2)%iprcparm(smooth_pos_)) case(post_smooth_) @@ -309,7 +309,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) if (debug) write(0,*) me, 'mlpr_aply starting up sweep ',& @@ -329,7 +329,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%x2l(:) = dzero mlprec_wrk(ilev)%y2l(:) = dzero mlprec_wrk(ilev)%tx(:) = dzero - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! ! Smoothed aggregation ! @@ -356,17 +356,17 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end if if (debug) write(0,*) me, 'mlpr_aply possible sum in up sweep ', & - & ilev,icm,associated(baseprecv(ilev)%base_desc),mat_repl_ + & ilev,icm,associated(baseprecv(ilev)%base_desc),repl_mat_ if (debug) write(0,*) me, 'mlpr_aply geaxpby in up sweep X', & & ilev,associated(baseprecv(ilev)%base_desc),& & baseprecv(ilev)%base_desc%matrix_data(psb_n_row_),& & baseprecv(ilev)%base_desc%matrix_data(psb_n_col_),& & size(mlprec_wrk(ilev)%tx),size(mlprec_wrk(ilev)%x2l) - if (icm == mat_repl_) Then + if (icm == repl_mat_) Then if (debug) write(0,*) 'Entering psb_sum ',nr2l call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm /= mat_distr_) Then + else if (icm /= distr_mat_) Then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ', icm endif @@ -389,11 +389,11 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) do ilev=nlev-1, 1, -1 if (debug) write(0,*) me, 'mlpr_aply starting down sweep',ilev - ismth = baseprecv(ilev+1)%iprcparm(smth_kind_) + ismth = baseprecv(ilev+1)%iprcparm(aggr_kind_) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) - if (ismth /= no_smth_) then - if (ismth == smth_omg_) & + if (ismth /= no_smooth_) then + if (ismth == tent_prol) & & call psb_halo(mlprec_wrk(ilev+1)%y2l,baseprecv(ilev+1)%desc_data,& & info,work=work) call psb_csmm(done,baseprecv(ilev+1)%av(sm_pr_),mlprec_wrk(ilev+1)%y2l,& @@ -479,7 +479,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& @@ -496,7 +496,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%tx(:) = dzero - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! !Smoothed Aggregation ! @@ -520,9 +520,9 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end do end if - if (icm ==mat_repl_) then + if (icm ==repl_mat_) then call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm /= mat_distr_) then + else if (icm /= distr_mat_) then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ', icm endif @@ -543,12 +543,12 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) do ilev = nlev-1, 1, -1 - ismth = baseprecv(ilev+1)%iprcparm(smth_kind_) + ismth = baseprecv(ilev+1)%iprcparm(aggr_kind_) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then - if (ismth == smth_omg_) & + if (ismth == tent_prol) & & call psb_halo(mlprec_wrk(ilev+1)%y2l,& & baseprecv(ilev+1)%desc_data,info,work=work) call psb_csmm(done,baseprecv(ilev+1)%av(sm_pr_),mlprec_wrk(ilev+1)%y2l,& @@ -574,7 +574,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) - case(smooth_both_) + case(twoside_smooth_) ! ! Symmetrized smoothing. @@ -635,7 +635,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -653,7 +653,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%ty(:) = dzero - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! !Smoothed Aggregation ! @@ -677,9 +677,9 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end do end if - if (icm == mat_repl_) then + if (icm == repl_mat_) then call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm /= mat_distr_) then + else if (icm /= distr_mat_) then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ', icm endif @@ -704,11 +704,11 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) do ilev=nlev-1, 1, -1 - ismth = baseprecv(ilev+1)%iprcparm(smth_kind_) + ismth = baseprecv(ilev+1)%iprcparm(aggr_kind_) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) - if (ismth /= no_smth_) then - if (ismth == smth_omg_) & + if (ismth /= no_smooth_) then + if (ismth == tent_prol) & & call psb_halo(mlprec_wrk(ilev+1)%y2l,baseprecv(ilev+1)%desc_data,& & info,work=work) call psb_csmm(done,baseprecv(ilev+1)%av(sm_pr_),mlprec_wrk(ilev+1)%y2l,& @@ -743,7 +743,7 @@ subroutine mld_dmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) case default call psb_errpush(4013,name,a_err='wrong smooth_pos',& - & i_Err=(/baseprecv(2)%iprcparm(smth_pos_),0,0,0,0/)) + & i_Err=(/baseprecv(2)%iprcparm(smooth_pos_),0,0,0,0/)) goto 9999 end select diff --git a/mld_dmlprec_bld.f90 b/mld_dmlprec_bld.f90 index 75525efe..aed38bb7 100644 --- a/mld_dmlprec_bld.f90 +++ b/mld_dmlprec_bld.f90 @@ -68,26 +68,26 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info) goto 9999 endif call psb_check_def(p%iprcparm(ml_type_),'Multilevel type',& - & mult_ml_prec_,is_legal_ml_type) + & mult_ml,is_legal_ml_type) call psb_check_def(p%iprcparm(aggr_alg_),'aggregation',& - & loc_aggr_,is_legal_ml_aggr_kind) - call psb_check_def(p%iprcparm(smth_kind_),'Smoother kind',& - & smth_omg_,is_legal_ml_smth_kind) + & dec_aggr_,is_legal_ml_aggr_kind) + call psb_check_def(p%iprcparm(aggr_kind_),'Smoother kind',& + & tent_prol,is_legal_ml_smth_kind) call psb_check_def(p%iprcparm(coarse_mat_),'Coarse matrix',& - & mat_distr_,is_legal_ml_coarse_mat) - call psb_check_def(p%iprcparm(smth_pos_),'smooth_pos',& + & distr_mat_,is_legal_ml_coarse_mat) + call psb_check_def(p%iprcparm(smooth_pos_),'smooth_pos',& & pre_smooth_,is_legal_ml_smooth_pos) !!$ nullify(p%desc_data) - select case(p%iprcparm(f_type_)) - case(f_ilu_n_) - call psb_check_def(p%iprcparm(ilu_fill_in_),'Level',0,is_legal_ml_lev) - case(f_ilu_e_) + select case(p%iprcparm(sub_solve_)) + case(ilu_n_) + call psb_check_def(p%iprcparm(sub_fill_in_),'Level',0,is_legal_ml_lev) + case(ilu_t_) call psb_check_def(p%dprcparm(fact_eps_),'Eps',dzero,is_legal_ml_eps) end select - call psb_check_def(p%dprcparm(smooth_omega_),'omega',dzero,is_legal_omega) - call psb_check_def(p%iprcparm(jac_sweeps_),'Jacobi sweeps',& + call psb_check_def(p%dprcparm(aggr_damp_),'omega',dzero,is_legal_omega) + call psb_check_def(p%iprcparm(smooth_sweeps_),'Jacobi sweeps',& & 1,is_legal_jac_sweeps) diff --git a/mld_dsp_renum.f90 b/mld_dsp_renum.f90 index 603c46a4..b29bd346 100644 --- a/mld_dsp_renum.f90 +++ b/mld_dsp_renum.f90 @@ -83,7 +83,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) call psb_csdp(a,atmp,info) call psb_rwextd(a%m+blck%m,atmp,info,blck,rowscale=.false.) - if (p%iprcparm(iren_)==renum_glb_) then + if (p%iprcparm(sub_ren_)==renum_glb_) then ! This is the renumbering coherent with global indices.. mglob = psb_cd_get_global_rows(desc_a) @@ -113,7 +113,7 @@ subroutine mld_dsp_renum(a,desc_a,blck,p,atmp,info) enddo t3 = psb_wtime() - else if (p%iprcparm(iren_)==renum_gps_) then + else if (p%iprcparm(sub_ren_)==renum_gps_) then call psb_ipcoo2csr(atmp,info) nztmp = psb_sp_get_nnzeros(atmp) diff --git a/mld_zaggrmat_asb.F90 b/mld_zaggrmat_asb.F90 index 1e1e242a..900d13a3 100644 --- a/mld_zaggrmat_asb.F90 +++ b/mld_zaggrmat_asb.F90 @@ -62,8 +62,8 @@ subroutine mld_zaggrmat_asb(a,desc_a,ac,desc_ac,p,info) call psb_info(ictxt, me, np) - select case (p%iprcparm(smth_kind_)) - case (no_smth_) + select case (p%iprcparm(aggr_kind_)) + case (no_smooth_) call raw_aggregate(info) @@ -73,7 +73,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,ac,desc_ac,p,info) end if if (aggr_dump) call psb_csprt(90+me,ac,head='% Raw aggregate.') - case(smth_omg_,smth_biz_) + case(tent_prol,biz_prol_) call smooth_aggregate(info) @@ -144,7 +144,7 @@ contains naggrm1=sum(p%nlaggr(1:me)) - if (p%iprcparm(coarse_mat_) == mat_repl_) then + if (p%iprcparm(coarse_mat_) == repl_mat_) then do i=1, nrow p%mlia(i) = p%mlia(i) + naggrm1 end do @@ -201,7 +201,7 @@ contains b%m = naggr b%k = naggr - if (p%iprcparm(coarse_mat_) == mat_repl_) then + if (p%iprcparm(coarse_mat_) == repl_mat_) then call psb_cdrep(ntaggr,ictxt,desc_ac,info) if(info /= 0) then @@ -247,7 +247,7 @@ contains goto 9999 end if - else if (p%iprcparm(coarse_mat_) == mat_distr_) then + else if (p%iprcparm(coarse_mat_) == distr_mat_) then call psb_cdall(ictxt,desc_ac,info,nl=naggr) if(info /= 0) then @@ -363,9 +363,9 @@ contains naggrm1 = sum(p%nlaggr(1:me)) naggrp1 = sum(p%nlaggr(1:me+1)) - ml_global_nmb = ( (p%iprcparm(smth_kind_) == smth_omg_).or.& - & ( (p%iprcparm(smth_kind_) == smth_biz_).and.& - & (p%iprcparm(coarse_mat_) == mat_repl_)) ) + ml_global_nmb = ( (p%iprcparm(aggr_kind_) == tent_prol).or.& + & ( (p%iprcparm(aggr_kind_) == biz_prol_).and.& + & (p%iprcparm(coarse_mat_) == repl_mat_)) ) if (ml_global_nmb) then @@ -474,9 +474,9 @@ contains call psb_sp_scal(am3,p%dorig,info) if(info /= 0) goto 9999 - if (p%iprcparm(om_choice_) == lib_choice_) then + if (p%iprcparm(aggr_eig_) == max_norm_) then - if (p%iprcparm(smth_kind_) == smth_biz_) then + if (p%iprcparm(aggr_kind_) == biz_prol_) then ! ! This only works with CSR. @@ -501,15 +501,15 @@ contains anorm = psb_spnrmi(am3,desc_a,info) endif omega = 4.d0/(3.d0*anorm) - p%dprcparm(smooth_omega_) = omega + p%dprcparm(aggr_damp_) = omega - else if (p%iprcparm(om_choice_) == user_choice_) then + else if (p%iprcparm(aggr_eig_) == user_choice_) then - omega = p%dprcparm(smooth_omega_) + omega = p%dprcparm(aggr_damp_) - else if (p%iprcparm(om_choice_) /= user_choice_) then + else if (p%iprcparm(aggr_eig_) /= user_choice_) then write(0,*) me,'Error: invalid choice for OMEGA in blaggrmat?? ',& - & p%iprcparm(om_choice_) + & p%iprcparm(aggr_eig_) end if @@ -620,7 +620,7 @@ contains call psb_numbmm(a,am1,am3) if (debug) write(0,*) me,'Done NUMBMM 2' - if (p%iprcparm(smth_kind_) == smth_omg_) then + if (p%iprcparm(aggr_kind_) == tent_prol) then call psb_transc(am1,am2,fmt='COO') nzl = am2%infoa(psb_nnz_) i=0 @@ -644,7 +644,7 @@ contains endif if (debug) write(0,*) me,'starting sphalo/ rwxtd' - if (p%iprcparm(smth_kind_) == smth_omg_) then + if (p%iprcparm(aggr_kind_) == tent_prol) then ! am2 = ((i-wDA)Ptilde)^T call psb_sphalo(am3,desc_a,am4,info,clcnv=.false.) @@ -663,7 +663,7 @@ contains goto 9999 end if - else if (p%iprcparm(smth_kind_) == smth_biz_) then + else if (p%iprcparm(aggr_kind_) == biz_prol_) then call psb_rwextd(ncol,am3,info) if(info /= 0) then @@ -705,13 +705,13 @@ contains if (test_dump) call psb_csprt(80+me,b,head='% Smoothed aggregate AC.') - select case(p%iprcparm(smth_kind_)) + select case(p%iprcparm(aggr_kind_)) - case(smth_omg_) + case(tent_prol) select case(p%iprcparm(coarse_mat_)) - case(mat_distr_) + case(distr_mat_) call psb_sp_clone(b,ac,info) if(info /= 0) goto 9999 @@ -800,7 +800,7 @@ contains end if am2%m=desc_ac%matrix_data(psb_n_col_) - case(mat_repl_) + case(repl_mat_) ! ! call psb_cdrep(ntaggr,ictxt,desc_ac,info) @@ -852,11 +852,11 @@ contains end select - case(smth_biz_) + case(biz_prol_) select case(p%iprcparm(coarse_mat_)) - case(mat_distr_) + case(distr_mat_) call psb_sp_clone(b,ac,info) if(info /= 0) then @@ -880,7 +880,7 @@ contains end if - case(mat_repl_) + case(repl_mat_) ! ! diff --git a/mld_zasmat_bld.f90 b/mld_zasmat_bld.f90 index b5cae64b..1897502b 100644 --- a/mld_zasmat_bld.f90 +++ b/mld_zasmat_bld.f90 @@ -123,7 +123,7 @@ Subroutine mld_zasmat_bld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) end if endif - Else If (ptype == asm_) Then + Else If (ptype == as_) Then ! diff --git a/mld_zbaseprec_aply.f90 b/mld_zbaseprec_aply.f90 index 6481f6e0..dcc8d60b 100644 --- a/mld_zbaseprec_aply.f90 +++ b/mld_zbaseprec_aply.f90 @@ -82,7 +82,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) goto 9999 end select - select case(prec%iprcparm(p_type_)) + select case(prec%iprcparm(prec_type_)) case(noprec_) @@ -121,7 +121,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) goto 9999 end if - case(asm_,ras_,ash_,rash_) + case(as_) if (prec%iprcparm(n_ovr_)==0) then ! shortcut: this fixes performance for RAS(0) == BJA @@ -176,19 +176,19 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) tx(1:nrow_d) = x(1:nrow_d) tx(nrow_d+1:isz) = zzero - if (prec%iprcparm(restr_)==psb_halo_) then + if (prec%iprcparm(sub_restr_)==psb_halo_) then call psb_halo(tx,prec%desc_data,info,work=aux,data=psb_comm_ext_) if(info /=0) then info=4010 ch_err='psb_halo' goto 9999 end if - else if (prec%iprcparm(restr_) /= psb_none_) then + else if (prec%iprcparm(sub_restr_) /= psb_none_) then write(0,*) 'Problem in PRC_APLY: Unknown value for restriction ',& - &prec%iprcparm(restr_) + &prec%iprcparm(sub_restr_) end if - if (prec%iprcparm(iren_)>0) then + if (prec%iprcparm(sub_ren_)>0) then call zgelp('N',n_row,1,prec%perm,tx,isz,ww,isz,info) if(info /=0) then info=4010 @@ -204,7 +204,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) goto 9999 end if - if (prec%iprcparm(iren_)>0) then + if (prec%iprcparm(sub_ren_)>0) then call zgelp('N',n_row,1,prec%invperm,ty,isz,ww,isz,info) if(info /=0) then info=4010 @@ -213,7 +213,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end if endif - select case (prec%iprcparm(prol_)) + select case (prec%iprcparm(sub_prol_)) case(psb_none_) ! Would work anyway, but since it's supposed to do nothing... @@ -221,7 +221,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) case(psb_sum_,psb_avg_) call psb_ovrl(ty,prec%desc_data,info,& - & update=prec%iprcparm(prol_),work=aux) + & update=prec%iprcparm(sub_prol_),work=aux) if(info /=0) then info=4010 ch_err='psb_ovrl' @@ -230,7 +230,7 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) case default write(0,*) 'Problem in PRC_APLY: Unknown value for prolongation ',& - & prec%iprcparm(prol_) + & prec%iprcparm(sub_prol_) end select call psb_geaxpby(alpha,ty,beta,y,desc_data,info) @@ -246,9 +246,8 @@ subroutine mld_zbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) endif end if case default - write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',& - & min_prec_,noprec_,diag_,bjac_,& - & ras_,asm_,ash_,rash_ + write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(prec_type_),':',& + & min_prec_,noprec_,diag_,bjac_,as_ end select call psb_erractionrestore(err_act) diff --git a/mld_zbaseprec_bld.f90 b/mld_zbaseprec_bld.f90 index 73d6d222..423be6fa 100644 --- a/mld_zbaseprec_bld.f90 +++ b/mld_zbaseprec_bld.f90 @@ -91,13 +91,13 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) ! Should add check to ensure all procs have the same... ! - call psb_check_def(p%iprcparm(p_type_),'base_prec',& + call psb_check_def(p%iprcparm(prec_type_),'base_prec',& & diag_,is_legal_base_prec) call psb_nullify_desc(p%desc_data) - select case(p%iprcparm(p_type_)) + select case(p%iprcparm(prec_type_)) case (noprec_) ! Do nothing. call psb_cdcpy(desc_a,p%desc_data,info) @@ -119,22 +119,22 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) goto 9999 end if - case (bjac_,asm_) + case (bjac_,as_) call psb_check_def(p%iprcparm(n_ovr_),'overlap',& & 0,is_legal_n_ovr) - call psb_check_def(p%iprcparm(restr_),'restriction',& + call psb_check_def(p%iprcparm(sub_restr_),'restriction',& & psb_halo_,is_legal_restrict) - call psb_check_def(p%iprcparm(prol_),'prolongator',& + call psb_check_def(p%iprcparm(sub_prol_),'prolongator',& & psb_none_,is_legal_prolong) - call psb_check_def(p%iprcparm(iren_),'renumbering',& + call psb_check_def(p%iprcparm(sub_ren_),'renumbering',& & renum_none_,is_legal_renum) - call psb_check_def(p%iprcparm(f_type_),'fact',& - & f_ilu_n_,is_legal_ml_fact) + call psb_check_def(p%iprcparm(sub_solve_),'fact',& + & ilu_n_,is_legal_ml_fact) - if (p%iprcparm(f_type_)==f_slud_) then + if (p%iprcparm(sub_solve_)==sludist_) then p%iprcparm(n_ovr_) = 0 - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if if (debug) write(0,*)me, ': Calling mld_bjac_bld' @@ -149,7 +149,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) case default info=4010 - ch_err='Unknown p_type_' + ch_err='Unknown prec_type_' call psb_errpush(info,name,a_err=ch_err) goto 9999 diff --git a/mld_zbjac_aply.f90 b/mld_zbjac_aply.f90 index 3424508a..8e318666 100644 --- a/mld_zbjac_aply.f90 +++ b/mld_zbjac_aply.f90 @@ -108,11 +108,11 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) endif - if (prec%iprcparm(jac_sweeps_) == 1) then + if (prec%iprcparm(smooth_sweeps_) == 1) then - select case(prec%iprcparm(f_type_)) - case(f_ilu_n_,f_ilu_e_) + select case(prec%iprcparm(sub_solve_)) + case(ilu_n_,ilu_t_) select case(toupper(trans)) case('N') @@ -134,7 +134,7 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) end select - case(f_slu_) + case(slu_) ww(1:n_row) = x(1:n_row) @@ -150,7 +150,7 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 call psb_geaxpby(alpha,ww,beta,y,desc_data,info) - case(f_slud_) + case(sludist_) !!$ write(0,*) 'Calling SLUDist_solve ',n_row ww(1:n_row) = x(1:n_row) @@ -167,7 +167,7 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 call psb_geaxpby(alpha,ww,beta,y,desc_data,info) - case (f_umf_) + case (umf_) select case(toupper(trans)) @@ -184,11 +184,11 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) call psb_geaxpby(alpha,ww,beta,y,desc_data,info) case default - write(0,*) 'Unknown factorization type in bjac_aply',prec%iprcparm(f_type_) + write(0,*) 'Unknown factorization type in bjac_aply',prec%iprcparm(sub_solve_) end select if (debugprt) write(0,*)' Y: ',y(:) - else if (prec%iprcparm(jac_sweeps_) > 1) then + else if (prec%iprcparm(smooth_sweeps_) > 1) then ! Note: we have to add TRANS to this one !!!!!!!!! @@ -207,9 +207,9 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) tx = zzero ty = zzero - select case(prec%iprcparm(f_type_)) - case(f_ilu_n_,f_ilu_e_) - do i=1, prec%iprcparm(jac_sweeps_) + select case(prec%iprcparm(sub_solve_)) + case(ilu_n_,ilu_t_) + do i=1, prec%iprcparm(smooth_sweeps_) ! X(k+1) = M^-1*(b-N*X(k)) ty(1:n_row) = x(1:n_row) call psb_spmm(-zone,prec%av(ap_nd_),tx,zone,ty,& @@ -225,12 +225,12 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 end do - case(f_slud_) + case(sludist_) write(0,*) 'No sense in having SLUDist with JAC_SWEEPS >1' info=4010 goto 9999 - case(f_slu_) - do i=1, prec%iprcparm(jac_sweeps_) + case(slu_) + do i=1, prec%iprcparm(smooth_sweeps_) ! X(k+1) = M^-1*(b-N*X(k)) ty(1:n_row) = x(1:n_row) call psb_spmm(-zone,prec%av(ap_nd_),tx,zone,ty,& @@ -241,8 +241,8 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 tx(1:n_row) = ty(1:n_row) end do - case(f_umf_) - do i=1, prec%iprcparm(jac_sweeps_) + case(umf_) + do i=1, prec%iprcparm(smooth_sweeps_) ! X(k+1) = M^-1*(b-N*X(k)) ty(1:n_row) = x(1:n_row) call psb_spmm(-zone,prec%av(ap_nd_),tx,zone,ty,& @@ -266,7 +266,7 @@ subroutine mld_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) else info = 10 call psb_errpush(info,name,& - & i_err=(/2,prec%iprcparm(jac_sweeps_),0,0,0/)) + & i_err=(/2,prec%iprcparm(smooth_sweeps_),0,0,0/)) goto 9999 endif diff --git a/mld_zbjac_bld.f90 b/mld_zbjac_bld.f90 index 7954f381..7fa31069 100644 --- a/mld_zbjac_bld.f90 +++ b/mld_zbjac_bld.f90 @@ -107,9 +107,9 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) t1= psb_wtime() - if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(p_type_),p%iprcparm(n_ovr_) + if(debug) write(0,*)me,': calling mld_asmat_bld',p%iprcparm(prec_type_),p%iprcparm(n_ovr_) if (debug) call psb_barrier(ictxt) - call mld_asmat_bld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& + call mld_asmat_bld(p%iprcparm(prec_type_),p%iprcparm(n_ovr_),a,& & blck,desc_a,upd,p%desc_data,info,outfmt=coofmt) if(info/=0) then @@ -122,7 +122,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) if (debug) call psb_barrier(ictxt) - select case(p%iprcparm(iren_)) + select case(p%iprcparm(sub_ren_)) case (1:) @@ -157,7 +157,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if @@ -171,9 +171,9 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) if (debug) write(0,*) me,' Factoring rows ',& &atmp%m,a%m,blck%m,atmp%ia2(atmp%m+1)-1 - select case(p%iprcparm(f_type_)) + select case(p%iprcparm(sub_solve_)) - case(f_ilu_n_,f_ilu_e_) + case(ilu_n_,ilu_t_) call psb_ipcoo2csr(atmp,info) @@ -205,7 +205,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) endif - case(f_slu_) + case(slu_) call psb_ipcoo2csr(atmp,info) if (info /= 0) then @@ -219,7 +219,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) goto 9999 end if - case(f_umf_) + case(umf_) call psb_ipcoo2csc(atmp,info,clshr=.true.) if (info /= 0) then @@ -241,7 +241,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) case default info=4010 - call psb_errpush(info,name,a_err='Unknown f_type_') + call psb_errpush(info,name,a_err='Unknown sub_solve_') goto 9999 end select @@ -258,12 +258,12 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) case(0) ! No renumbering - select case(p%iprcparm(f_type_)) + select case(p%iprcparm(sub_solve_)) - case(f_ilu_n_,f_ilu_e_) + case(ilu_n_,ilu_t_) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then atmp%fida='COO' call psb_csdp(a,atmp,info) if (info /= 0) then @@ -293,7 +293,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if call psb_sp_free(atmp,info) end if @@ -328,7 +328,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) endif - case(f_slu_) + case(slu_) atmp%fida='COO' call psb_csdp(a,atmp,info) @@ -341,7 +341,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) n_col = psb_cd_get_local_cols(p%desc_data) call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ ! Split AC=M+N N off-diagonal part ! Output in COO format. @@ -361,7 +361,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if endif @@ -379,7 +379,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) end if - case(f_slud_) + case(sludist_) atmp%fida='COO' call psb_csdp(a,atmp,info) @@ -392,7 +392,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) n_col = psb_cd_get_local_cols(p%desc_data) call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ ! Split AC=M+N N off-diagonal part ! Output in COO format. @@ -412,7 +412,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if endif @@ -432,7 +432,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) end if !!$ - case(f_umf_) + case(umf_) atmp%fida='COO' @@ -446,7 +446,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) n_col = psb_cd_get_local_cols(p%desc_data) call psb_rwextd(n_row,atmp,info,b=blck,rowscale=.false.) - if (p%iprcparm(jac_sweeps_) > 1) then + if (p%iprcparm(smooth_sweeps_) > 1) then !------------------------------------------------------------------ ! Split AC=M+N N off-diagonal part ! Output in COO format. @@ -467,7 +467,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) ! If the off diagonal part is emtpy, there's no point ! in doing multiple Jacobi sweeps. This is certain ! to happen when running on a single processor. - p%iprcparm(jac_sweeps_) = 1 + p%iprcparm(smooth_sweeps_) = 1 end if endif @@ -498,7 +498,7 @@ subroutine mld_zbjac_bld(a,desc_a,p,upd,info) case default info=4010 - call psb_errpush(info,name,a_err='Unknown f_type_') + call psb_errpush(info,name,a_err='Unknown sub_solve_') goto 9999 end select diff --git a/mld_zmlprec_aply.f90 b/mld_zmlprec_aply.f90 index f3710267..4b71188e 100644 --- a/mld_zmlprec_aply.f90 +++ b/mld_zmlprec_aply.f90 @@ -138,7 +138,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) goto 9999 - case(add_ml_prec_) + case(add_ml_) ! @@ -191,9 +191,9 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%ty(:) = zzero - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! ! Smoothed aggregation ! @@ -217,9 +217,9 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end if - if (icm ==mat_repl_) Then + if (icm ==repl_mat_) Then call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm/= mat_distr_) Then + else if (icm/= distr_mat_) Then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ',icm endif @@ -235,10 +235,10 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then call psb_csmm(zone,baseprecv(ilev)%av(sm_pr_),mlprec_wrk(ilev)%y2l,& & zone,mlprec_wrk(ilev-1)%y2l,info) @@ -258,14 +258,14 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) if(info /=0) goto 9999 - case(mult_ml_prec_) + case(mult_ml) ! ! Multiplicative multilevel ! Pre/post smoothing versions. ! - select case(baseprecv(2)%iprcparm(smth_pos_)) + select case(baseprecv(2)%iprcparm(smooth_pos_)) case(post_smooth_) @@ -310,7 +310,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) if (debug) write(0,*) me, 'mlpr_aply starting up sweep ',& @@ -330,7 +330,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%x2l(:) = zzero mlprec_wrk(ilev)%y2l(:) = zzero mlprec_wrk(ilev)%tx(:) = zzero - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! ! Smoothed aggregation ! @@ -356,17 +356,17 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end if if (debug) write(0,*) me, 'mlpr_aply possible sum in up sweep ', & - & ilev,icm,associated(baseprecv(ilev)%base_desc),mat_repl_ + & ilev,icm,associated(baseprecv(ilev)%base_desc),repl_mat_ if (debug) write(0,*) me, 'mlpr_aply geaxpby in up sweep X', & & ilev,associated(baseprecv(ilev)%base_desc),& & baseprecv(ilev)%base_desc%matrix_data(psb_n_row_),& & baseprecv(ilev)%base_desc%matrix_data(psb_n_col_),& & size(mlprec_wrk(ilev)%tx),size(mlprec_wrk(ilev)%x2l) - if (icm == mat_repl_) Then + if (icm == repl_mat_) Then if (debug) write(0,*) 'Entering psb_sum ',nr2l call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm /= mat_distr_) Then + else if (icm /= distr_mat_) Then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ', icm endif call psb_geaxpby(zone,mlprec_wrk(ilev)%x2l,zzero,mlprec_wrk(ilev)%tx,& @@ -383,11 +383,11 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) do ilev=nlev-1, 1, -1 - ismth = baseprecv(ilev+1)%iprcparm(smth_kind_) + ismth = baseprecv(ilev+1)%iprcparm(aggr_kind_) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) - if (ismth /= no_smth_) then - if (ismth == smth_omg_) & + if (ismth /= no_smooth_) then + if (ismth == tent_prol) & & call psb_halo(mlprec_wrk(ilev+1)%y2l,baseprecv(ilev+1)%desc_data,& & info,work=work) call psb_csmm(zone,baseprecv(ilev+1)%av(sm_pr_),mlprec_wrk(ilev+1)%y2l,& @@ -473,7 +473,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) allocate(mlprec_wrk(ilev)%tx(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& @@ -490,7 +490,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%tx(:) = zzero - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! !Smoothed Aggregation ! @@ -514,9 +514,9 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end do end if - if (icm ==mat_repl_) then + if (icm ==repl_mat_) then call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm /= mat_distr_) then + else if (icm /= distr_mat_) then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ', icm endif @@ -537,12 +537,12 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) do ilev = nlev-1, 1, -1 - ismth = baseprecv(ilev+1)%iprcparm(smth_kind_) + ismth = baseprecv(ilev+1)%iprcparm(aggr_kind_) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then - if (ismth == smth_omg_) & + if (ismth == tent_prol) & & call psb_halo(mlprec_wrk(ilev+1)%y2l,& & baseprecv(ilev+1)%desc_data,info,work=work) call psb_csmm(zone,baseprecv(ilev+1)%av(sm_pr_),mlprec_wrk(ilev+1)%y2l,& @@ -568,7 +568,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) - case(smooth_both_) + case(twoside_smooth_) ! ! Symmetrized smoothing. @@ -629,7 +629,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) n_col = psb_cd_get_local_cols(baseprecv(ilev-1)%desc_data) nc2l = psb_cd_get_local_cols(baseprecv(ilev)%desc_data) nr2l = psb_cd_get_local_rows(baseprecv(ilev)%desc_data) - ismth = baseprecv(ilev)%iprcparm(smth_kind_) + ismth = baseprecv(ilev)%iprcparm(aggr_kind_) icm = baseprecv(ilev)%iprcparm(coarse_mat_) allocate(mlprec_wrk(ilev)%ty(nc2l),mlprec_wrk(ilev)%y2l(nc2l),& & mlprec_wrk(ilev)%x2l(nc2l), stat=info) @@ -647,7 +647,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) mlprec_wrk(ilev)%ty(:) = zzero - if (ismth /= no_smth_) then + if (ismth /= no_smooth_) then ! !Smoothed Aggregation ! @@ -671,9 +671,9 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) end do end if - if (icm == mat_repl_) then + if (icm == repl_mat_) then call psb_sum(ictxt,mlprec_wrk(ilev)%x2l(1:nr2l)) - else if (icm /= mat_distr_) then + else if (icm /= distr_mat_) then write(0,*) 'Unknown value for baseprecv(2)%iprcparm(coarse_mat_) ', icm endif @@ -698,11 +698,11 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) do ilev=nlev-1, 1, -1 - ismth = baseprecv(ilev+1)%iprcparm(smth_kind_) + ismth = baseprecv(ilev+1)%iprcparm(aggr_kind_) n_row = psb_cd_get_local_rows(baseprecv(ilev)%base_desc) - if (ismth /= no_smth_) then - if (ismth == smth_omg_) & + if (ismth /= no_smooth_) then + if (ismth == tent_prol) & & call psb_halo(mlprec_wrk(ilev+1)%y2l,baseprecv(ilev+1)%desc_data,& & info,work=work) call psb_csmm(zone,baseprecv(ilev+1)%av(sm_pr_),mlprec_wrk(ilev+1)%y2l,& @@ -737,7 +737,7 @@ subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) case default call psb_errpush(4013,name,a_err='wrong smooth_pos',& - & i_Err=(/baseprecv(2)%iprcparm(smth_pos_),0,0,0,0/)) + & i_Err=(/baseprecv(2)%iprcparm(smooth_pos_),0,0,0,0/)) goto 9999 end select diff --git a/mld_zmlprec_bld.f90 b/mld_zmlprec_bld.f90 index d3aceb46..85ca6306 100644 --- a/mld_zmlprec_bld.f90 +++ b/mld_zmlprec_bld.f90 @@ -69,26 +69,26 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info) goto 9999 endif call psb_check_def(p%iprcparm(ml_type_),'Multilevel type',& - & mult_ml_prec_,is_legal_ml_type) + & mult_ml,is_legal_ml_type) call psb_check_def(p%iprcparm(aggr_alg_),'aggregation',& - & loc_aggr_,is_legal_ml_aggr_kind) - call psb_check_def(p%iprcparm(smth_kind_),'Smoother kind',& - & smth_omg_,is_legal_ml_smth_kind) + & dec_aggr_,is_legal_ml_aggr_kind) + call psb_check_def(p%iprcparm(aggr_kind_),'Smoother kind',& + & tent_prol,is_legal_ml_smth_kind) call psb_check_def(p%iprcparm(coarse_mat_),'Coarse matrix',& - & mat_distr_,is_legal_ml_coarse_mat) - call psb_check_def(p%iprcparm(smth_pos_),'smooth_pos',& + & distr_mat_,is_legal_ml_coarse_mat) + call psb_check_def(p%iprcparm(smooth_pos_),'smooth_pos',& & pre_smooth_,is_legal_ml_smooth_pos) !!$ nullify(p%desc_data) - select case(p%iprcparm(f_type_)) - case(f_ilu_n_) - call psb_check_def(p%iprcparm(ilu_fill_in_),'Level',0,is_legal_ml_lev) - case(f_ilu_e_) + select case(p%iprcparm(sub_solve_)) + case(ilu_n_) + call psb_check_def(p%iprcparm(sub_fill_in_),'Level',0,is_legal_ml_lev) + case(ilu_t_) call psb_check_def(p%dprcparm(fact_eps_),'Eps',dzero,is_legal_ml_eps) end select - call psb_check_def(p%dprcparm(smooth_omega_),'omega',dzero,is_legal_omega) - call psb_check_def(p%iprcparm(jac_sweeps_),'Jacobi sweeps',& + call psb_check_def(p%dprcparm(aggr_damp_),'omega',dzero,is_legal_omega) + call psb_check_def(p%iprcparm(smooth_sweeps_),'Jacobi sweeps',& & 1,is_legal_jac_sweeps) diff --git a/mld_zsp_renum.f90 b/mld_zsp_renum.f90 index 2b70df76..10e7ebba 100644 --- a/mld_zsp_renum.f90 +++ b/mld_zsp_renum.f90 @@ -70,7 +70,7 @@ subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info) ! 1. Global column indices ! (2. GPS band reduction disabled for the time being) - if (p%iprcparm(iren_)==renum_glb_) then + if (p%iprcparm(sub_ren_)==renum_glb_) then atmp%m = a%m + blck%m atmp%k = a%k atmp%fida='CSR' @@ -183,7 +183,7 @@ subroutine mld_zsp_renum(a,desc_a,blck,p,atmp,info) deallocate(itmp,itmp2,ztmp) - else if (p%iprcparm(iren_)==renum_gps_) then + else if (p%iprcparm(sub_ren_)==renum_gps_) then atmp%m = a%m + blck%m atmp%k = a%k diff --git a/psb_dprecinit.f90 b/psb_dprecinit.f90 index f0bd858c..312f94bc 100644 --- a/psb_dprecinit.f90 +++ b/psb_dprecinit.f90 @@ -65,13 +65,13 @@ subroutine psb_dprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = noprec_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(prec_type_) = noprec_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = f_none_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('DIAG') nlev_ = 1 @@ -80,14 +80,14 @@ subroutine psb_dprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = diag_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = diag_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = f_none_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('BJAC') nlev_ = 1 @@ -96,15 +96,15 @@ subroutine psb_dprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = bjac_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('AS') nlev_ = 1 @@ -113,15 +113,15 @@ subroutine psb_dprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = asm_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_halo_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = as_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_halo_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('ML') @@ -139,58 +139,58 @@ subroutine psb_dprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = asm_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_halo_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = as_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_halo_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 if (nlev_ == 1) return do ilev_ = 2, nlev_ -1 if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml_prec_ - p%baseprecv(ilev_)%iprcparm(aggr_alg_) = loc_aggr_ - p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_ - p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_ - p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_ - p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 - p%baseprecv(ilev_)%dprcparm(smooth_omega_) = 4.d0/3.d0 + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = bjac_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml + p%baseprecv(ilev_)%iprcparm(aggr_alg_) = dec_aggr_ + p%baseprecv(ilev_)%iprcparm(aggr_kind_) = tent_prol + p%baseprecv(ilev_)%iprcparm(coarse_mat_) = distr_mat_ + p%baseprecv(ilev_)%iprcparm(smooth_pos_) = post_smooth_ + p%baseprecv(ilev_)%iprcparm(aggr_eig_) = max_norm_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 + p%baseprecv(ilev_)%dprcparm(aggr_damp_) = 4.d0/3.d0 end do ilev_ = nlev_ if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 - p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml_prec_ - p%baseprecv(ilev_)%iprcparm(aggr_alg_) = loc_aggr_ - p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_ - p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_ - p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_ - p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_umf_ - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 4 - p%baseprecv(ilev_)%dprcparm(smooth_omega_) = 4.d0/3.d0 + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = bjac_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 + p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 + p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml + p%baseprecv(ilev_)%iprcparm(aggr_alg_) = dec_aggr_ + p%baseprecv(ilev_)%iprcparm(aggr_kind_) = tent_prol + p%baseprecv(ilev_)%iprcparm(coarse_mat_) = distr_mat_ + p%baseprecv(ilev_)%iprcparm(smooth_pos_) = post_smooth_ + p%baseprecv(ilev_)%iprcparm(aggr_eig_) = max_norm_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = umf_ + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 4 + p%baseprecv(ilev_)%dprcparm(aggr_damp_) = 4.d0/3.d0 case default write(0,*) 'Unknown preconditioner type request "',ptype,'"' diff --git a/psb_dprecset.f90 b/psb_dprecset.f90 index 4323cfaf..3f5e80b8 100644 --- a/psb_dprecset.f90 +++ b/psb_dprecset.f90 @@ -49,12 +49,6 @@ subroutine psb_dprecseti(p,what,val,info,ilev) info = 0 - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - if (.not.allocated(p%baseprecv)) then write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner' info = -1 @@ -62,6 +56,12 @@ subroutine psb_dprecseti(p,what,val,info,ilev) endif nlev_ = size(p%baseprecv) + if (present(ilev)) then + ilev_ = ilev + else + ilev_ = 1 + end if + if ((ilev_<1).or.(ilev_ > nlev_)) then write(0,*) 'PRECSET ERRROR: ilev out of bounds' info = -1 @@ -74,25 +74,90 @@ subroutine psb_dprecseti(p,what,val,info,ilev) endif + if (present(ilev)) then + + if (ilev_ == 1) then + ! Rules for fine level are slightly different. + select case(what) + case(prec_type_,sub_solve_,sub_restr_,sub_prol_,sub_ren_,n_ovr_,sub_fill_in_,smooth_sweeps_) + p%baseprecv(ilev_)%iprcparm(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(prec_type_,sub_solve_,sub_restr_,sub_prol_,sub_ren_,n_ovr_,sub_fill_in_,& + & smooth_sweeps_,ml_type_,aggr_alg_,aggr_kind_,coarse_mat_,& + & smooth_pos_,aggr_eig_) + p%baseprecv(ilev_)%iprcparm(what) = val + case(coarse_solve_) + if (ilev_ /= nlev_) then + write(0,*) 'Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + p%baseprecv(ilev_)%iprcparm(sub_solve_) = val + case(coarse_sweeps_) + if (ilev_ /= nlev_) then + write(0,*) 'Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = val + case(coarse_fill_in_) + if (ilev_ /= nlev_) then + write(0,*) 'Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 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 + + select case(what) + case(prec_type_,sub_solve_,sub_restr_,sub_prol_,sub_ren_,n_ovr_,sub_fill_in_,& + & smooth_sweeps_,ml_type_,aggr_alg_,aggr_kind_,coarse_mat_,& + & smooth_pos_,aggr_eig_) + do ilev_=1,nlev_-1 + if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then + write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner' + info = -1 + return + endif + p%baseprecv(ilev_)%iprcparm(what) = val + end do + case(coarse_solve_) + 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(sub_solve_) = val + case(coarse_sweeps_) + 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(smooth_sweeps_) = val + case(coarse_fill_in_) + 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(sub_fill_in_) = val + case default + write(0,*) 'Error: trying to call PRECSET with an invalid WHAT' + info = -2 + end select - if (ilev_ == 1) then - ! Rules for fine level are slightly different. - select case(what) - case(p_type_,f_type_,restr_,prol_,iren_,n_ovr_,ilu_fill_in_,jac_sweeps_) - p%baseprecv(ilev_)%iprcparm(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(p_type_,f_type_,restr_,prol_,iren_,n_ovr_,ilu_fill_in_,jac_sweeps_,& - & ml_type_,aggr_alg_,smth_kind_,coarse_mat_,smth_pos_,om_choice_) - p%baseprecv(ilev_)%iprcparm(what) = val - case default - write(0,*) 'Error: trying to call PRECSET with an invalid WHAT' - info = -2 - end select endif end subroutine psb_dprecseti @@ -140,14 +205,14 @@ subroutine psb_dprecsetd(p,what,val,info,ilev) ! Rules for fine level are slightly different. select case(what) ! Right now we don't have any at base level. Will change when - ! we implement F_ILU_E_ + ! we implement ilu_t_ 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(smooth_omega_) + case(aggr_damp_) p%baseprecv(ilev_)%dprcparm(what) = val case default write(0,*) 'Error: trying to call PRECSET with an invalid WHAT' diff --git a/psb_prec_type.f90 b/psb_prec_type.f90 index af12686b..89404a54 100644 --- a/psb_prec_type.f90 +++ b/psb_prec_type.f90 @@ -132,20 +132,19 @@ module psb_prec_type ! Entries in iprcparm - integer, parameter :: p_type_=1 - integer, parameter :: f_type_=2 - integer, parameter :: restr_=3 - integer, parameter :: prol_=4 - integer, parameter :: iren_=5 + integer, parameter :: prec_type_=1 + integer, parameter :: sub_solve_=2 + integer, parameter :: sub_restr_=3 + integer, parameter :: sub_prol_=4 + integer, parameter :: sub_ren_=5 integer, parameter :: n_ovr_=6 - integer, parameter :: ilu_fill_in_=8 - integer, parameter :: jac_sweeps_=9 + integer, parameter :: sub_fill_in_=8 + integer, parameter :: smooth_sweeps_=9 integer, parameter :: ml_type_=10 - integer, parameter :: smth_pos_=11 + integer, parameter :: smooth_pos_=11 integer, parameter :: aggr_alg_=12 - integer, parameter :: smth_kind_=13 - integer, parameter :: om_choice_=14 - integer, parameter :: aggr_eig_ =15 + integer, parameter :: aggr_kind_=13 + integer, parameter :: aggr_eig_=14 integer, parameter :: coarse_mat_=16 !! 2 ints for 64 bit versions integer, parameter :: slu_ptr_=17 @@ -158,38 +157,35 @@ module psb_prec_type integer, parameter :: coarse_fill_in_=27 integer, parameter :: ifpsz=32 - ! Legal values for entry: p_type_ + ! Legal values for entry: prec_type_ integer, parameter :: min_prec_=0, noprec_=0, diag_=1, bjac_=2,& - & ras_=3,asm_=4, ash_=5, rash_=6, ras2lv_=7, ras2lvm_=8,& - & lv2mras_=9, lv2smth_=10, lv2lsm_=11, sl2sm_=12, superlu_=13,& - & new_loc_smth_=14, new_glb_smth_=15, ag2lsm_=16,& - & msy2l_=18, msy2g_=19, max_prec_=19 + & as_=3, max_prec_=3 ! Legal values for entry: ml_type_ - integer, parameter :: no_ml_=0, add_ml_prec_=1, mult_ml_prec_=2 + integer, parameter :: no_ml_=0, add_ml_=1, mult_ml=2 integer, parameter :: new_ml_prec_=3, max_ml_=new_ml_prec_ - ! Legal values for entry: smth_pos_ - integer, parameter :: pre_smooth_=1, post_smooth_=2, smooth_both_=3,& - & max_smooth_=smooth_both_ - ! Legal values for entry: f_type_ - integer, parameter :: f_none_=0,f_ilu_n_=1,f_ilu_e_=2,f_slu_=3 - integer, parameter :: f_umf_=4, f_slud_=5 + ! Legal values for entry: smooth_pos_ + integer, parameter :: pre_smooth_=1, post_smooth_=2, twoside_smooth_=3,& + & max_smooth_=twoside_smooth_ + ! Legal values for entry: sub_solve_ + integer, parameter :: f_none_=0,ilu_n_=1,ilu_t_=2,slu_=3 + integer, parameter :: umf_=4, sludist_=5 ! Legal values for entry: aggr_alg_ - integer, parameter :: loc_aggr_=0, glb_aggr_=1, new_loc_aggr_=2 + integer, parameter :: dec_aggr_=0, glb_aggr_=1, new_dec_aggr_=2 integer, parameter :: new_glb_aggr_=3, max_aggr_=new_glb_aggr_ - ! Legal values for entry: smth_kind_ - integer, parameter :: no_smth_=0, smth_omg_=1, smth_biz_=2 - ! Legal values for entry: om_choice_ - integer, parameter :: lib_choice_=0, user_choice_=999 + ! Legal values for entry: aggr_kind_ + integer, parameter :: no_smooth_=0, tent_prol=1, biz_prol_=2 + ! Legal values for entry: aggr_eig_ + integer, parameter :: max_norm_=0, user_choice_=999 ! Legal values for entry: coarse_mat_ - integer, parameter :: mat_distr_=0, mat_repl_=1 + integer, parameter :: distr_mat_=0, repl_mat_=1 ! Legal values for entry: prec_status_ integer, parameter :: prec_built=98765 - ! Legal values for entry: iren_ + ! Legal values for entry: sub_ren_ integer, parameter :: renum_none_=0, renum_glb_=1, renum_gps_=2 ! Entries in dprcparm: ILU(E) epsilon, smoother omega integer, parameter :: fact_eps_=1 - integer, parameter :: smooth_omega_=2 + integer, parameter :: aggr_damp_=2 integer, parameter :: aggr_thresh_=3 integer, parameter :: dfpsz=4 ! Fields for sparse matrices ensembles stored in av() @@ -290,14 +286,14 @@ contains if (allocated(prec%iprcparm)) then val = val + 4 * size(prec%iprcparm) if (prec%iprcparm(prec_status_) == prec_built) then - select case(prec%iprcparm(f_type_)) - case(f_ilu_n_,f_ilu_e_) + select case(prec%iprcparm(sub_solve_)) + case(ilu_n_,ilu_t_) ! do nothing - case(f_slu_) + case(slu_) write(0,*) 'Should implement check for size of SuperLU data structs' - case(f_umf_) + case(umf_) write(0,*) 'Should implement check for size of UMFPACK data structs' - case(f_slud_) + case(sludist_) write(0,*) 'Should implement check for size of SuperLUDist data structs' case default end select @@ -329,14 +325,14 @@ contains if (allocated(prec%iprcparm)) then val = val + 4 * size(prec%iprcparm) if (prec%iprcparm(prec_status_) == prec_built) then - select case(prec%iprcparm(f_type_)) - case(f_ilu_n_,f_ilu_e_) + select case(prec%iprcparm(sub_solve_)) + case(ilu_n_,ilu_t_) ! do nothing - case(f_slu_) + case(slu_) write(0,*) 'Should implement check for size of SuperLU data structs' - case(f_umf_) + case(umf_) write(0,*) 'Should implement check for size of UMFPACK data structs' - case(f_slud_) + case(sludist_) write(0,*) 'Should implement check for size of SuperLUDist data structs' case default end select @@ -382,23 +378,23 @@ contains if (allocated(p%baseprecv)) then if (size(p%baseprecv)>=1) then write(iout,*) 'Base preconditioner' - select case(p%baseprecv(1)%iprcparm(p_type_)) + select case(p%baseprecv(1)%iprcparm(prec_type_)) case(noprec_) write(iout,*) 'No preconditioning' case(diag_) write(iout,*) 'Diagonal scaling' case(bjac_) write(iout,*) 'Block Jacobi with: ',& - & fact_names(p%baseprecv(1)%iprcparm(f_type_)) - case(asm_,ras_,ash_,rash_) + & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) + case(as_) write(iout,*) 'Additive Schwarz with: ',& - & fact_names(p%baseprecv(1)%iprcparm(f_type_)) + & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) write(iout,*) 'Overlap:',& & p%baseprecv(1)%iprcparm(n_ovr_) write(iout,*) 'Restriction: ',& - & restrict_names(p%baseprecv(1)%iprcparm(restr_)) + & restrict_names(p%baseprecv(1)%iprcparm(sub_restr_)) write(iout,*) 'Prolongation: ',& - & prolong_names(p%baseprecv(1)%iprcparm(prol_)) + & prolong_names(p%baseprecv(1)%iprcparm(sub_prol_)) end select end if if (size(p%baseprecv)>=2) then @@ -415,12 +411,12 @@ contains write(iout,*) 'Multilevel aggregation: ', & & aggr_names(p%baseprecv(ilev)%iprcparm(aggr_alg_)) write(iout,*) 'Smoother: ', & - & smooth_kinds(p%baseprecv(ilev)%iprcparm(smth_kind_)) - if (p%baseprecv(ilev)%iprcparm(smth_kind_) /= no_smth_) then + & smooth_kinds(p%baseprecv(ilev)%iprcparm(aggr_kind_)) + if (p%baseprecv(ilev)%iprcparm(aggr_kind_) /= no_smooth_) then write(iout,*) 'Smoothing omega: ', & - & p%baseprecv(ilev)%dprcparm(smooth_omega_) + & p%baseprecv(ilev)%dprcparm(aggr_damp_) write(iout,*) 'Smoothing position: ',& - & smooth_names(p%baseprecv(ilev)%iprcparm(smth_pos_)) + & smooth_names(p%baseprecv(ilev)%iprcparm(smooth_pos_)) end if write(iout,*) 'Coarse matrix: ',& & matrix_names(p%baseprecv(ilev)%iprcparm(coarse_mat_)) @@ -429,18 +425,18 @@ contains & sum( p%baseprecv(ilev)%nlaggr(:)),' : ',p%baseprecv(ilev)%nlaggr(:) end if write(iout,*) 'Factorization type: ',& - & fact_names(p%baseprecv(ilev)%iprcparm(f_type_)) - select case(p%baseprecv(ilev)%iprcparm(f_type_)) - case(f_ilu_n_) - write(iout,*) 'Fill level :',p%baseprecv(ilev)%iprcparm(ilu_fill_in_) - case(f_ilu_e_) + & fact_names(p%baseprecv(ilev)%iprcparm(sub_solve_)) + select case(p%baseprecv(ilev)%iprcparm(sub_solve_)) + case(ilu_n_) + write(iout,*) 'Fill level :',p%baseprecv(ilev)%iprcparm(sub_fill_in_) + case(ilu_t_) write(iout,*) 'Fill threshold :',p%baseprecv(ilev)%dprcparm(fact_eps_) - case(f_slu_,f_umf_,f_slud_) + case(slu_,umf_,sludist_) case default write(iout,*) 'Should never get here!' end select write(iout,*) 'Number of Jacobi sweeps: ', & - & (p%baseprecv(ilev)%iprcparm(jac_sweeps_)) + & (p%baseprecv(ilev)%iprcparm(smooth_sweeps_)) end if end do end if @@ -461,23 +457,23 @@ contains !!$ if (associated(p%baseprecv)) then !!$ if (size(p%baseprecv)>=1) then !!$ write(iout,*) 'Base preconditioner' -!!$ select case(p%baseprecv(1)%iprcparm(p_type_)) +!!$ select case(p%baseprecv(1)%iprcparm(prec_type_)) !!$ case(noprec_) !!$ write(iout,*) 'No preconditioning' !!$ case(diag_) !!$ write(iout,*) 'Diagonal scaling' !!$ case(bjac_) !!$ write(iout,*) 'Block Jacobi with: ',& -!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) -!!$ case(asm_,ras_,ash_,rash_) +!!$ & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) +!!$ case(as_,ras_,ash_,rash_) !!$ write(iout,*) 'Additive Schwarz with: ',& -!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) +!!$ & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) !!$ write(iout,*) 'Overlap:',& !!$ & p%baseprecv(1)%iprcparm(n_ovr_) !!$ write(iout,*) 'Restriction: ',& -!!$ & restrict_names(p%baseprecv(1)%iprcparm(restr_)) +!!$ & restrict_names(p%baseprecv(1)%iprcparm(sub_restr_)) !!$ write(iout,*) 'Prolongation: ',& -!!$ & prolong_names(p%baseprecv(1)%iprcparm(prol_)) +!!$ & prolong_names(p%baseprecv(1)%iprcparm(sub_prol_)) !!$ end select !!$ end if !!$ if (size(p%baseprecv)>=2) then @@ -490,25 +486,25 @@ contains !!$ write(iout,*) 'Multilevel aggregation: ', & !!$ & aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_)) !!$ write(iout,*) 'Smoother: ', & -!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_)) -!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_) +!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(aggr_kind_)) +!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(aggr_damp_) !!$ write(iout,*) 'Smoothing position: ',& -!!$ & smooth_names(p%baseprecv(2)%iprcparm(smth_pos_)) +!!$ & smooth_names(p%baseprecv(2)%iprcparm(smooth_pos_)) !!$ write(iout,*) 'Coarse matrix: ',& !!$ & matrix_names(p%baseprecv(2)%iprcparm(coarse_mat_)) !!$ write(iout,*) 'Factorization type: ',& -!!$ & fact_names(p%baseprecv(2)%iprcparm(f_type_)) -!!$ select case(p%baseprecv(2)%iprcparm(f_type_)) -!!$ case(f_ilu_n_) -!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_) -!!$ case(f_ilu_e_) +!!$ & fact_names(p%baseprecv(2)%iprcparm(sub_solve_)) +!!$ select case(p%baseprecv(2)%iprcparm(sub_solve_)) +!!$ case(ilu_n_) +!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(sub_fill_in_) +!!$ case(ilu_t_) !!$ write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_) -!!$ case(f_slu_,f_umf_,f_slud_) +!!$ case(slu_,umf_,sludist_) !!$ case default !!$ write(iout,*) 'Should never get here!' !!$ end select !!$ write(iout,*) 'Number of Jacobi sweeps: ', & -!!$ & (p%baseprecv(2)%iprcparm(jac_sweeps_)) +!!$ & (p%baseprecv(2)%iprcparm(smooth_sweeps_)) !!$ !!$ end if !!$ end if @@ -530,23 +526,23 @@ contains if (allocated(p%baseprecv)) then if (size(p%baseprecv)>=1) then write(iout,*) 'Base preconditioner' - select case(p%baseprecv(1)%iprcparm(p_type_)) + select case(p%baseprecv(1)%iprcparm(prec_type_)) case(noprec_) write(iout,*) 'No preconditioning' case(diag_) write(iout,*) 'Diagonal scaling' case(bjac_) write(iout,*) 'Block Jacobi with: ',& - & fact_names(p%baseprecv(1)%iprcparm(f_type_)) - case(asm_,ras_,ash_,rash_) + & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) + case(as_) write(iout,*) 'Additive Schwarz with: ',& - & fact_names(p%baseprecv(1)%iprcparm(f_type_)) + & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) write(iout,*) 'Overlap:',& & p%baseprecv(1)%iprcparm(n_ovr_) write(iout,*) 'Restriction: ',& - & restrict_names(p%baseprecv(1)%iprcparm(restr_)) + & restrict_names(p%baseprecv(1)%iprcparm(sub_restr_)) write(iout,*) 'Prolongation: ',& - & prolong_names(p%baseprecv(1)%iprcparm(prol_)) + & prolong_names(p%baseprecv(1)%iprcparm(sub_prol_)) end select end if if (size(p%baseprecv)>=2) then @@ -559,11 +555,11 @@ contains write(iout,*) 'Multilevel aggregation: ', & & aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_)) write(iout,*) 'Smoother: ', & - & smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_)) - if (p%baseprecv(2)%iprcparm(smth_kind_) /= no_smth_) then - write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_) + & smooth_kinds(p%baseprecv(2)%iprcparm(aggr_kind_)) + if (p%baseprecv(2)%iprcparm(aggr_kind_) /= no_smooth_) then + write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(aggr_damp_) write(iout,*) 'Smoothing position: ',& - & smooth_names(p%baseprecv(2)%iprcparm(smth_pos_)) + & smooth_names(p%baseprecv(2)%iprcparm(smooth_pos_)) end if write(iout,*) 'Coarse matrix: ',& @@ -573,18 +569,18 @@ contains & sum( p%baseprecv(2)%nlaggr(:)),' : ',p%baseprecv(2)%nlaggr(:) endif write(iout,*) 'Factorization type: ',& - & fact_names(p%baseprecv(2)%iprcparm(f_type_)) - select case(p%baseprecv(2)%iprcparm(f_type_)) - case(f_ilu_n_) - write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_) - case(f_ilu_e_) + & fact_names(p%baseprecv(2)%iprcparm(sub_solve_)) + select case(p%baseprecv(2)%iprcparm(sub_solve_)) + case(ilu_n_) + write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(sub_fill_in_) + case(ilu_t_) write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_) - case(f_slu_,f_umf_,f_slud_) + case(slu_,umf_,sludist_) case default write(iout,*) 'Should never get here!' end select write(iout,*) 'Number of Jacobi sweeps: ', & - & (p%baseprecv(2)%iprcparm(jac_sweeps_)) + & (p%baseprecv(2)%iprcparm(smooth_sweeps_)) end if end if @@ -605,23 +601,23 @@ contains !!$ if (associated(p%baseprecv)) then !!$ if (size(p%baseprecv)>=1) then !!$ write(iout,*) 'Base preconditioner' -!!$ select case(p%baseprecv(1)%iprcparm(p_type_)) +!!$ select case(p%baseprecv(1)%iprcparm(prec_type_)) !!$ case(noprec_) !!$ write(iout,*) 'No preconditioning' !!$ case(diag_) !!$ write(iout,*) 'Diagonal scaling' !!$ case(bjac_) !!$ write(iout,*) 'Block Jacobi with: ',& -!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) -!!$ case(asm_,ras_,ash_,rash_) +!!$ & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) +!!$ case(as_,ras_,ash_,rash_) !!$ write(iout,*) 'Additive Schwarz with: ',& -!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) +!!$ & fact_names(p%baseprecv(1)%iprcparm(sub_solve_)) !!$ write(iout,*) 'Overlap:',& !!$ & p%baseprecv(1)%iprcparm(n_ovr_) !!$ write(iout,*) 'Restriction: ',& -!!$ & restrict_names(p%baseprecv(1)%iprcparm(restr_)) +!!$ & restrict_names(p%baseprecv(1)%iprcparm(sub_restr_)) !!$ write(iout,*) 'Prolongation: ',& -!!$ & prolong_names(p%baseprecv(1)%iprcparm(prol_)) +!!$ & prolong_names(p%baseprecv(1)%iprcparm(sub_prol_)) !!$ end select !!$ end if !!$ if (size(p%baseprecv)>=2) then @@ -634,25 +630,25 @@ contains !!$ write(iout,*) 'Multilevel aggregation: ', & !!$ & aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_)) !!$ write(iout,*) 'Smoother: ', & -!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_)) -!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_) +!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(aggr_kind_)) +!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(aggr_damp_) !!$ write(iout,*) 'Smoothing position: ',& -!!$ & smooth_names(p%baseprecv(2)%iprcparm(smth_pos_)) +!!$ & smooth_names(p%baseprecv(2)%iprcparm(smooth_pos_)) !!$ write(iout,*) 'Coarse matrix: ',& !!$ & matrix_names(p%baseprecv(2)%iprcparm(coarse_mat_)) !!$ write(iout,*) 'Factorization type: ',& -!!$ & fact_names(p%baseprecv(2)%iprcparm(f_type_)) -!!$ select case(p%baseprecv(2)%iprcparm(f_type_)) -!!$ case(f_ilu_n_) -!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_) -!!$ case(f_ilu_e_) +!!$ & fact_names(p%baseprecv(2)%iprcparm(sub_solve_)) +!!$ select case(p%baseprecv(2)%iprcparm(sub_solve_)) +!!$ case(ilu_n_) +!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(sub_fill_in_) +!!$ case(ilu_t_) !!$ write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_) -!!$ case(f_slu_,f_umf_,f_slud_) +!!$ case(slu_,umf_,sludist_) !!$ case default !!$ write(iout,*) 'Should never get here!' !!$ end select !!$ write(iout,*) 'Number of Jacobi sweeps: ', & -!!$ & (p%baseprecv(2)%iprcparm(jac_sweeps_)) +!!$ & (p%baseprecv(2)%iprcparm(smooth_sweeps_)) !!$ !!$ end if !!$ end if @@ -672,7 +668,7 @@ contains integer, intent(in) :: ip logical :: is_legal_base_prec - is_legal_base_prec = ((ip>=noprec_).and.(ip<=rash_)) + is_legal_base_prec = ((ip>=noprec_).and.(ip<=max_prec_)) return end function is_legal_base_prec function is_legal_n_ovr(ip) @@ -726,7 +722,7 @@ contains integer, intent(in) :: ip logical :: is_legal_ml_aggr_kind - is_legal_ml_aggr_kind = ((ip>=loc_aggr_).and.(ip<=max_aggr_)) + is_legal_ml_aggr_kind = ((ip>=dec_aggr_).and.(ip<=max_aggr_)) return end function is_legal_ml_aggr_kind function is_legal_ml_smooth_pos(ip) @@ -742,7 +738,7 @@ contains integer, intent(in) :: ip logical :: is_legal_ml_smth_kind - is_legal_ml_smth_kind = ((ip>=no_smth_).and.(ip<=smth_biz_)) + is_legal_ml_smth_kind = ((ip>=no_smooth_).and.(ip<=biz_prol_)) return end function is_legal_ml_smth_kind function is_legal_ml_coarse_mat(ip) @@ -750,7 +746,7 @@ contains integer, intent(in) :: ip logical :: is_legal_ml_coarse_mat - is_legal_ml_coarse_mat = ((ip>=mat_distr_).and.(ip<=mat_repl_)) + is_legal_ml_coarse_mat = ((ip>=distr_mat_).and.(ip<=repl_mat_)) return end function is_legal_ml_coarse_mat function is_legal_ml_fact(ip) @@ -758,7 +754,7 @@ contains integer, intent(in) :: ip logical :: is_legal_ml_fact - is_legal_ml_fact = ((ip>=f_ilu_n_).and.(ip<=f_slud_)) + is_legal_ml_fact = ((ip>=ilu_n_).and.(ip<=sludist_)) return end function is_legal_ml_fact function is_legal_ml_lev(ip) @@ -885,13 +881,13 @@ contains endif if (allocated(p%iprcparm)) then - if (p%iprcparm(f_type_)==f_slu_) then + if (p%iprcparm(sub_solve_)==slu_) then call mld_dslu_free(p%iprcparm(slu_ptr_),info) end if - if (p%iprcparm(f_type_)==f_slud_) then + if (p%iprcparm(sub_solve_)==sludist_) then call mld_dsludist_free(p%iprcparm(slud_ptr_),info) end if - if (p%iprcparm(f_type_)==f_umf_) then + if (p%iprcparm(sub_solve_)==umf_) then call mld_dumf_free(p%iprcparm(umf_symptr_),& & p%iprcparm(umf_numptr_),info) end if @@ -968,10 +964,10 @@ contains endif if (allocated(p%iprcparm)) then - if (p%iprcparm(f_type_)==f_slu_) then + if (p%iprcparm(sub_solve_)==slu_) then call mld_zslu_free(p%iprcparm(slu_ptr_),info) end if - if (p%iprcparm(f_type_)==f_umf_) then + if (p%iprcparm(sub_solve_)==umf_) then call mld_zumf_free(p%iprcparm(umf_symptr_),& & p%iprcparm(umf_numptr_),info) end if @@ -1005,14 +1001,8 @@ contains pr_to_str='DIAG' case(bjac_) pr_to_str='BJAC' - case(asm_) - pr_to_str='ASM' - case(ash_) - pr_to_str='ASM' - case(ras_) - pr_to_str='ASM' - case(rash_) - pr_to_str='ASM' + case(as_) + pr_to_str='AS' end select end function pr_to_str diff --git a/psb_zprecinit.f90 b/psb_zprecinit.f90 index 7a54179a..3ab92e6a 100644 --- a/psb_zprecinit.f90 +++ b/psb_zprecinit.f90 @@ -65,13 +65,13 @@ subroutine psb_zprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = noprec_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = noprec_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = f_none_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('DIAG') nlev_ = 1 @@ -80,13 +80,13 @@ subroutine psb_zprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(p_type_) = diag_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = diag_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = f_none_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('BJAC') nlev_ = 1 @@ -96,14 +96,14 @@ subroutine psb_zprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return p%baseprecv(ilev_)%iprcparm(:) = 0 - p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = bjac_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('ASM','AS') nlev_ = 1 @@ -112,14 +112,14 @@ subroutine psb_zprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(p_type_) = asm_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_halo_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = as_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_halo_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 1 - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 case ('MLD', 'ML') @@ -137,55 +137,55 @@ subroutine psb_zprecinit(p,ptype,info,nlev) if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(p_type_) = asm_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_halo_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = as_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_halo_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 1 - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 if (nlev_ == 1) return do ilev_ = 2, nlev_ -1 if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = bjac_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml_prec_ - p%baseprecv(ilev_)%iprcparm(aggr_alg_) = loc_aggr_ - p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_ - p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_ - p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_ - p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 - p%baseprecv(ilev_)%dprcparm(smooth_omega_) = 4.d0/3.d0 + p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml + p%baseprecv(ilev_)%iprcparm(aggr_alg_) = dec_aggr_ + p%baseprecv(ilev_)%iprcparm(aggr_kind_) = tent_prol + p%baseprecv(ilev_)%iprcparm(coarse_mat_) = distr_mat_ + p%baseprecv(ilev_)%iprcparm(smooth_pos_) = post_smooth_ + p%baseprecv(ilev_)%iprcparm(aggr_eig_) = max_norm_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = ilu_n_ + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 1 + p%baseprecv(ilev_)%dprcparm(aggr_damp_) = 4.d0/3.d0 end do ilev_ = nlev_ if (info == 0) call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) if (info /= 0) return - p%baseprecv(ilev_)%iprcparm(p_type_) = bjac_ - p%baseprecv(ilev_)%iprcparm(restr_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_ - p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(prec_type_) = bjac_ + p%baseprecv(ilev_)%iprcparm(sub_restr_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_prol_) = psb_none_ + p%baseprecv(ilev_)%iprcparm(sub_ren_) = 0 p%baseprecv(ilev_)%iprcparm(n_ovr_) = 0 - p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml_prec_ - p%baseprecv(ilev_)%iprcparm(aggr_alg_) = loc_aggr_ - p%baseprecv(ilev_)%iprcparm(smth_kind_) = smth_omg_ - p%baseprecv(ilev_)%iprcparm(coarse_mat_) = mat_distr_ - p%baseprecv(ilev_)%iprcparm(smth_pos_) = post_smooth_ - p%baseprecv(ilev_)%iprcparm(om_choice_) = lib_choice_ - p%baseprecv(ilev_)%iprcparm(f_type_) = f_umf_ - p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 - p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 4 - p%baseprecv(ilev_)%dprcparm(smooth_omega_) = 4.d0/3.d0 + p%baseprecv(ilev_)%iprcparm(ml_type_) = mult_ml + p%baseprecv(ilev_)%iprcparm(aggr_alg_) = dec_aggr_ + p%baseprecv(ilev_)%iprcparm(aggr_kind_) = tent_prol + p%baseprecv(ilev_)%iprcparm(coarse_mat_) = distr_mat_ + p%baseprecv(ilev_)%iprcparm(smooth_pos_) = post_smooth_ + p%baseprecv(ilev_)%iprcparm(aggr_eig_) = max_norm_ + p%baseprecv(ilev_)%iprcparm(sub_solve_) = umf_ + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = 4 + p%baseprecv(ilev_)%dprcparm(aggr_damp_) = 4.d0/3.d0 case default write(0,*) 'Unknown preconditioner type request "',ptype,'"' diff --git a/psb_zprecset.f90 b/psb_zprecset.f90 index e39dcc70..329e70f2 100644 --- a/psb_zprecset.f90 +++ b/psb_zprecset.f90 @@ -50,12 +50,6 @@ subroutine psb_zprecseti(p,what,val,info,ilev) info = 0 - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - if (.not.allocated(p%baseprecv)) then write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner' info = -1 @@ -63,6 +57,12 @@ subroutine psb_zprecseti(p,what,val,info,ilev) endif nlev_ = size(p%baseprecv) + if (present(ilev)) then + ilev_ = ilev + else + ilev_ = 1 + end if + if ((ilev_<1).or.(ilev_ > nlev_)) then write(0,*) 'PRECSET ERRROR: ilev out of bounds' info = -1 @@ -75,25 +75,90 @@ subroutine psb_zprecseti(p,what,val,info,ilev) endif + if (present(ilev)) then + + if (ilev_ == 1) then + ! Rules for fine level are slightly different. + select case(what) + case(prec_type_,sub_solve_,sub_restr_,sub_prol_,sub_ren_,n_ovr_,sub_fill_in_,smooth_sweeps_) + p%baseprecv(ilev_)%iprcparm(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(prec_type_,sub_solve_,sub_restr_,sub_prol_,sub_ren_,n_ovr_,sub_fill_in_,& + & smooth_sweeps_,ml_type_,aggr_alg_,aggr_kind_,coarse_mat_,& + & smooth_pos_,aggr_eig_) + p%baseprecv(ilev_)%iprcparm(what) = val + case(coarse_solve_) + if (ilev_ /= nlev_) then + write(0,*) 'Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + p%baseprecv(ilev_)%iprcparm(sub_solve_) = val + case(coarse_sweeps_) + if (ilev_ /= nlev_) then + write(0,*) 'Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + p%baseprecv(ilev_)%iprcparm(smooth_sweeps_) = val + case(coarse_fill_in_) + if (ilev_ /= nlev_) then + write(0,*) 'Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + p%baseprecv(ilev_)%iprcparm(sub_fill_in_) = 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 + + select case(what) + case(prec_type_,sub_solve_,sub_restr_,sub_prol_,sub_ren_,n_ovr_,sub_fill_in_,& + & smooth_sweeps_,ml_type_,aggr_alg_,aggr_kind_,coarse_mat_,& + & smooth_pos_,aggr_eig_) + do ilev_=1,nlev_-1 + if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then + write(0,*) 'Error: trying to call PRECSET on an uninitialized preconditioner' + info = -1 + return + endif + p%baseprecv(ilev_)%iprcparm(what) = val + end do + case(coarse_solve_) + 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(sub_solve_) = val + case(coarse_sweeps_) + 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(smooth_sweeps_) = val + case(coarse_fill_in_) + 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(sub_fill_in_) = val + case default + write(0,*) 'Error: trying to call PRECSET with an invalid WHAT' + info = -2 + end select - if (ilev_ == 1) then - ! Rules for fine level are slightly different. - select case(what) - case(p_type_,f_type_,restr_,prol_,iren_,n_ovr_,ilu_fill_in_,jac_sweeps_) - p%baseprecv(ilev_)%iprcparm(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(p_type_,f_type_,restr_,prol_,iren_,n_ovr_,ilu_fill_in_,jac_sweeps_,& - & ml_type_,aggr_alg_,smth_kind_,coarse_mat_,smth_pos_,om_choice_) - p%baseprecv(ilev_)%iprcparm(what) = val - case default - write(0,*) 'Error: trying to call PRECSET with an invalid WHAT' - info = -2 - end select endif end subroutine psb_zprecseti @@ -141,14 +206,14 @@ subroutine psb_zprecsetd(p,what,val,info,ilev) ! Rules for fine level are slightly different. select case(what) ! Right now we don't have any at base level. Will change when - ! we implement F_ILU_E_ + ! we implement ilu_t_ 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(smooth_omega_) + case(aggr_damp_) p%baseprecv(ilev_)%dprcparm(what) = val case default write(0,*) 'Error: trying to call PRECSET with an invalid WHAT'