From 377340f221e320eaede278ce289a72ec1f5549c0 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 15 Sep 2018 10:22:35 +0100 Subject: [PATCH 01/16] Fix compilation for BCM example. Next we need to stitch together the codes. --- tests/Bcmatch/Makefile | 7 ++- .../mld_d_bcmatch_aggregator_mat_asb.f90 | 20 +----- .../Bcmatch/mld_d_bcmatch_aggregator_mod.F90 | 61 ++++++++++++++----- .../mld_d_bcmatch_aggregator_tprol.f90 | 13 ++-- tests/Bcmatch/mld_d_bcmatch_map_to_tprol.f90 | 3 +- .../Bcmatch/mld_daggrmat_unsmth_spmm_asb.f90 | 2 +- 6 files changed, 63 insertions(+), 43 deletions(-) diff --git a/tests/Bcmatch/Makefile b/tests/Bcmatch/Makefile index e0f9b6b2..42a1cf2b 100644 --- a/tests/Bcmatch/Makefile +++ b/tests/Bcmatch/Makefile @@ -24,16 +24,19 @@ BCM_INCDIR=$(BCM_DIR)/include BCM_LIBDIR=$(BCM_DIR)/lib BCM_LDLIBS=-lBCM -L$(BCM_LIBDIR) $(HSL_LIBS) $(SPRAL_LIBS) +CDEFINES=$(MLDCDEFINES) -I$(BCM_INCDIR) + LINKOPT= EXEDIR=./runs all: mld_d_pde3d BCMOBJS= mld_d_bcmatch_aggregator_mod.o mld_d_bcmatch_aggregator_mat_asb.o \ - mld_d_bcmatch_aggregator_tprol.o mld_d_bcmatch_map_to_tprol.o + mld_d_bcmatch_aggregator_tprol.o mld_d_bcmatch_map_to_tprol.o \ + mld_daggrmat_unsmth_spmm_asb.o bootCMatch_interface.o mld_d_pde3d: mld_d_pde3d.o data_input.o $(BCMOBJS) - $(FLINK) $(LINKOPT) mld_d_pde3d.o data_input.o $(BCMOBJS) -o mld_d_pde3d $(MLD_LIBS) $(BCMLIBS) $(PSBLAS_LIBS) $(LDLIBS) + $(FLINK) $(LINKOPT) mld_d_pde3d.o data_input.o $(BCMOBJS) -o mld_d_pde3d $(MLD_LIBS) $(BCM_LDLIBS) $(PSBLAS_LIBS) $(LDLIBS) /bin/mv mld_d_pde3d $(EXEDIR) mld_d_pde3d.o: data_input.o mld_d_bcmatch_aggregator_mod.o diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 index 3ec938d9..1566dced 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 @@ -156,7 +156,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac, integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit - name='mld_d_base_aggregator_mat_asb' + name='mld_d_bcmatch_aggregator_mat_asb' if (psb_get_errstatus().ne.0) return call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() @@ -165,26 +165,12 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%aggr_kind,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_kind) - call mld_check_def(parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(parms%smoother_pos,'smooth_pos',& - & mld_pre_smooth_,is_legal_ml_smooth_pos) - call mld_check_def(parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega) - ! ! Build the coarse-level matrix from the fine-level one, starting from ! the mapping defined by mld_aggrmap_bld and applying the aggregation - ! algorithm specified by p%iprcparm(mld_aggr_kind_) + ! algorithm specified by ! - select case (parms%aggr_kind) + select case (parms%aggr_prol) case (mld_no_smooth_) call mld_daggrmat_unsmth_spmm_asb(a,desc_a,ilaggr,nlaggr,& diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 index 891ca7e6..a70c0946 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 @@ -146,22 +146,51 @@ module mld_d_bcmatch_aggregator_mod end subroutine mld_d_bcmatch_aggregator_build_tprol end interface -!!$ interface -!!$ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,& -!!$ & op_prol,op_restr,info) -!!$ import :: mld_d_bcmatch_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, & -!!$ & psb_ipk_, psb_long_int_k_, mld_dml_parms -!!$ implicit none -!!$ class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag -!!$ type(mld_dml_parms), intent(inout) :: parms -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ type(psb_desc_type), intent(in) :: desc_a -!!$ integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) -!!$ type(psb_dspmat_type), intent(inout) :: op_prol -!!$ type(psb_dspmat_type), intent(out) :: ac,op_restr -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine mld_d_bcmatch_aggregator_mat_asb -!!$ end interface + interface + subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,& + & op_prol,op_restr,info) + import :: mld_d_bcmatch_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, mld_dml_parms + implicit none + class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag + type(mld_dml_parms), intent(inout) :: parms + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) + type(psb_dspmat_type), intent(inout) :: op_prol + type(psb_dspmat_type), intent(out) :: ac,op_restr + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_bcmatch_aggregator_mat_asb + end interface + + + interface + subroutine mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info) + import :: mld_d_bcmatch_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, mld_dml_parms + implicit none + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), allocatable, intent(inout) :: ilaggr(:),nlaggr(:) + real(psb_dpk_), allocatable, intent(inout) :: valaggr(:) + type(psb_dspmat_type), intent(out) :: op_prol + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_bcmatch_map_to_tprol + end interface + + interface + subroutine mld_daggrmat_unsmth_spmm_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) + import :: mld_d_bcmatch_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, mld_dml_parms + implicit none + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) + type(mld_dml_parms), intent(inout) :: parms + type(psb_dspmat_type), intent(inout) :: op_prol + type(psb_dspmat_type), intent(out) :: ac,op_restr + integer(psb_ipk_), intent(out) :: info + end subroutine mld_daggrmat_unsmth_spmm_asb + end interface contains diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 index d6b511fe..22453c83 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 @@ -206,6 +206,7 @@ end module bcm_CSRMatrix_mod subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_d_prec_type use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_build_tprol use mld_d_inner_mod !use bcm_CSRMatrix_mod @@ -217,12 +218,12 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) - real(psb_dpk_), allocatable:: valaggr(:) type(psb_dspmat_type), intent(out) :: op_prol integer(psb_ipk_), intent(out) :: info ! Local variables + real(psb_dpk_), allocatable:: valaggr(:) type(psb_dspmat_type) :: a_tmp type(bcm_CSRMatrix) :: C, P integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels @@ -280,10 +281,10 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr info = psb_success_ - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) @@ -340,7 +341,7 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr call psb_sum(ictxt,nlaggr(1:np)) - call mld_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr,op_prol,info) + call mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr,op_prol,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_bcmatch_map_to_tprol') goto 9999 diff --git a/tests/Bcmatch/mld_d_bcmatch_map_to_tprol.f90 b/tests/Bcmatch/mld_d_bcmatch_map_to_tprol.f90 index 960f9cb9..6d289454 100644 --- a/tests/Bcmatch/mld_d_bcmatch_map_to_tprol.f90 +++ b/tests/Bcmatch/mld_d_bcmatch_map_to_tprol.f90 @@ -89,7 +89,8 @@ subroutine mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info) use psb_base_mod - use mld_d_inner_mod, mld_protect_name => mld_d_bcmatch_map_to_tprol + use mld_d_inner_mod!, mld_protect_name => mld_d_bcmatch_map_to_tprol + use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_map_to_tprol implicit none diff --git a/tests/Bcmatch/mld_daggrmat_unsmth_spmm_asb.f90 b/tests/Bcmatch/mld_daggrmat_unsmth_spmm_asb.f90 index 54173b30..49a42446 100644 --- a/tests/Bcmatch/mld_daggrmat_unsmth_spmm_asb.f90 +++ b/tests/Bcmatch/mld_daggrmat_unsmth_spmm_asb.f90 @@ -98,7 +98,7 @@ ! subroutine mld_daggrmat_unsmth_spmm_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) use psb_base_mod - use mld_d_inner_mod, mld_protect_name => mld_daggrmat_unsmth_spmm_asb + use mld_d_inner_mod!, mld_protect_name => mld_daggrmat_unsmth_spmm_asb implicit none From 5664c9755524766e497af0b3608d26099a3d1c01 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 15 Sep 2018 10:26:24 +0100 Subject: [PATCH 02/16] New C file for BCM interface. --- tests/Bcmatch/bootCMatch_interface.c | 65 ++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) create mode 100644 tests/Bcmatch/bootCMatch_interface.c diff --git a/tests/Bcmatch/bootCMatch_interface.c b/tests/Bcmatch/bootCMatch_interface.c new file mode 100644 index 00000000..8362abd1 --- /dev/null +++ b/tests/Bcmatch/bootCMatch_interface.c @@ -0,0 +1,65 @@ +#include +#include + +#include "bcm.h" + +bcm_CSRMatrix bootCMatch(bcm_CSRMatrix *C, int *match_algorithm, int *n_sweeps, int *max_nlevels, int *max_csize, bcm_Vector *w); +bcm_CSRMatrix bootCMatch(bcm_CSRMatrix *C, int *match_algorithm, int *n_sweeps, int *max_nlevels, int *max_csize, bcm_Vector *w){ + bcm_Vector *w_temp; + int info; + //double *w_inp; + //w_inp=bcm_VectorData(w); + + bcm_CSRMatrix *P; + bcm_CSRMatrix *Ac; + int ftcoarse=1; + int cr_it=0, cr_relax_type=0; + double cr_relax_weight=0.0; + // Here I am building Ac but I won't use it. + Ac=bcm_CSRMatchingAgg(C, &w, &P, *match_algorithm, *n_sweeps, *max_nlevels,*max_csize , &ftcoarse, + cr_it, cr_relax_type, cr_relax_weight); + //w_inp=bcm_VectorData(w); + bcm_CSRMatrixDestroy(Ac); + return *P; +} + +int mld_bootCMatch_if(bcm_CSRMatrix *C, int match_algorithm, int n_sweeps, + int max_nlevels, int max_csize, bcm_Vector *w, + int isz, int ilaggr[], double valaggr[], int *num_cols){ + bcm_Vector *w_temp; + int info; + //double *w_inp; + //w_inp=bcm_VectorData(w); + + bcm_CSRMatrix *P; + bcm_CSRMatrix *Ac; + int *irp, *ja, nr, nz, nc,i,j; + double *val; + int ftcoarse=1; + int cr_it=0, cr_relax_type=0; + double cr_relax_weight=0.0; + // Here I am building Ac but I won't use it. + Ac=bcm_CSRMatchingAgg(C, &w, &P, match_algorithm, n_sweeps, max_nlevels,max_csize , &ftcoarse, + cr_it, cr_relax_type, cr_relax_weight); + irp = bcm_CSRMatrixI(P); + ja = bcm_CSRMatrixJ(P); + val = bcm_CSRMatrixData(P); + nr = bcm_CSRMatrixNumRows(P); + nc = bcm_CSRMatrixNumCols(P); + nz = bcm_CSRMatrixNumNonzeros(P); + + if (isz < nr) return(-1); + if (nz != nr) return(-2); + /* loop here only makes sense when nr==nz */ + for (i=0; i< nr; i++) { + for (j=irp[i]; j Date: Sat, 15 Sep 2018 10:44:49 +0100 Subject: [PATCH 03/16] bcmag in the test program. --- tests/Bcmatch/mld_d_pde3d.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/tests/Bcmatch/mld_d_pde3d.f90 b/tests/Bcmatch/mld_d_pde3d.f90 index e8a85631..738b5441 100644 --- a/tests/Bcmatch/mld_d_pde3d.f90 +++ b/tests/Bcmatch/mld_d_pde3d.f90 @@ -577,6 +577,7 @@ program mld_d_pde3d use psb_util_mod use data_input use mld_d_pde3d_mod + use mld_d_bcmatch_aggregator_mod implicit none ! input parameters @@ -590,6 +591,7 @@ program mld_d_pde3d ! sparse matrix and preconditioner type(psb_dspmat_type) :: a type(mld_dprec_type) :: prec + type(mld_d_bcmatch_aggregator_type) :: bcmag ! descriptor type(psb_desc_type) :: desc_a ! dense vectors @@ -814,7 +816,7 @@ program mld_d_pde3d call prec%set('coarse_fillin', p_choice%cfill, info) call prec%set('coarse_iluthrs', p_choice%cthres, info) call prec%set('coarse_sweeps', p_choice%cjswp, info) - + !call prec%set(bcmag,info) end select ! build the preconditioner From c7ab19ec9bf81b45cb40cbad5690c71d790516d8 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 15 Sep 2018 10:47:09 +0100 Subject: [PATCH 04/16] test runs dir. --- tests/Bcmatch/runs/mld-bcm.inp | 49 ++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 tests/Bcmatch/runs/mld-bcm.inp diff --git a/tests/Bcmatch/runs/mld-bcm.inp b/tests/Bcmatch/runs/mld-bcm.inp new file mode 100644 index 00000000..25edad61 --- /dev/null +++ b/tests/Bcmatch/runs/mld-bcm.inp @@ -0,0 +1,49 @@ +%%%%%%%%%%% General arguments % Lines starting with % are ignored. +CSR ! Storage format CSR COO JAD +0040 ! IDIM; domain size. Linear system size is IDIM**2 +CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES +2 ! ISTOPC +00500 ! ITMAX +1 ! ITRACE +30 ! IRST (restart for RGMRES and BiCGSTABL) +1.d-6 ! EPS +ML-VCYCLE-FBGS-ILU ! Longer descriptive name for preconditioner (up to 20 chars) +ML ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML +%%%%%%%%%%% First smoother (for all levels but coarsest) %%%%%%%%%%%%%%%% +FBGS ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. +2 ! Number of sweeps for smoother +0 ! Number of overlap layers for AS preconditioner +HALO ! AS restriction operator: NONE HALO +NONE ! AS prolongation operator: NONE SUM AVG +ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +0 ! Fill level P for ILU(P) and ILU(T,P) +1.d-4 ! Threshold T for ILU(T,P) +%%%%%%%%%%% Second smoother, always ignored for non-ML %%%%%%%%%%%%%%%% +NONE ! Second (post) smoother, ignored if NONE +1 ! Number of sweeps for (post) smoother +0 ! Number of overlap layers for AS preconditioner +HALO ! AS restriction operator: NONE HALO +NONE ! AS prolongation operator: NONE SUM AVG +ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +0 ! Fill level P for ILU(P) and ILU(T,P) +1.d-4 ! Threshold T for ILU(T,P) +%%%%%%%%%%% Multilevel parameters %%%%%%%%%%%%%%%% +VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD +1 ! Number of outer sweeps for ML +-3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default +-3 ! Target coarse matrix size; if <0, lib default +SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED +DEC ! Parallel aggregation: DEC, SYMDEC +NATURAL ! Ordering of aggregation NATURAL DEGREE +NOFILTER ! Filtering of matrix: FILTER NOFILTER +-1.5 ! Coarsening ratio, if < 0 use library default +-2 ! Number of thresholds in vector, next line ignored if <= 0 +0.05 0.025 ! Thresholds +-0.0100d0 ! Smoothed aggregation threshold: >= 0.0 +%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% +BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC DEFLT +ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU +DIST ! Coarsest-level matrix distribution: DIST REPL, DEFLT +1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) +1.d-4 ! Coarsest-level threshold T for ILU(T,P) +1 ! Number of sweeps for JACOBI/GS/BJAC coarsest-level solver From 660d00d49b755366e9ca6194e16ba850aa417a94 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 17 Sep 2018 09:48:05 +0100 Subject: [PATCH 05/16] First version working with BootCMatch. To be tested in detail. --- mlprec/impl/level/mld_d_base_onelev_cseti.F90 | 3 +- mlprec/impl/level/mld_d_base_onelev_setag.f90 | 1 + mlprec/mld_base_prec_type.F90 | 2 +- mlprec/mld_d_base_aggregator_mod.f90 | 18 ++- tests/Bcmatch/Makefile | 10 +- tests/Bcmatch/bootCMatch_interface.c | 7 + .../Bcmatch/mld_d_bcmatch_aggregator_mod.F90 | 121 +++++++++++++----- .../mld_d_bcmatch_aggregator_tprol.f90 | 9 +- tests/Bcmatch/mld_d_pde3d.f90 | 16 ++- tests/Bcmatch/runs/mld-bcm.inp | 1 + 10 files changed, 142 insertions(+), 46 deletions(-) diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index d76c5b59..18691606 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -260,7 +260,8 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if - + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + end select if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/level/mld_d_base_onelev_setag.f90 b/mlprec/impl/level/mld_d_base_onelev_setag.f90 index c4c26cca..8e09ceb1 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setag.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setag.f90 @@ -76,6 +76,7 @@ subroutine mld_d_base_onelev_setag(lv,val,info,pos) lv%parms%par_aggr_alg = mld_ext_aggr_ lv%parms%aggr_type = mld_noalg_ end if + call lv%aggr%default() end subroutine mld_d_base_onelev_setag diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index b7661e99..809eb25c 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -571,7 +571,7 @@ contains write(iout,*) ' Parallel aggregation algorithm: ',& & par_aggr_alg_names(pm%par_aggr_alg) - write(iout,*) ' Aggregation type: ',& + if (pm%aggr_type>0) write(iout,*) ' Aggregation type: ',& & aggr_type_names(pm%aggr_type) if (pm%par_aggr_alg /= mld_ext_aggr_) then if ( pm%aggr_ord /= mld_aggr_ord_nat_) & diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 515d64c7..7a2b1eea 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -104,12 +104,27 @@ module mld_d_base_aggregator_mod procedure, pass(ag) :: default => mld_d_base_aggregator_default procedure, pass(ag) :: descr => mld_d_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_d_base_aggregator_set_aggr_type + procedure, pass(ag) :: cseti => mld_d_base_aggregator_cseti + generic, public :: set => cseti procedure, nopass :: fmt => mld_d_base_aggregator_fmt end type mld_d_base_aggregator_type contains + subroutine mld_d_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_d_base_aggregator_cseti + subroutine mld_d_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_d_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +174,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_d_base_aggregator_fmt subroutine mld_d_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +184,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/tests/Bcmatch/Makefile b/tests/Bcmatch/Makefile index 42a1cf2b..6d577902 100644 --- a/tests/Bcmatch/Makefile +++ b/tests/Bcmatch/Makefile @@ -6,20 +6,20 @@ MLDLIBDIR=$(MLDDIR)/lib MLD_LIBS=-L$(MLDLIBDIR) -lpsb_krylov -lmld_prec -lpsb_prec FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDMODDIR) $(FMFLAG)$(MLDINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). -HSL_DIR=/opt/hsl/2.3.1/gnu/6.4.0 +HSL_DIR=/opt/hsl/2.3.1/sys HSL_INCDIR=$(HSL_DIR)/include HSL_LIBDIR=$(HSL_DIR)/lib HSL_LIBS=-lhsl_mc64 -L$(HSL_LIBDIR) HSL_FLAGS= -DHAVE_HSL -I$(HSL_INCDIR) # SPRAL package for auction algorithm -SPRAL_DIR=/opt/spral/2015.04.20/gnu/6.4.0 +SPRAL_DIR=/opt/spral/2015.04.20/sys SPRAL_INCDIR=$(SPRAL_DIR)/include SPRAL_LIBDIR=$(SPRAL_DIR)/lib SPRAL_LIBS=-lspral -L$(SPRAL_LIBDIR) SPRAL_FLAGS=-DHAVE_SPRAL -I$(SPRAL_INCDIR) -BCM_DIR=/opt/bcm/0.9/gnu/6.4.0 +BCM_DIR=/opt/bcm/0.9/sys BCM_INCDIR=$(BCM_DIR)/include BCM_LIBDIR=$(BCM_DIR)/lib BCM_LDLIBS=-lBCM -L$(BCM_LIBDIR) $(HSL_LIBS) $(SPRAL_LIBS) @@ -47,8 +47,8 @@ check: all clean: - /bin/rm -f data_input.o mld_d_pde3d.o mld_s_pde3d.o mld_d_pde2d.o mld_s_pde2d.o *$(.mod)\ - $(EXEDIR)/mld_d_pde3d $(EXEDIR)/mld_s_pde3d $(EXEDIR)/mld_d_pde2d $(EXEDIR)/mld_s_pde2d + /bin/rm -f data_input.o mld_d_pde3d.o *$(.mod) $(BCMOBJS)\ + $(EXEDIR)/mld_d_pde3d verycleanlib: (cd ../..; make veryclean) diff --git a/tests/Bcmatch/bootCMatch_interface.c b/tests/Bcmatch/bootCMatch_interface.c index 8362abd1..2b3a5087 100644 --- a/tests/Bcmatch/bootCMatch_interface.c +++ b/tests/Bcmatch/bootCMatch_interface.c @@ -1,3 +1,4 @@ + #include #include @@ -38,6 +39,12 @@ int mld_bootCMatch_if(bcm_CSRMatrix *C, int match_algorithm, int n_sweeps, int ftcoarse=1; int cr_it=0, cr_relax_type=0; double cr_relax_weight=0.0; + + // Sanity checks + nr = bcm_CSRMatrixNumRows(C); + nc = bcm_VectorSize(w); +// fprintf(stderr,"Sanity check: %d %d \n",nr,nc); + // Here I am building Ac but I won't use it. Ac=bcm_CSRMatchingAgg(C, &w, &P, match_algorithm, n_sweeps, max_nlevels,max_csize , &ftcoarse, cr_it, cr_relax_type, cr_relax_weight); diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 index a70c0946..276d7728 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_mod.F90 @@ -113,17 +113,20 @@ module mld_d_bcmatch_aggregator_mod type, extends(mld_d_base_aggregator_type) :: mld_d_bcmatch_aggregator_type integer(psb_ipk_) :: matching_alg integer(psb_ipk_) :: n_sweeps - real(psb_dpk_), allocatable :: w_tmp(:) - type(bcm_Vector) :: w_par + real(psb_dpk_), allocatable :: w_tmp(:), w_nxt(:) + type(bcm_Vector) :: w_par integer(psb_ipk_) :: max_csize integer(psb_ipk_) :: max_nlevels !type(psb_d_vect_type) :: w contains procedure, pass(ag) :: bld_tprol => mld_d_bcmatch_aggregator_build_tprol - procedure, pass(ag) :: set => d_bcmatch_aggr_cseti + procedure, pass(ag) :: cseti => d_bcmatch_aggr_cseti procedure, pass(ag) :: default => d_bcmatch_aggr_set_default procedure, pass(ag) :: mat_asb => mld_d_bcmatch_aggregator_mat_asb - procedure, pass(ag) :: update_level => d_bcmatch_aggregator_update_level + procedure, pass(ag) :: update_next => d_bcmatch_aggregator_update_next + procedure, pass(ag) :: bld_wnxt => d_bcmatch_bld_wnxt + procedure, pass(ag) :: bld_default_w => d_bld_default_w + procedure, pass(ag) :: set_c_default_w => d_set_default_bcm_w !!$ procedure, pass(ag) :: clone => mld_d_base_aggregator_clone !!$ procedure, pass(ag) :: free => mld_d_bcmatch_aggregator_free !!$ procedure, pass(ag) :: default => mld_d_base_aggregator_default @@ -195,7 +198,60 @@ module mld_d_bcmatch_aggregator_mod contains + subroutine d_bld_default_w(ag,nr) + use psb_realloc_mod + implicit none + class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag + integer(psb_ipk_), intent(in) :: nr + integer(psb_ipk_) :: info + call psb_realloc(nr,ag%w_tmp,info) + if (info /= psb_success_) return + ag%w_tmp = done + call ag%set_c_default_w() + end subroutine d_bld_default_w + + subroutine d_set_default_bcm_w(ag) + use psb_realloc_mod + use iso_c_binding + implicit none + class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag + + ag%w_par%size = psb_size(ag%w_tmp) + ag%w_par%owns_data = 0 + if (ag%w_par%size > 0) call set_cloc(ag%w_tmp, ag%w_par) + + end subroutine d_set_default_bcm_w + + subroutine set_cloc(vect,w_par) + use iso_c_binding + real(psb_dpk_), target :: vect(:) + type(bcm_Vector) :: w_par + + w_par%data = c_loc(vect) + end subroutine set_cloc + + + subroutine d_bcmatch_bld_wnxt(ag,ilaggr,valaggr,nx) + use psb_realloc_mod + implicit none + class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag + integer(psb_ipk_), intent(in) :: ilaggr(:) + real(psb_dpk_), intent(in) :: valaggr(:) + integer(psb_ipk_), intent(in) :: nx + + integer(psb_ipk_) :: info,i,j + call psb_realloc(nx,ag%w_nxt,info) + associate(w_nxt => ag%w_nxt, w_tmp=>ag%w_tmp) + w_nxt = dzero + do j=1, size(ilaggr) + i = ilaggr(j) + w_nxt(i) = w_nxt(i) + valaggr(j)*w_tmp(j) + end do + end associate + + end subroutine d_bcmatch_bld_wnxt + function mld_d_bcmatch_aggregator_fmt() result(val) implicit none character(len=32) :: val @@ -203,7 +259,8 @@ contains val = "BootCMatch aggregation" end function mld_d_bcmatch_aggregator_fmt - subroutine d_bcmatch_aggregator_update_level(ag,agnext,info) + subroutine d_bcmatch_aggregator_update_next(ag,agnext,info) + use psb_realloc_mod implicit none class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag class(mld_d_base_aggregator_type), target, intent(inout) :: agnext @@ -212,17 +269,20 @@ contains ! ! select type(agnext) - type is (mld_d_bcmatch_aggregator_type) + class is (mld_d_bcmatch_aggregator_type) agnext%matching_alg = ag%matching_alg agnext%n_sweeps = ag%n_sweeps agnext%max_csize = ag%max_csize agnext%max_nlevels = ag%max_nlevels ! Is this going to generate shallow copies/memory leaks/double frees? ! To be investigated further. - agnext%w_par = ag%w_par + call psb_safe_ab_cpy(ag%w_nxt,agnext%w_tmp,info) + call agnext%set_c_default_w() + class default + ! What should we do here? end select info = 0 - end subroutine d_bcmatch_aggregator_update_level + end subroutine d_bcmatch_aggregator_update_next subroutine d_bcmatch_aggr_cseti(ag,what,val,info) @@ -238,31 +298,22 @@ contains info = psb_success_ select case(what) - case('BCM_MATCH_ALG') - ag%matching_alg=val - case('BCM_SWEEPS') - ag%n_sweeps=val - case('BCM_MAX_CSIZE') - ag%max_csize=val - case('BCM_MAX_NLEVELS') - ag%max_nlevels=val - case('BCM_W_SIZE') - ag%w_par%size=val - ag%w_par%owns_data=0 - allocate(ag%w_tmp(val)) - ag%w_tmp = 1.0_psb_dpk_ - call set_cloc(ag%w_tmp, ag%w_par) - case default + case('BCM_MATCH_ALG') + ag%matching_alg=val + case('BCM_SWEEPS') + ag%n_sweeps=val + case('BCM_MAX_CSIZE') + ag%max_csize=val + case('BCM_MAX_NLEVELS') + ag%max_nlevels=val + case('BCM_W_SIZE') + !write(0,*) 'Setting W_SIZE' + call ag%bld_default_w(val) + + case default + end select return - contains - subroutine set_cloc(vect,w_par) - real(psb_dpk_), target :: vect(:) - type(bcm_Vector) :: w_par - - w_par%data = c_loc(vect) - end subroutine set_cloc - end subroutine d_bcmatch_aggr_cseti subroutine d_bcmatch_aggr_set_default(ag) @@ -272,10 +323,10 @@ contains ! Arguments class(mld_d_bcmatch_aggregator_type), intent(inout) :: ag character(len=20) :: name='d_bcmatch_aggr_set_default' - ag%matching_alg=0 - ag%n_sweeps=1 - ag%max_nlevels=36 - ag%max_csize=10 + ag%matching_alg = 0 + ag%n_sweeps = 1 + ag%max_nlevels = 36 + ag%max_csize = 10 return diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 index 22453c83..adfc5258 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 @@ -292,7 +292,9 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr call a%csclip(b=a_tmp, info=info, jmax=a%get_nrows(), imax=a%get_nrows()) call a_tmp%mv_to(acsr) - + nr = a%get_nrows() + if (psb_size(ag%w_tmp) < nr) call ag%bld_default_w(nr) + !write(*,*) 'Build_tprol:',acsr%get_nrows(),acsr%get_ncols() C%num_rows=acsr%get_nrows() C%num_cols=acsr%get_ncols() @@ -326,7 +328,12 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_bootCMatch_if') goto 9999 end if +!!$ write(0,*) 'On output from BootCMatch',nr,num_pcols,size(ilaggr),maxval(ilaggr),& +!!$ & minval(ilaggr),minval(ilaggr(1:nr)),a%get_nrows(),a%get_ncols() + ! Prepare vector W for next level, just in case + call ag%bld_wnxt(ilaggr(1:nr),valaggr(1:nr),num_pcols) + call psb_realloc(np,nlaggr,info) if (info /= psb_success_) then info=psb_err_alloc_request_ diff --git a/tests/Bcmatch/mld_d_pde3d.f90 b/tests/Bcmatch/mld_d_pde3d.f90 index 738b5441..de89f105 100644 --- a/tests/Bcmatch/mld_d_pde3d.f90 +++ b/tests/Bcmatch/mld_d_pde3d.f90 @@ -671,6 +671,7 @@ program mld_d_pde3d integer(psb_ipk_) :: cfill ! fill-in for incomplete LU factorization real(psb_dpk_) :: cthres ! threshold for ILUT factorization integer(psb_ipk_) :: cjswp ! sweeps for GS or JAC coarsest-lev subsolver + logical :: use_bcm ! Use BootCMatch aggregation end type precdata type(precdata) :: p_choice @@ -816,13 +817,23 @@ program mld_d_pde3d call prec%set('coarse_fillin', p_choice%cfill, info) call prec%set('coarse_iluthrs', p_choice%cthres, info) call prec%set('coarse_sweeps', p_choice%cjswp, info) - !call prec%set(bcmag,info) + if (p_choice%use_bcm) then + call prec%set(bcmag,info) + call prec%set('BCM_MATCH_ALG',2, info) + call prec%set('BCM_SWEEPS',3, info) +!!$ if (p_choice%csize>0) call prec%set('BCM_MAX_CSIZE',p_choice%csize, info) + call prec%set('BCM_MAX_NLEVELS',p_choice%maxlevs, info) + !call prec%set('BCM_W_SIZE',desc_a%get_local_rows(), info,ilev=2) + end if + end select ! build the preconditioner call psb_barrier(ictxt) t1 = psb_wtime() + !call psb_set_debug_level(9999) call prec%hierarchy_build(a,desc_a,info) + !call psb_set_debug_level(0) thier = psb_wtime()-t1 if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_hierarchy_bld') @@ -1024,6 +1035,7 @@ contains call read_data(prec%cfill,inp_unit) ! fill-in for incompl LU call read_data(prec%cthres,inp_unit) ! Threshold for ILUT call read_data(prec%cjswp,inp_unit) ! sweeps for GS/JAC subsolver + call read_data(prec%use_bcm,inp_unit) ! BootCMatch? if (inp_unit /= psb_inp_unit) then close(inp_unit) end if @@ -1085,7 +1097,7 @@ contains call psb_bcast(icontxt,prec%cfill) call psb_bcast(icontxt,prec%cthres) call psb_bcast(icontxt,prec%cjswp) - + call psb_bcast(icontxt,prec%use_bcm) end subroutine get_parms diff --git a/tests/Bcmatch/runs/mld-bcm.inp b/tests/Bcmatch/runs/mld-bcm.inp index 25edad61..374d5139 100644 --- a/tests/Bcmatch/runs/mld-bcm.inp +++ b/tests/Bcmatch/runs/mld-bcm.inp @@ -47,3 +47,4 @@ DIST ! Coarsest-level matrix distribution: DIST REPL, DE 1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) 1.d-4 ! Coarsest-level threshold T for ILU(T,P) 1 ! Number of sweeps for JACOBI/GS/BJAC coarsest-level solver +T ! Use BootCMatch aggregator \ No newline at end of file From 5848b592bdb47c0bf0d3bf8c7be5d171e3564069 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 19 Sep 2018 12:26:06 +0100 Subject: [PATCH 06/16] Override DESCR for aggregator, testing. --- mlprec/mld_d_dec_aggregator_mod.f90 | 15 +++++++++++++++ mlprec/mld_d_symdec_aggregator_mod.f90 | 15 +++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/mlprec/mld_d_dec_aggregator_mod.f90 b/mlprec/mld_d_dec_aggregator_mod.f90 index 4b5acff3..c835cd0b 100644 --- a/mlprec/mld_d_dec_aggregator_mod.f90 +++ b/mlprec/mld_d_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_d_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_d_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_d_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_d_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_d_dec_aggregator_descr procedure, nopass :: fmt => mld_d_dec_aggregator_fmt end type mld_d_dec_aggregator_type @@ -189,5 +190,19 @@ contains val = "Decoupled aggregation" end function mld_d_dec_aggregator_fmt + + subroutine mld_d_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_d_dec_aggregator_type), intent(in) :: ag + type(mld_dml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_d_dec_aggregator_descr end module mld_d_dec_aggregator_mod diff --git a/mlprec/mld_d_symdec_aggregator_mod.f90 b/mlprec/mld_d_symdec_aggregator_mod.f90 index 86fd4ba2..dfc03c90 100644 --- a/mlprec/mld_d_symdec_aggregator_mod.f90 +++ b/mlprec/mld_d_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_d_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_d_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_d_symdec_aggregator_descr procedure, nopass :: fmt => mld_d_symdec_aggregator_fmt end type mld_d_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_d_symdec_aggregator_fmt + subroutine mld_d_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_d_symdec_aggregator_type), intent(in) :: ag + type(mld_dml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_d_symdec_aggregator_descr + end module mld_d_symdec_aggregator_mod From 532ad262b03b650fe061166715f587aa660fbddb Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 27 Sep 2018 13:33:59 +0100 Subject: [PATCH 07/16] Avoid integer overflow when computing nnz. --- tests/pdegen/mld_d_pde2d.f90 | 2 +- tests/pdegen/mld_d_pde3d.f90 | 2 +- tests/pdegen/mld_s_pde2d.f90 | 2 +- tests/pdegen/mld_s_pde3d.f90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/pdegen/mld_d_pde2d.f90 b/tests/pdegen/mld_d_pde2d.f90 index e1b1bde9..ce866028 100644 --- a/tests/pdegen/mld_d_pde2d.f90 +++ b/tests/pdegen/mld_d_pde2d.f90 @@ -247,7 +247,7 @@ contains m = idim*idim n = m - nnz = ((n*7)/(np)) + nnz = 7*((n+np-1)/np) if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n t0 = psb_wtime() select case(partition_) diff --git a/tests/pdegen/mld_d_pde3d.f90 b/tests/pdegen/mld_d_pde3d.f90 index e8a85631..633d4fe0 100644 --- a/tests/pdegen/mld_d_pde3d.f90 +++ b/tests/pdegen/mld_d_pde3d.f90 @@ -263,7 +263,7 @@ contains m = idim*idim*idim n = m - nnz = ((n*7)/(np)) + nnz = 7*((n+np-1)/np) if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n t0 = psb_wtime() select case(partition_) diff --git a/tests/pdegen/mld_s_pde2d.f90 b/tests/pdegen/mld_s_pde2d.f90 index 6d8abb14..a7fea3e5 100644 --- a/tests/pdegen/mld_s_pde2d.f90 +++ b/tests/pdegen/mld_s_pde2d.f90 @@ -247,7 +247,7 @@ contains m = idim*idim n = m - nnz = ((n*7)/(np)) + nnz = 7*((n+np-1)/np) if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n t0 = psb_wtime() select case(partition_) diff --git a/tests/pdegen/mld_s_pde3d.f90 b/tests/pdegen/mld_s_pde3d.f90 index 26d318a7..1978fb81 100644 --- a/tests/pdegen/mld_s_pde3d.f90 +++ b/tests/pdegen/mld_s_pde3d.f90 @@ -263,7 +263,7 @@ contains m = idim*idim*idim n = m - nnz = ((n*7)/(np)) + nnz = 7*((n+np-1)/np) if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n t0 = psb_wtime() select case(partition_) From 3951e449bb62943f90efc1fbaf6240c5737bed02 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 30 Sep 2018 21:17:39 +0100 Subject: [PATCH 08/16] New version with aggregator object interface. Take out SET with integer WHAT. --- mlprec/impl/level/Makefile | 13 +- mlprec/impl/level/mld_c_base_onelev_setc.f90 | 99 --- mlprec/impl/level/mld_c_base_onelev_seti.F90 | 253 ------- mlprec/impl/level/mld_c_base_onelev_setr.f90 | 104 --- mlprec/impl/level/mld_d_base_onelev_cseti.F90 | 3 +- mlprec/impl/level/mld_d_base_onelev_setag.f90 | 1 - mlprec/impl/level/mld_d_base_onelev_setc.f90 | 99 --- mlprec/impl/level/mld_d_base_onelev_seti.F90 | 273 -------- mlprec/impl/level/mld_d_base_onelev_setr.f90 | 104 --- mlprec/impl/level/mld_s_base_onelev_setc.f90 | 99 --- mlprec/impl/level/mld_s_base_onelev_seti.F90 | 253 ------- mlprec/impl/level/mld_s_base_onelev_setr.f90 | 104 --- mlprec/impl/level/mld_z_base_onelev_setc.f90 | 99 --- mlprec/impl/level/mld_z_base_onelev_seti.F90 | 273 -------- mlprec/impl/level/mld_z_base_onelev_setr.f90 | 104 --- mlprec/impl/mld_cprecset.F90 | 627 ----------------- mlprec/impl/mld_dprecset.F90 | 660 ------------------ mlprec/impl/mld_sprecset.F90 | 627 ----------------- mlprec/impl/mld_zprecset.F90 | 660 ------------------ mlprec/impl/smoother/Makefile | 25 - .../impl/smoother/mld_c_as_smoother_setc.f90 | 74 -- .../impl/smoother/mld_c_as_smoother_seti.f90 | 72 -- .../impl/smoother/mld_c_as_smoother_setr.f90 | 68 -- .../smoother/mld_c_base_smoother_setc.f90 | 73 -- .../smoother/mld_c_base_smoother_seti.f90 | 64 -- .../smoother/mld_c_base_smoother_setr.f90 | 68 -- .../impl/smoother/mld_d_as_smoother_setc.f90 | 74 -- .../impl/smoother/mld_d_as_smoother_seti.f90 | 72 -- .../impl/smoother/mld_d_as_smoother_setr.f90 | 68 -- .../smoother/mld_d_base_smoother_setc.f90 | 73 -- .../smoother/mld_d_base_smoother_seti.f90 | 64 -- .../smoother/mld_d_base_smoother_setr.f90 | 68 -- .../impl/smoother/mld_s_as_smoother_setc.f90 | 74 -- .../impl/smoother/mld_s_as_smoother_seti.f90 | 72 -- .../impl/smoother/mld_s_as_smoother_setr.f90 | 68 -- .../smoother/mld_s_base_smoother_setc.f90 | 73 -- .../smoother/mld_s_base_smoother_seti.f90 | 64 -- .../smoother/mld_s_base_smoother_setr.f90 | 68 -- .../impl/smoother/mld_z_as_smoother_setc.f90 | 74 -- .../impl/smoother/mld_z_as_smoother_seti.f90 | 72 -- .../impl/smoother/mld_z_as_smoother_setr.f90 | 68 -- .../smoother/mld_z_base_smoother_setc.f90 | 73 -- .../smoother/mld_z_base_smoother_seti.f90 | 64 -- .../smoother/mld_z_base_smoother_setr.f90 | 68 -- mlprec/impl/solver/Makefile | 14 +- mlprec/impl/solver/mld_c_base_solver_setc.f90 | 69 -- mlprec/impl/solver/mld_c_base_solver_seti.f90 | 55 -- mlprec/impl/solver/mld_c_base_solver_setr.f90 | 56 -- mlprec/impl/solver/mld_d_base_solver_setc.f90 | 69 -- mlprec/impl/solver/mld_d_base_solver_seti.f90 | 55 -- mlprec/impl/solver/mld_d_base_solver_setr.f90 | 56 -- mlprec/impl/solver/mld_s_base_solver_setc.f90 | 69 -- mlprec/impl/solver/mld_s_base_solver_seti.f90 | 55 -- mlprec/impl/solver/mld_s_base_solver_setr.f90 | 56 -- mlprec/impl/solver/mld_z_base_solver_setc.f90 | 69 -- mlprec/impl/solver/mld_z_base_solver_seti.f90 | 55 -- mlprec/impl/solver/mld_z_base_solver_setr.f90 | 56 -- mlprec/mld_c_as_smoother.f90 | 38 - mlprec/mld_c_base_aggregator_mod.f90 | 33 +- mlprec/mld_c_base_smoother_mod.f90 | 43 +- mlprec/mld_c_base_solver_mod.f90 | 49 +- mlprec/mld_c_dec_aggregator_mod.f90 | 15 + mlprec/mld_c_gs_solver.f90 | 99 +-- mlprec/mld_c_ilu_solver.f90 | 101 +-- mlprec/mld_c_mumps_solver.F90 | 108 +-- mlprec/mld_c_onelev_mod.f90 | 53 +- mlprec/mld_c_prec_mod.f90 | 31 - mlprec/mld_c_prec_type.f90 | 36 +- mlprec/mld_c_symdec_aggregator_mod.f90 | 15 + mlprec/mld_d_as_smoother.f90 | 38 - mlprec/mld_d_base_aggregator_mod.f90 | 19 +- mlprec/mld_d_base_smoother_mod.f90 | 43 +- mlprec/mld_d_base_solver_mod.f90 | 49 +- mlprec/mld_d_dec_aggregator_mod.f90 | 4 +- mlprec/mld_d_gs_solver.f90 | 99 +-- mlprec/mld_d_ilu_solver.f90 | 101 +-- mlprec/mld_d_mumps_solver.F90 | 108 +-- mlprec/mld_d_onelev_mod.f90 | 53 +- mlprec/mld_d_prec_mod.f90 | 31 - mlprec/mld_d_prec_type.f90 | 36 +- mlprec/mld_s_as_smoother.f90 | 38 - mlprec/mld_s_base_aggregator_mod.f90 | 33 +- mlprec/mld_s_base_smoother_mod.f90 | 43 +- mlprec/mld_s_base_solver_mod.f90 | 49 +- mlprec/mld_s_dec_aggregator_mod.f90 | 15 + mlprec/mld_s_gs_solver.f90 | 99 +-- mlprec/mld_s_ilu_solver.f90 | 101 +-- mlprec/mld_s_mumps_solver.F90 | 108 +-- mlprec/mld_s_onelev_mod.f90 | 53 +- mlprec/mld_s_prec_mod.f90 | 31 - mlprec/mld_s_prec_type.f90 | 36 +- mlprec/mld_s_symdec_aggregator_mod.f90 | 15 + mlprec/mld_z_as_smoother.f90 | 38 - mlprec/mld_z_base_aggregator_mod.f90 | 33 +- mlprec/mld_z_base_smoother_mod.f90 | 43 +- mlprec/mld_z_base_solver_mod.f90 | 49 +- mlprec/mld_z_dec_aggregator_mod.f90 | 15 + mlprec/mld_z_gs_solver.f90 | 99 +-- mlprec/mld_z_ilu_solver.f90 | 101 +-- mlprec/mld_z_mumps_solver.F90 | 108 +-- mlprec/mld_z_onelev_mod.f90 | 53 +- mlprec/mld_z_prec_mod.f90 | 31 - mlprec/mld_z_prec_type.f90 | 36 +- mlprec/mld_z_symdec_aggregator_mod.f90 | 15 + tests/Bcmatch/mld_d_pde3d.f90 | 17 +- tests/Bcmatch/runs/mld-bcm.inp | 16 +- 106 files changed, 288 insertions(+), 9079 deletions(-) delete mode 100644 mlprec/impl/level/mld_c_base_onelev_setc.f90 delete mode 100644 mlprec/impl/level/mld_c_base_onelev_seti.F90 delete mode 100644 mlprec/impl/level/mld_c_base_onelev_setr.f90 delete mode 100644 mlprec/impl/level/mld_d_base_onelev_setc.f90 delete mode 100644 mlprec/impl/level/mld_d_base_onelev_seti.F90 delete mode 100644 mlprec/impl/level/mld_d_base_onelev_setr.f90 delete mode 100644 mlprec/impl/level/mld_s_base_onelev_setc.f90 delete mode 100644 mlprec/impl/level/mld_s_base_onelev_seti.F90 delete mode 100644 mlprec/impl/level/mld_s_base_onelev_setr.f90 delete mode 100644 mlprec/impl/level/mld_z_base_onelev_setc.f90 delete mode 100644 mlprec/impl/level/mld_z_base_onelev_seti.F90 delete mode 100644 mlprec/impl/level/mld_z_base_onelev_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_c_as_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_c_as_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_c_as_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_c_base_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_c_base_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_c_base_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_d_as_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_d_as_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_d_as_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_d_base_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_d_base_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_d_base_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_s_as_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_s_as_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_s_as_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_s_base_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_s_base_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_s_base_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_z_as_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_z_as_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_z_as_smoother_setr.f90 delete mode 100644 mlprec/impl/smoother/mld_z_base_smoother_setc.f90 delete mode 100644 mlprec/impl/smoother/mld_z_base_smoother_seti.f90 delete mode 100644 mlprec/impl/smoother/mld_z_base_smoother_setr.f90 delete mode 100644 mlprec/impl/solver/mld_c_base_solver_setc.f90 delete mode 100644 mlprec/impl/solver/mld_c_base_solver_seti.f90 delete mode 100644 mlprec/impl/solver/mld_c_base_solver_setr.f90 delete mode 100644 mlprec/impl/solver/mld_d_base_solver_setc.f90 delete mode 100644 mlprec/impl/solver/mld_d_base_solver_seti.f90 delete mode 100644 mlprec/impl/solver/mld_d_base_solver_setr.f90 delete mode 100644 mlprec/impl/solver/mld_s_base_solver_setc.f90 delete mode 100644 mlprec/impl/solver/mld_s_base_solver_seti.f90 delete mode 100644 mlprec/impl/solver/mld_s_base_solver_setr.f90 delete mode 100644 mlprec/impl/solver/mld_z_base_solver_setc.f90 delete mode 100644 mlprec/impl/solver/mld_z_base_solver_seti.f90 delete mode 100644 mlprec/impl/solver/mld_z_base_solver_setr.f90 diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index 9cb12928..8ce9264f 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -19,9 +19,6 @@ mld_c_base_onelev_dump.o \ mld_c_base_onelev_free.o \ mld_c_base_onelev_mat_asb.o \ mld_c_base_onelev_setag.o \ -mld_c_base_onelev_setc.o \ -mld_c_base_onelev_seti.o \ -mld_c_base_onelev_setr.o \ mld_c_base_onelev_setsm.o \ mld_c_base_onelev_setsv.o \ mld_d_base_onelev_build.o \ @@ -35,9 +32,6 @@ mld_d_base_onelev_dump.o \ mld_d_base_onelev_free.o \ mld_d_base_onelev_mat_asb.o \ mld_d_base_onelev_setag.o \ -mld_d_base_onelev_setc.o \ -mld_d_base_onelev_seti.o \ -mld_d_base_onelev_setr.o \ mld_d_base_onelev_setsm.o \ mld_d_base_onelev_setsv.o \ mld_s_base_onelev_build.o \ @@ -51,9 +45,6 @@ mld_s_base_onelev_dump.o \ mld_s_base_onelev_free.o \ mld_s_base_onelev_mat_asb.o \ mld_s_base_onelev_setag.o \ -mld_s_base_onelev_setc.o \ -mld_s_base_onelev_seti.o \ -mld_s_base_onelev_setr.o \ mld_s_base_onelev_setsm.o \ mld_s_base_onelev_setsv.o \ mld_z_base_onelev_build.o \ @@ -67,12 +58,10 @@ mld_z_base_onelev_dump.o \ mld_z_base_onelev_free.o \ mld_z_base_onelev_mat_asb.o \ mld_z_base_onelev_setag.o \ -mld_z_base_onelev_setc.o \ -mld_z_base_onelev_seti.o \ -mld_z_base_onelev_setr.o \ mld_z_base_onelev_setsm.o \ mld_z_base_onelev_setsv.o + LIBNAME=libmld_prec.a lib: $(OBJS) diff --git a/mlprec/impl/level/mld_c_base_onelev_setc.f90 b/mlprec/impl/level/mld_c_base_onelev_setc.f90 deleted file mode 100644 index 93b8ff9c..00000000 --- a/mlprec/impl/level/mld_c_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='c_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_base_onelev_setc diff --git a/mlprec/impl/level/mld_c_base_onelev_seti.F90 b/mlprec/impl/level/mld_c_base_onelev_seti.F90 deleted file mode 100644 index 534915cc..00000000 --- a/mlprec/impl/level/mld_c_base_onelev_seti.F90 +++ /dev/null @@ -1,253 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_seti - use mld_c_base_aggregator_mod - use mld_c_dec_aggregator_mod - use mld_c_symdec_aggregator_mod - use mld_c_jac_smoother - use mld_c_as_smoother - use mld_c_diag_solver - use mld_c_ilu_solver - use mld_c_id_solver - use mld_c_gs_solver -#if defined(HAVE_SLU_) - use mld_c_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_c_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='c_base_onelev_seti' - type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold - type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold - type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold - type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold - type(mld_c_ilu_solver_type) :: mld_c_ilu_solver_mold - type(mld_c_id_solver_type) :: mld_c_id_solver_mold - type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold - type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold -#if defined(HAVE_SLU_) - type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_c_mumps_solver_type) :: mld_c_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_c_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_c_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_c_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_c_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_c_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_c_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_c_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_c_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_c_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_c_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_c_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_c_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_c_mumps_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_c_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_c_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_base_onelev_seti diff --git a/mlprec/impl/level/mld_c_base_onelev_setr.f90 b/mlprec/impl/level/mld_c_base_onelev_setr.f90 deleted file mode 100644 index adfd71ba..00000000 --- a/mlprec/impl/level/mld_c_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='c_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_base_onelev_setr diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index 18691606..d76c5b59 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -260,8 +260,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) - + end select if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/level/mld_d_base_onelev_setag.f90 b/mlprec/impl/level/mld_d_base_onelev_setag.f90 index 8e09ceb1..c4c26cca 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setag.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setag.f90 @@ -76,7 +76,6 @@ subroutine mld_d_base_onelev_setag(lv,val,info,pos) lv%parms%par_aggr_alg = mld_ext_aggr_ lv%parms%aggr_type = mld_noalg_ end if - call lv%aggr%default() end subroutine mld_d_base_onelev_setag diff --git a/mlprec/impl/level/mld_d_base_onelev_setc.f90 b/mlprec/impl/level/mld_d_base_onelev_setc.f90 deleted file mode 100644 index 4b5f633b..00000000 --- a/mlprec/impl/level/mld_d_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='d_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_base_onelev_setc diff --git a/mlprec/impl/level/mld_d_base_onelev_seti.F90 b/mlprec/impl/level/mld_d_base_onelev_seti.F90 deleted file mode 100644 index d68f2ec6..00000000 --- a/mlprec/impl/level/mld_d_base_onelev_seti.F90 +++ /dev/null @@ -1,273 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_seti - use mld_d_base_aggregator_mod - use mld_d_dec_aggregator_mod - use mld_d_symdec_aggregator_mod - use mld_d_jac_smoother - use mld_d_as_smoother - use mld_d_diag_solver - use mld_d_ilu_solver - use mld_d_id_solver - use mld_d_gs_solver -#if defined(HAVE_UMF_) - use mld_d_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_d_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_d_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_d_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='d_base_onelev_seti' - type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold - type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold - type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold - type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold - type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold - type(mld_d_id_solver_type) :: mld_d_id_solver_mold - type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold - type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold -#if defined(HAVE_UMF_) - type(mld_d_umf_solver_type) :: mld_d_umf_solver_mold -#endif -#if defined(HAVE_SLUDIST_) - type(mld_d_sludist_solver_type) :: mld_d_sludist_solver_mold -#endif -#if defined(HAVE_SLU_) - type(mld_d_slu_solver_type) :: mld_d_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_d_mumps_solver_type) :: mld_d_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_d_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_d_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_d_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_d_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_d_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_d_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_d_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_d_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_d_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_d_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_d_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_d_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_d_mumps_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_SLUDIST_ - case (mld_sludist_) - call lv%set(mld_d_sludist_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_UMF_ - case (mld_umf_) - call lv%set(mld_d_umf_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_d_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_d_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_base_onelev_seti diff --git a/mlprec/impl/level/mld_d_base_onelev_setr.f90 b/mlprec/impl/level/mld_d_base_onelev_setr.f90 deleted file mode 100644 index dfd96da7..00000000 --- a/mlprec/impl/level/mld_d_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='d_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_base_onelev_setr diff --git a/mlprec/impl/level/mld_s_base_onelev_setc.f90 b/mlprec/impl/level/mld_s_base_onelev_setc.f90 deleted file mode 100644 index 1093ce9a..00000000 --- a/mlprec/impl/level/mld_s_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='s_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_base_onelev_setc diff --git a/mlprec/impl/level/mld_s_base_onelev_seti.F90 b/mlprec/impl/level/mld_s_base_onelev_seti.F90 deleted file mode 100644 index 7d12cf9b..00000000 --- a/mlprec/impl/level/mld_s_base_onelev_seti.F90 +++ /dev/null @@ -1,253 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_seti - use mld_s_base_aggregator_mod - use mld_s_dec_aggregator_mod - use mld_s_symdec_aggregator_mod - use mld_s_jac_smoother - use mld_s_as_smoother - use mld_s_diag_solver - use mld_s_ilu_solver - use mld_s_id_solver - use mld_s_gs_solver -#if defined(HAVE_SLU_) - use mld_s_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_s_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='s_base_onelev_seti' - type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold - type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold - type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold - type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold - type(mld_s_ilu_solver_type) :: mld_s_ilu_solver_mold - type(mld_s_id_solver_type) :: mld_s_id_solver_mold - type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold - type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold -#if defined(HAVE_SLU_) - type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_s_mumps_solver_type) :: mld_s_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_s_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_s_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_s_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_s_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_s_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_s_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_s_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_s_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_s_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_s_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_s_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_s_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_s_mumps_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_s_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_s_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_base_onelev_seti diff --git a/mlprec/impl/level/mld_s_base_onelev_setr.f90 b/mlprec/impl/level/mld_s_base_onelev_setr.f90 deleted file mode 100644 index 2aeee09c..00000000 --- a/mlprec/impl/level/mld_s_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='s_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_base_onelev_setr diff --git a/mlprec/impl/level/mld_z_base_onelev_setc.f90 b/mlprec/impl/level/mld_z_base_onelev_setc.f90 deleted file mode 100644 index 137ee584..00000000 --- a/mlprec/impl/level/mld_z_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='z_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_base_onelev_setc diff --git a/mlprec/impl/level/mld_z_base_onelev_seti.F90 b/mlprec/impl/level/mld_z_base_onelev_seti.F90 deleted file mode 100644 index bfba8765..00000000 --- a/mlprec/impl/level/mld_z_base_onelev_seti.F90 +++ /dev/null @@ -1,273 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_seti - use mld_z_base_aggregator_mod - use mld_z_dec_aggregator_mod - use mld_z_symdec_aggregator_mod - use mld_z_jac_smoother - use mld_z_as_smoother - use mld_z_diag_solver - use mld_z_ilu_solver - use mld_z_id_solver - use mld_z_gs_solver -#if defined(HAVE_UMF_) - use mld_z_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_z_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_z_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_z_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='z_base_onelev_seti' - type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold - type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold - type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold - type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold - type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold - type(mld_z_id_solver_type) :: mld_z_id_solver_mold - type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold - type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold -#if defined(HAVE_UMF_) - type(mld_z_umf_solver_type) :: mld_z_umf_solver_mold -#endif -#if defined(HAVE_SLUDIST_) - type(mld_z_sludist_solver_type) :: mld_z_sludist_solver_mold -#endif -#if defined(HAVE_SLU_) - type(mld_z_slu_solver_type) :: mld_z_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_z_mumps_solver_type) :: mld_z_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_z_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_z_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_z_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_z_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_z_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_z_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_z_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_z_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_z_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_z_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_z_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_z_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_z_mumps_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_SLUDIST_ - case (mld_sludist_) - call lv%set(mld_z_sludist_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_UMF_ - case (mld_umf_) - call lv%set(mld_z_umf_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_z_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_z_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_base_onelev_seti diff --git a/mlprec/impl/level/mld_z_base_onelev_setr.f90 b/mlprec/impl/level/mld_z_base_onelev_setr.f90 deleted file mode 100644 index f2303e41..00000000 --- a/mlprec/impl/level/mld_z_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='z_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_base_onelev_setr diff --git a/mlprec/impl/mld_cprecset.F90 b/mlprec/impl/mld_cprecset.F90 index 24e2d659..5bfc0b66 100644 --- a/mlprec/impl/mld_cprecset.F90 +++ b/mlprec/impl/mld_cprecset.F90 @@ -37,385 +37,6 @@ ! ! File: mld_cprecset.f90 ! -! Subroutine: mld_cprecseti -! Version: complex -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and complex parameters, see mld_cprecsetc and mld_cprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_cprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_c_prec_mod, mld_protect_name => mld_cprecseti - use mld_c_jac_smoother - use mld_c_as_smoother - use mld_c_diag_solver - use mld_c_ilu_solver - use mld_c_id_solver - use mld_c_gs_solver -#if defined(HAVE_SLU_) - use mld_c_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_c_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_cprecseti - subroutine mld_cprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -606,251 +227,3 @@ subroutine mld_cprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_cprecsetag -! -! Subroutine: mld_cprecsetc -! Version: complex -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and complex parameters, see mld_cprecseti and mld_cprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_cprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_cprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_c_prec_mod, mld_protect_name => mld_cprecsetc - - implicit none - - ! Arguments - class(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_cprecsetc - - -! -! Subroutine: mld_cprecsetr -! Version: complex -! -! This routine sets the complex parameters defining the preconditioner. More -! precisely, the complex parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_cprecseti and mld_cprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_cprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_spk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_cprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_c_prec_mod, mld_protect_name => mld_cprecsetr - - implicit none - - ! Arguments - class(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_spk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(sone,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_cprecsetr - - - - diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index aa4bf23c..44daac05 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -37,418 +37,6 @@ ! ! File: mld_dprecset.f90 ! -! Subroutine: mld_dprecseti -! Version: real -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and real parameters, see mld_dprecsetc and mld_dprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_dprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_d_prec_mod, mld_protect_name => mld_dprecseti - use mld_d_jac_smoother - use mld_d_as_smoother - use mld_d_diag_solver - use mld_d_ilu_solver - use mld_d_id_solver - use mld_d_gs_solver -#if defined(HAVE_UMF_) - use mld_d_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_d_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_d_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_d_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_sludist_) -#if defined(HAVE_SLUDIST_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLUDIST_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_dprecseti - subroutine mld_dprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -639,251 +227,3 @@ subroutine mld_dprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_dprecsetag -! -! Subroutine: mld_dprecsetc -! Version: real -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and real parameters, see mld_dprecseti and mld_dprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_dprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_dprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_d_prec_mod, mld_protect_name => mld_dprecsetc - - implicit none - - ! Arguments - class(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_dprecsetc - - -! -! Subroutine: mld_dprecsetr -! Version: real -! -! This routine sets the real parameters defining the preconditioner. More -! precisely, the real parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_dprecseti and mld_dprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_dprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_dpk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_dprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_d_prec_mod, mld_protect_name => mld_dprecsetr - - implicit none - - ! Arguments - class(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_dpk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(done,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_dprecsetr - - - - diff --git a/mlprec/impl/mld_sprecset.F90 b/mlprec/impl/mld_sprecset.F90 index 3780e959..6ee91285 100644 --- a/mlprec/impl/mld_sprecset.F90 +++ b/mlprec/impl/mld_sprecset.F90 @@ -37,385 +37,6 @@ ! ! File: mld_sprecset.f90 ! -! Subroutine: mld_sprecseti -! Version: real -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and real parameters, see mld_sprecsetc and mld_sprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_sprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_s_prec_mod, mld_protect_name => mld_sprecseti - use mld_s_jac_smoother - use mld_s_as_smoother - use mld_s_diag_solver - use mld_s_ilu_solver - use mld_s_id_solver - use mld_s_gs_solver -#if defined(HAVE_SLU_) - use mld_s_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_s_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_sprecseti - subroutine mld_sprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -606,251 +227,3 @@ subroutine mld_sprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_sprecsetag -! -! Subroutine: mld_sprecsetc -! Version: real -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and real parameters, see mld_sprecseti and mld_sprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_sprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_sprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_s_prec_mod, mld_protect_name => mld_sprecsetc - - implicit none - - ! Arguments - class(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_sprecsetc - - -! -! Subroutine: mld_sprecsetr -! Version: real -! -! This routine sets the real parameters defining the preconditioner. More -! precisely, the real parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_sprecseti and mld_sprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_sprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_spk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_sprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_s_prec_mod, mld_protect_name => mld_sprecsetr - - implicit none - - ! Arguments - class(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_spk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(sone,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_sprecsetr - - - - diff --git a/mlprec/impl/mld_zprecset.F90 b/mlprec/impl/mld_zprecset.F90 index da553cb1..ad4fcf03 100644 --- a/mlprec/impl/mld_zprecset.F90 +++ b/mlprec/impl/mld_zprecset.F90 @@ -37,418 +37,6 @@ ! ! File: mld_zprecset.f90 ! -! Subroutine: mld_zprecseti -! Version: complex -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and complex parameters, see mld_zprecsetc and mld_zprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_zprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_zprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_z_prec_mod, mld_protect_name => mld_zprecseti - use mld_z_jac_smoother - use mld_z_as_smoother - use mld_z_diag_solver - use mld_z_ilu_solver - use mld_z_id_solver - use mld_z_gs_solver -#if defined(HAVE_UMF_) - use mld_z_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_z_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_z_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_z_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_sludist_) -#if defined(HAVE_SLUDIST_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLUDIST_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_zprecseti - subroutine mld_zprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -639,251 +227,3 @@ subroutine mld_zprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_zprecsetag -! -! Subroutine: mld_zprecsetc -! Version: complex -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and complex parameters, see mld_zprecseti and mld_zprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_zprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_zprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_z_prec_mod, mld_protect_name => mld_zprecsetc - - implicit none - - ! Arguments - class(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_zprecsetc - - -! -! Subroutine: mld_zprecsetr -! Version: complex -! -! This routine sets the complex parameters defining the preconditioner. More -! precisely, the complex parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_zprecseti and mld_zprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_zprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_dpk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_zprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_z_prec_mod, mld_protect_name => mld_zprecsetr - - implicit none - - ! Arguments - class(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_dpk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(done,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_zprecsetr - - - - diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index 8aef9cda..89dbf942 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -18,9 +18,6 @@ mld_c_as_smoother_cseti.o \ mld_c_as_smoother_csetr.o \ mld_c_as_smoother_dmp.o \ mld_c_as_smoother_free.o \ -mld_c_as_smoother_setc.o \ -mld_c_as_smoother_seti.o \ -mld_c_as_smoother_setr.o \ mld_c_as_smoother_prol_a.o \ mld_c_as_smoother_prol_v.o \ mld_c_as_smoother_restr_a.o \ @@ -37,9 +34,6 @@ mld_c_base_smoother_csetr.o \ mld_c_base_smoother_descr.o \ mld_c_base_smoother_dmp.o \ mld_c_base_smoother_free.o \ -mld_c_base_smoother_setc.o \ -mld_c_base_smoother_seti.o \ -mld_c_base_smoother_setr.o \ mld_c_jac_smoother_apply.o \ mld_c_jac_smoother_apply_vect.o \ mld_c_jac_smoother_bld.o \ @@ -58,9 +52,6 @@ mld_d_as_smoother_cseti.o \ mld_d_as_smoother_csetr.o \ mld_d_as_smoother_dmp.o \ mld_d_as_smoother_free.o \ -mld_d_as_smoother_setc.o \ -mld_d_as_smoother_seti.o \ -mld_d_as_smoother_setr.o \ mld_d_as_smoother_prol_a.o \ mld_d_as_smoother_prol_v.o \ mld_d_as_smoother_restr_a.o \ @@ -77,9 +68,6 @@ mld_d_base_smoother_csetr.o \ mld_d_base_smoother_descr.o \ mld_d_base_smoother_dmp.o \ mld_d_base_smoother_free.o \ -mld_d_base_smoother_setc.o \ -mld_d_base_smoother_seti.o \ -mld_d_base_smoother_setr.o \ mld_d_jac_smoother_apply.o \ mld_d_jac_smoother_apply_vect.o \ mld_d_jac_smoother_bld.o \ @@ -98,9 +86,6 @@ mld_s_as_smoother_cseti.o \ mld_s_as_smoother_csetr.o \ mld_s_as_smoother_dmp.o \ mld_s_as_smoother_free.o \ -mld_s_as_smoother_setc.o \ -mld_s_as_smoother_seti.o \ -mld_s_as_smoother_setr.o \ mld_s_as_smoother_prol_a.o \ mld_s_as_smoother_prol_v.o \ mld_s_as_smoother_restr_a.o \ @@ -117,9 +102,6 @@ mld_s_base_smoother_csetr.o \ mld_s_base_smoother_descr.o \ mld_s_base_smoother_dmp.o \ mld_s_base_smoother_free.o \ -mld_s_base_smoother_setc.o \ -mld_s_base_smoother_seti.o \ -mld_s_base_smoother_setr.o \ mld_s_jac_smoother_apply.o \ mld_s_jac_smoother_apply_vect.o \ mld_s_jac_smoother_bld.o \ @@ -138,9 +120,6 @@ mld_z_as_smoother_cseti.o \ mld_z_as_smoother_csetr.o \ mld_z_as_smoother_dmp.o \ mld_z_as_smoother_free.o \ -mld_z_as_smoother_setc.o \ -mld_z_as_smoother_seti.o \ -mld_z_as_smoother_setr.o \ mld_z_as_smoother_prol_a.o \ mld_z_as_smoother_prol_v.o \ mld_z_as_smoother_restr_a.o \ @@ -157,9 +136,6 @@ mld_z_base_smoother_csetr.o \ mld_z_base_smoother_descr.o \ mld_z_base_smoother_dmp.o \ mld_z_base_smoother_free.o \ -mld_z_base_smoother_setc.o \ -mld_z_base_smoother_seti.o \ -mld_z_base_smoother_setr.o \ mld_z_jac_smoother_apply.o \ mld_z_jac_smoother_apply_vect.o \ mld_z_jac_smoother_bld.o \ @@ -168,7 +144,6 @@ mld_z_jac_smoother_dmp.o \ mld_z_jac_smoother_clone.o \ mld_z_jac_smoother_cnv.o - LIBNAME=libmld_prec.a lib: $(OBJS) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 deleted file mode 100644 index abf19e45..00000000 --- a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_setc - Implicit None - ! Arguments - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_c_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 deleted file mode 100644 index d401f944..00000000 --- a/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_seti - Implicit None - - ! Arguments - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_c_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 deleted file mode 100644 index 46f6c546..00000000 --- a/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_setr - Implicit None - ! Arguments - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 deleted file mode 100644 index 88b82f78..00000000 --- a/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_setc - Implicit None - - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_c_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_c_base_smoother_seti.f90 deleted file mode 100644 index 9ea67f47..00000000 --- a/mlprec/impl/smoother/mld_c_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_seti - Implicit None - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_c_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_c_base_smoother_setr.f90 deleted file mode 100644 index eaf9ca24..00000000 --- a/mlprec/impl/smoother/mld_c_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_setr - Implicit None - - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_smoother_setr diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 deleted file mode 100644 index c90c0cfb..00000000 --- a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_setc - Implicit None - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_d_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 deleted file mode 100644 index 2b84d5bb..00000000 --- a/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_seti - Implicit None - - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_d_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 deleted file mode 100644 index e87297a5..00000000 --- a/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_setr - Implicit None - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 deleted file mode 100644 index cf5f34e8..00000000 --- a/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_setc - Implicit None - - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_d_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_d_base_smoother_seti.f90 deleted file mode 100644 index ea9deef4..00000000 --- a/mlprec/impl/smoother/mld_d_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_seti - Implicit None - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_d_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_d_base_smoother_setr.f90 deleted file mode 100644 index 80f5ec7f..00000000 --- a/mlprec/impl/smoother/mld_d_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_setr - Implicit None - - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_smoother_setr diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 deleted file mode 100644 index 842fa945..00000000 --- a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_setc - Implicit None - ! Arguments - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_s_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 deleted file mode 100644 index c4fee0fd..00000000 --- a/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_seti - Implicit None - - ! Arguments - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_s_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 deleted file mode 100644 index 1eb9fe99..00000000 --- a/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_setr - Implicit None - ! Arguments - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 deleted file mode 100644 index 0e04cddf..00000000 --- a/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_setc - Implicit None - - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_s_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_s_base_smoother_seti.f90 deleted file mode 100644 index b840ce5e..00000000 --- a/mlprec/impl/smoother/mld_s_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_seti - Implicit None - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_s_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_s_base_smoother_setr.f90 deleted file mode 100644 index 4a0d4936..00000000 --- a/mlprec/impl/smoother/mld_s_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_setr - Implicit None - - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_smoother_setr diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 deleted file mode 100644 index c928b1aa..00000000 --- a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_setc - Implicit None - ! Arguments - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_z_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 deleted file mode 100644 index ba29e8ec..00000000 --- a/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_seti - Implicit None - - ! Arguments - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_z_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 deleted file mode 100644 index 88f54237..00000000 --- a/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_setr - Implicit None - ! Arguments - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 deleted file mode 100644 index cb342510..00000000 --- a/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_setc - Implicit None - - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_z_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_z_base_smoother_seti.f90 deleted file mode 100644 index 0c089f6b..00000000 --- a/mlprec/impl/smoother/mld_z_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_seti - Implicit None - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_z_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_z_base_smoother_setr.f90 deleted file mode 100644 index 330b4093..00000000 --- a/mlprec/impl/smoother/mld_z_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_setr - Implicit None - - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_smoother_setr diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index 71dba236..d688c6e0 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -19,9 +19,6 @@ mld_c_base_solver_csetr.o \ mld_c_base_solver_descr.o \ mld_c_base_solver_dmp.o \ mld_c_base_solver_free.o \ -mld_c_base_solver_setc.o \ -mld_c_base_solver_seti.o \ -mld_c_base_solver_setr.o \ mld_c_diag_solver_apply.o \ mld_c_diag_solver_apply_vect.o \ mld_c_diag_solver_bld.o \ @@ -64,9 +61,6 @@ mld_d_base_solver_csetr.o \ mld_d_base_solver_descr.o \ mld_d_base_solver_dmp.o \ mld_d_base_solver_free.o \ -mld_d_base_solver_setc.o \ -mld_d_base_solver_seti.o \ -mld_d_base_solver_setr.o \ mld_d_diag_solver_apply.o \ mld_d_diag_solver_apply_vect.o \ mld_d_diag_solver_bld.o \ @@ -109,9 +103,6 @@ mld_s_base_solver_csetr.o \ mld_s_base_solver_descr.o \ mld_s_base_solver_dmp.o \ mld_s_base_solver_free.o \ -mld_s_base_solver_setc.o \ -mld_s_base_solver_seti.o \ -mld_s_base_solver_setr.o \ mld_s_diag_solver_apply.o \ mld_s_diag_solver_apply_vect.o \ mld_s_diag_solver_bld.o \ @@ -154,9 +145,6 @@ mld_z_base_solver_csetr.o \ mld_z_base_solver_descr.o \ mld_z_base_solver_dmp.o \ mld_z_base_solver_free.o \ -mld_z_base_solver_setc.o \ -mld_z_base_solver_seti.o \ -mld_z_base_solver_setr.o \ mld_z_diag_solver_apply.o \ mld_z_diag_solver_apply_vect.o \ mld_z_diag_solver_bld.o \ @@ -187,7 +175,7 @@ mld_zilut_fact.o \ mld_z_mumps_solver_apply.o \ mld_z_mumps_solver_apply_vect.o \ mld_z_mumps_solver_bld.o \ - + LIBNAME=libmld_prec.a diff --git a/mlprec/impl/solver/mld_c_base_solver_setc.f90 b/mlprec/impl/solver/mld_c_base_solver_setc.f90 deleted file mode 100644 index 53f1201e..00000000 --- a/mlprec/impl/solver/mld_c_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_setc - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_solver_setc diff --git a/mlprec/impl/solver/mld_c_base_solver_seti.f90 b/mlprec/impl/solver/mld_c_base_solver_seti.f90 deleted file mode 100644 index 3a461e05..00000000 --- a/mlprec/impl/solver/mld_c_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_seti - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_c_base_solver_seti diff --git a/mlprec/impl/solver/mld_c_base_solver_setr.f90 b/mlprec/impl/solver/mld_c_base_solver_setr.f90 deleted file mode 100644 index f6ea6371..00000000 --- a/mlprec/impl/solver/mld_c_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_c_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_setr - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_c_base_solver_setr diff --git a/mlprec/impl/solver/mld_d_base_solver_setc.f90 b/mlprec/impl/solver/mld_d_base_solver_setc.f90 deleted file mode 100644 index e2664ce7..00000000 --- a/mlprec/impl/solver/mld_d_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_setc - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_solver_setc diff --git a/mlprec/impl/solver/mld_d_base_solver_seti.f90 b/mlprec/impl/solver/mld_d_base_solver_seti.f90 deleted file mode 100644 index 4e18f78f..00000000 --- a/mlprec/impl/solver/mld_d_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_seti - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_d_base_solver_seti diff --git a/mlprec/impl/solver/mld_d_base_solver_setr.f90 b/mlprec/impl/solver/mld_d_base_solver_setr.f90 deleted file mode 100644 index a933cfd6..00000000 --- a/mlprec/impl/solver/mld_d_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_d_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_setr - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_d_base_solver_setr diff --git a/mlprec/impl/solver/mld_s_base_solver_setc.f90 b/mlprec/impl/solver/mld_s_base_solver_setc.f90 deleted file mode 100644 index 23e17ce5..00000000 --- a/mlprec/impl/solver/mld_s_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_setc - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_solver_setc diff --git a/mlprec/impl/solver/mld_s_base_solver_seti.f90 b/mlprec/impl/solver/mld_s_base_solver_seti.f90 deleted file mode 100644 index 0a7fb9e6..00000000 --- a/mlprec/impl/solver/mld_s_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_seti - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_s_base_solver_seti diff --git a/mlprec/impl/solver/mld_s_base_solver_setr.f90 b/mlprec/impl/solver/mld_s_base_solver_setr.f90 deleted file mode 100644 index d0f25532..00000000 --- a/mlprec/impl/solver/mld_s_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_s_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_setr - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_s_base_solver_setr diff --git a/mlprec/impl/solver/mld_z_base_solver_setc.f90 b/mlprec/impl/solver/mld_z_base_solver_setc.f90 deleted file mode 100644 index a0d60a99..00000000 --- a/mlprec/impl/solver/mld_z_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_setc - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_solver_setc diff --git a/mlprec/impl/solver/mld_z_base_solver_seti.f90 b/mlprec/impl/solver/mld_z_base_solver_seti.f90 deleted file mode 100644 index ebeec939..00000000 --- a/mlprec/impl/solver/mld_z_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_seti - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_z_base_solver_seti diff --git a/mlprec/impl/solver/mld_z_base_solver_setr.f90 b/mlprec/impl/solver/mld_z_base_solver_setr.f90 deleted file mode 100644 index a31ba30d..00000000 --- a/mlprec/impl/solver/mld_z_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -subroutine mld_z_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_setr - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_z_base_solver_setr diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 2da8aedb..9a84bad5 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_c_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_c_as_smoother_free - procedure, pass(sm) :: seti => mld_c_as_smoother_seti - procedure, pass(sm) :: setc => mld_c_as_smoother_setc procedure, pass(sm) :: cseti => mld_c_as_smoother_cseti procedure, pass(sm) :: csetc => mld_c_as_smoother_csetc procedure, pass(sm) :: descr => c_as_smoother_descr @@ -253,42 +251,6 @@ module mld_c_as_smoother end subroutine mld_c_as_smoother_cnv end interface - interface - subroutine mld_c_as_smoother_seti(sm,what,val,info) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_as_smoother_seti - end interface - - interface - subroutine mld_c_as_smoother_setc(sm,what,val,info) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_as_smoother_setc - end interface - - interface - subroutine mld_c_as_smoother_setr(sm,what,val,info) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_as_smoother_setr - end interface - interface subroutine mld_c_as_smoother_cseti(sm,what,val,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index b62c9af1..7e816283 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -105,11 +105,41 @@ module mld_c_base_aggregator_mod procedure, pass(ag) :: descr => mld_c_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_c_base_aggregator_set_aggr_type procedure, nopass :: fmt => mld_c_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_c_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_c_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_c_base_aggregator_type contains + subroutine mld_c_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_c_base_aggregator_cseti + + subroutine mld_c_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_c_base_aggregator_csetr + + subroutine mld_c_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_c_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +189,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_c_base_aggregator_fmt subroutine mld_c_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +199,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index caf92d49..a17300f5 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_c_base_smoother_mod procedure, pass(sm) :: apply_a => mld_c_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_c_base_smoother_free - procedure, pass(sm) :: seti => mld_c_base_smoother_seti - procedure, pass(sm) :: setc => mld_c_base_smoother_setc - procedure, pass(sm) :: setr => mld_c_base_smoother_setr procedure, pass(sm) :: cseti => mld_c_base_smoother_cseti procedure, pass(sm) :: csetc => mld_c_base_smoother_csetc procedure, pass(sm) :: csetr => mld_c_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => c_base_smoother_default procedure, pass(sm) :: descr => mld_c_base_smoother_descr procedure, pass(sm) :: sizeof => c_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_c_base_smoother_mod end subroutine mld_c_base_smoother_check end interface - interface - subroutine mld_c_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_smoother_seti - end interface - - interface - subroutine mld_c_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_smoother_setc - end interface - - interface - subroutine mld_c_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_smoother_setr - end interface - interface subroutine mld_c_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index c4dc7f35..376abc61 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_c_base_solver_mod procedure, pass(sv) :: apply_a => mld_c_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_c_base_solver_free - procedure, pass(sv) :: seti => mld_c_base_solver_seti - procedure, pass(sv) :: setc => mld_c_base_solver_setc - procedure, pass(sv) :: setr => mld_c_base_solver_setr procedure, pass(sv) :: cseti => mld_c_base_solver_cseti procedure, pass(sv) :: csetc => mld_c_base_solver_csetc procedure, pass(sv) :: csetr => mld_c_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => c_base_solver_default procedure, pass(sv) :: descr => mld_c_base_solver_descr procedure, pass(sv) :: sizeof => c_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_c_base_solver_mod end subroutine mld_c_base_solver_check end interface - interface - subroutine mld_c_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_solver_seti - end interface - - interface - subroutine mld_c_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_solver_setc - end interface - - interface - subroutine mld_c_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_solver_setr - end interface - interface subroutine mld_c_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_dec_aggregator_mod.f90 b/mlprec/mld_c_dec_aggregator_mod.f90 index 53a5f2c9..e933494c 100644 --- a/mlprec/mld_c_dec_aggregator_mod.f90 +++ b/mlprec/mld_c_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_c_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_c_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_c_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_c_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_c_dec_aggregator_descr procedure, nopass :: fmt => mld_c_dec_aggregator_fmt end type mld_c_dec_aggregator_type @@ -190,4 +191,18 @@ contains val = "Decoupled aggregation" end function mld_c_dec_aggregator_fmt + subroutine mld_c_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_c_dec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_c_dec_aggregator_descr + end module mld_c_dec_aggregator_mod diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 0ce986b2..746843ba 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_c_gs_solver procedure, pass(sv) :: apply_v => mld_c_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_gs_solver_apply procedure, pass(sv) :: free => c_gs_solver_free - procedure, pass(sv) :: seti => c_gs_solver_seti - procedure, pass(sv) :: setc => c_gs_solver_setc - procedure, pass(sv) :: setr => c_gs_solver_setr procedure, pass(sv) :: cseti => c_gs_solver_cseti procedure, pass(sv) :: csetc => c_gs_solver_csetc procedure, pass(sv) :: csetr => c_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_c_gs_solver private :: c_gs_solver_bld, c_gs_solver_apply, & - & c_gs_solver_free, c_gs_solver_seti, & - & c_gs_solver_setc, c_gs_solver_setr,& + & c_gs_solver_free, & & c_gs_solver_descr, c_gs_solver_sizeof, & & c_gs_solver_default, c_gs_solver_dmp, & & c_gs_solver_apply_vect, c_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine c_gs_solver_check - - subroutine c_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_gs_solver_seti - - subroutine c_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_gs_solver_setc - - subroutine c_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_gs_solver_setr - subroutine c_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 8ee43c46..f7358797 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_c_ilu_solver procedure, pass(sv) :: apply_v => mld_c_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_ilu_solver_apply procedure, pass(sv) :: free => c_ilu_solver_free - procedure, pass(sv) :: seti => c_ilu_solver_seti - procedure, pass(sv) :: setc => c_ilu_solver_setc - procedure, pass(sv) :: setr => c_ilu_solver_setr procedure, pass(sv) :: cseti => c_ilu_solver_cseti procedure, pass(sv) :: csetc => c_ilu_solver_csetc procedure, pass(sv) :: csetr => c_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_c_ilu_solver private :: c_ilu_solver_bld, c_ilu_solver_apply, & - & c_ilu_solver_free, c_ilu_solver_seti, & - & c_ilu_solver_setc, c_ilu_solver_setr,& + & c_ilu_solver_free, & & c_ilu_solver_descr, c_ilu_solver_sizeof, & & c_ilu_solver_default, c_ilu_solver_dmp, & & c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine c_ilu_solver_check - - subroutine c_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_ilu_solver_seti - - subroutine c_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_ilu_solver_setc - - subroutine c_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_ilu_solver_setr - subroutine c_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_c_mumps_solver.F90 b/mlprec/mld_c_mumps_solver.F90 index cf4b2db8..0e2baca4 100644 --- a/mlprec/mld_c_mumps_solver.F90 +++ b/mlprec/mld_c_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_c_mumps_solver procedure, pass(sv) :: free => c_mumps_solver_free procedure, pass(sv) :: descr => c_mumps_solver_descr procedure, pass(sv) :: sizeof => c_mumps_solver_sizeof - procedure, pass(sv) :: seti => c_mumps_solver_seti - procedure, pass(sv) :: setr => c_mumps_solver_setr procedure, pass(sv) :: cseti =>c_mumps_solver_cseti procedure, pass(sv) :: csetr => c_mumps_solver_csetr procedure, pass(sv) :: default => c_mumps_solver_default @@ -93,8 +91,7 @@ module mld_c_mumps_solver private :: c_mumps_solver_bld, c_mumps_solver_apply, & & c_mumps_solver_free, c_mumps_solver_descr, & & c_mumps_solver_sizeof, c_mumps_solver_apply_vect,& - & c_mumps_solver_seti, c_mumps_solver_setr, & - & c_mumps_solver_cseti, c_mumps_solver_csetri, & + & c_mumps_solver_cseti, c_mumps_solver_csetr, & & c_mumps_solver_default, c_mumps_solver_get_fmt, & & c_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine c_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine c_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_mumps_solver_seti - - - subroutine c_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_mumps_solver_setr subroutine c_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_c_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_c_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_c_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_c_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index 1ca988ed..b836b66b 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_c_onelev_mod procedure, pass(lv) :: nullify => c_base_onelev_nullify procedure, pass(lv) :: check => mld_c_base_onelev_check procedure, pass(lv) :: dump => mld_c_base_onelev_dump - procedure, pass(lv) :: seti => mld_c_base_onelev_seti - procedure, pass(lv) :: setr => mld_c_base_onelev_setr - procedure, pass(lv) :: setc => mld_c_base_onelev_setc procedure, pass(lv) :: cseti => mld_c_base_onelev_cseti procedure, pass(lv) :: csetr => mld_c_base_onelev_csetr procedure, pass(lv) :: csetc => mld_c_base_onelev_csetc procedure, pass(lv) :: setsm => mld_c_base_onelev_setsm procedure, pass(lv) :: setsv => mld_c_base_onelev_setsv procedure, pass(lv) :: setag => mld_c_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => c_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_c_onelev_mod end subroutine mld_c_base_onelev_check end interface - interface - subroutine mld_c_base_onelev_seti(lv,what,val,info,pos) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_c_base_onelev_seti - end interface - interface subroutine mld_c_base_onelev_setsm(lv,val,info,pos) import :: psb_spk_, mld_c_onelev_type, mld_c_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_c_onelev_mod end subroutine mld_c_base_onelev_setag end interface - interface - subroutine mld_c_base_onelev_setc(lv,what,val,info,pos) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_c_base_onelev_setc - end interface - - interface - subroutine mld_c_base_onelev_setr(lv,what,val,info,pos) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_c_base_onelev_setr - end interface - - interface subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_prec_mod.f90 b/mlprec/mld_c_prec_mod.f90 index 682b0548..990e4055 100644 --- a/mlprec/mld_c_prec_mod.f90 +++ b/mlprec/mld_c_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_c_prec_mod interface mld_precset module procedure mld_c_iprecsetsm, mld_c_iprecsetsv, & - & mld_c_iprecseti, mld_c_iprecsetc, mld_c_iprecsetr, & & mld_c_cprecseti, mld_c_cprecsetc, mld_c_cprecsetr, & & mld_c_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_c_iprecsetag - subroutine mld_c_iprecseti(p,what,val,info,pos) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_c_iprecseti - - subroutine mld_c_iprecsetr(p,what,val,info,pos) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_c_iprecsetr - - subroutine mld_c_iprecsetc(p,what,val,info,pos) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_c_iprecsetc - subroutine mld_c_cprecseti(p,what,val,info,pos) type(mld_cprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index a6f37391..7a9d4d13 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -128,14 +128,10 @@ module mld_c_prec_type procedure, pass(prec) :: setsm => mld_cprecsetsm procedure, pass(prec) :: setsv => mld_cprecsetsv procedure, pass(prec) :: setag => mld_cprecsetag - procedure, pass(prec) :: seti => mld_cprecseti - procedure, pass(prec) :: setc => mld_cprecsetc - procedure, pass(prec) :: setr => mld_cprecsetr procedure, pass(prec) :: cseti => mld_ccprecseti procedure, pass(prec) :: csetc => mld_ccprecsetc procedure, pass(prec) :: csetr => mld_ccprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_c_get_smootherp procedure, pass(prec) :: get_solver => mld_c_get_solverp procedure, pass(prec) :: move_alloc => c_prec_move_alloc @@ -245,36 +241,6 @@ module mld_c_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_cprecsetag - subroutine mld_cprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_cspmat_type, psb_desc_type, psb_spk_, & - & mld_cprec_type, psb_ipk_ - class(mld_cprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_cprecseti - subroutine mld_cprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_cspmat_type, psb_desc_type, psb_spk_, & - & mld_cprec_type, psb_ipk_ - class(mld_cprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_cprecsetr - subroutine mld_cprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_cspmat_type, psb_desc_type, psb_spk_, & - & mld_cprec_type, psb_ipk_ - class(mld_cprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_cprecsetc subroutine mld_ccprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & mld_cprec_type, psb_ipk_ diff --git a/mlprec/mld_c_symdec_aggregator_mod.f90 b/mlprec/mld_c_symdec_aggregator_mod.f90 index f3df179e..a3dd8fb9 100644 --- a/mlprec/mld_c_symdec_aggregator_mod.f90 +++ b/mlprec/mld_c_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_c_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_c_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_c_symdec_aggregator_descr procedure, nopass :: fmt => mld_c_symdec_aggregator_fmt end type mld_c_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_c_symdec_aggregator_fmt + subroutine mld_c_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_c_symdec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_c_symdec_aggregator_descr + end module mld_c_symdec_aggregator_mod diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 7dcb6641..8aaee4b9 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_d_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_d_as_smoother_free - procedure, pass(sm) :: seti => mld_d_as_smoother_seti - procedure, pass(sm) :: setc => mld_d_as_smoother_setc procedure, pass(sm) :: cseti => mld_d_as_smoother_cseti procedure, pass(sm) :: csetc => mld_d_as_smoother_csetc procedure, pass(sm) :: descr => d_as_smoother_descr @@ -253,42 +251,6 @@ module mld_d_as_smoother end subroutine mld_d_as_smoother_cnv end interface - interface - subroutine mld_d_as_smoother_seti(sm,what,val,info) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_as_smoother_seti - end interface - - interface - subroutine mld_d_as_smoother_setc(sm,what,val,info) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_as_smoother_setc - end interface - - interface - subroutine mld_d_as_smoother_setr(sm,what,val,info) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_as_smoother_setr - end interface - interface subroutine mld_d_as_smoother_cseti(sm,what,val,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 7a2b1eea..71d73c60 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -104,9 +104,10 @@ module mld_d_base_aggregator_mod procedure, pass(ag) :: default => mld_d_base_aggregator_default procedure, pass(ag) :: descr => mld_d_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_d_base_aggregator_set_aggr_type - procedure, pass(ag) :: cseti => mld_d_base_aggregator_cseti - generic, public :: set => cseti procedure, nopass :: fmt => mld_d_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_d_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_d_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_d_base_aggregator_type @@ -125,6 +126,20 @@ contains info = 0 end subroutine mld_d_base_aggregator_cseti + subroutine mld_d_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_d_base_aggregator_csetr + + subroutine mld_d_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_d_base_aggregator_type), target, intent(inout) :: ag, agnext diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index b382d100..18391f39 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_d_base_smoother_mod procedure, pass(sm) :: apply_a => mld_d_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_d_base_smoother_free - procedure, pass(sm) :: seti => mld_d_base_smoother_seti - procedure, pass(sm) :: setc => mld_d_base_smoother_setc - procedure, pass(sm) :: setr => mld_d_base_smoother_setr procedure, pass(sm) :: cseti => mld_d_base_smoother_cseti procedure, pass(sm) :: csetc => mld_d_base_smoother_csetc procedure, pass(sm) :: csetr => mld_d_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => d_base_smoother_default procedure, pass(sm) :: descr => mld_d_base_smoother_descr procedure, pass(sm) :: sizeof => d_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_d_base_smoother_mod end subroutine mld_d_base_smoother_check end interface - interface - subroutine mld_d_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_smoother_seti - end interface - - interface - subroutine mld_d_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_smoother_setc - end interface - - interface - subroutine mld_d_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_smoother_setr - end interface - interface subroutine mld_d_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 26e860e2..536f4ee6 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_d_base_solver_mod procedure, pass(sv) :: apply_a => mld_d_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_d_base_solver_free - procedure, pass(sv) :: seti => mld_d_base_solver_seti - procedure, pass(sv) :: setc => mld_d_base_solver_setc - procedure, pass(sv) :: setr => mld_d_base_solver_setr procedure, pass(sv) :: cseti => mld_d_base_solver_cseti procedure, pass(sv) :: csetc => mld_d_base_solver_csetc procedure, pass(sv) :: csetr => mld_d_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => d_base_solver_default procedure, pass(sv) :: descr => mld_d_base_solver_descr procedure, pass(sv) :: sizeof => d_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_d_base_solver_mod end subroutine mld_d_base_solver_check end interface - interface - subroutine mld_d_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_solver_seti - end interface - - interface - subroutine mld_d_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_solver_setc - end interface - - interface - subroutine mld_d_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_solver_setr - end interface - interface subroutine mld_d_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_dec_aggregator_mod.f90 b/mlprec/mld_d_dec_aggregator_mod.f90 index c835cd0b..3fa0247f 100644 --- a/mlprec/mld_d_dec_aggregator_mod.f90 +++ b/mlprec/mld_d_dec_aggregator_mod.f90 @@ -190,7 +190,7 @@ contains val = "Decoupled aggregation" end function mld_d_dec_aggregator_fmt - + subroutine mld_d_dec_aggregator_descr(ag,parms,iout,info) implicit none class(mld_d_dec_aggregator_type), intent(in) :: ag @@ -204,5 +204,5 @@ contains return end subroutine mld_d_dec_aggregator_descr - + end module mld_d_dec_aggregator_mod diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 35c818dc..46ac5898 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_d_gs_solver procedure, pass(sv) :: apply_v => mld_d_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_gs_solver_apply procedure, pass(sv) :: free => d_gs_solver_free - procedure, pass(sv) :: seti => d_gs_solver_seti - procedure, pass(sv) :: setc => d_gs_solver_setc - procedure, pass(sv) :: setr => d_gs_solver_setr procedure, pass(sv) :: cseti => d_gs_solver_cseti procedure, pass(sv) :: csetc => d_gs_solver_csetc procedure, pass(sv) :: csetr => d_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_d_gs_solver private :: d_gs_solver_bld, d_gs_solver_apply, & - & d_gs_solver_free, d_gs_solver_seti, & - & d_gs_solver_setc, d_gs_solver_setr,& + & d_gs_solver_free, & & d_gs_solver_descr, d_gs_solver_sizeof, & & d_gs_solver_default, d_gs_solver_dmp, & & d_gs_solver_apply_vect, d_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine d_gs_solver_check - - subroutine d_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_gs_solver_seti - - subroutine d_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_gs_solver_setc - - subroutine d_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_gs_solver_setr - subroutine d_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 2f435a35..e6b177a2 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_d_ilu_solver procedure, pass(sv) :: apply_v => mld_d_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_ilu_solver_apply procedure, pass(sv) :: free => d_ilu_solver_free - procedure, pass(sv) :: seti => d_ilu_solver_seti - procedure, pass(sv) :: setc => d_ilu_solver_setc - procedure, pass(sv) :: setr => d_ilu_solver_setr procedure, pass(sv) :: cseti => d_ilu_solver_cseti procedure, pass(sv) :: csetc => d_ilu_solver_csetc procedure, pass(sv) :: csetr => d_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_d_ilu_solver private :: d_ilu_solver_bld, d_ilu_solver_apply, & - & d_ilu_solver_free, d_ilu_solver_seti, & - & d_ilu_solver_setc, d_ilu_solver_setr,& + & d_ilu_solver_free, & & d_ilu_solver_descr, d_ilu_solver_sizeof, & & d_ilu_solver_default, d_ilu_solver_dmp, & & d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine d_ilu_solver_check - - subroutine d_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_ilu_solver_seti - - subroutine d_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_ilu_solver_setc - - subroutine d_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_ilu_solver_setr - subroutine d_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_d_mumps_solver.F90 b/mlprec/mld_d_mumps_solver.F90 index 2f2dab5f..f41822d8 100644 --- a/mlprec/mld_d_mumps_solver.F90 +++ b/mlprec/mld_d_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_d_mumps_solver procedure, pass(sv) :: free => d_mumps_solver_free procedure, pass(sv) :: descr => d_mumps_solver_descr procedure, pass(sv) :: sizeof => d_mumps_solver_sizeof - procedure, pass(sv) :: seti => d_mumps_solver_seti - procedure, pass(sv) :: setr => d_mumps_solver_setr procedure, pass(sv) :: cseti =>d_mumps_solver_cseti procedure, pass(sv) :: csetr => d_mumps_solver_csetr procedure, pass(sv) :: default => d_mumps_solver_default @@ -93,8 +91,7 @@ module mld_d_mumps_solver private :: d_mumps_solver_bld, d_mumps_solver_apply, & & d_mumps_solver_free, d_mumps_solver_descr, & & d_mumps_solver_sizeof, d_mumps_solver_apply_vect,& - & d_mumps_solver_seti, d_mumps_solver_setr, & - & d_mumps_solver_cseti, d_mumps_solver_csetri, & + & d_mumps_solver_cseti, d_mumps_solver_csetr, & & d_mumps_solver_default, d_mumps_solver_get_fmt, & & d_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine d_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine d_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_mumps_solver_seti - - - subroutine d_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_mumps_solver_setr subroutine d_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_d_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_d_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_d_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_d_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index 25caa9d7..7cc6a728 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_d_onelev_mod procedure, pass(lv) :: nullify => d_base_onelev_nullify procedure, pass(lv) :: check => mld_d_base_onelev_check procedure, pass(lv) :: dump => mld_d_base_onelev_dump - procedure, pass(lv) :: seti => mld_d_base_onelev_seti - procedure, pass(lv) :: setr => mld_d_base_onelev_setr - procedure, pass(lv) :: setc => mld_d_base_onelev_setc procedure, pass(lv) :: cseti => mld_d_base_onelev_cseti procedure, pass(lv) :: csetr => mld_d_base_onelev_csetr procedure, pass(lv) :: csetc => mld_d_base_onelev_csetc procedure, pass(lv) :: setsm => mld_d_base_onelev_setsm procedure, pass(lv) :: setsv => mld_d_base_onelev_setsv procedure, pass(lv) :: setag => mld_d_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => d_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_d_onelev_mod end subroutine mld_d_base_onelev_check end interface - interface - subroutine mld_d_base_onelev_seti(lv,what,val,info,pos) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_d_base_onelev_seti - end interface - interface subroutine mld_d_base_onelev_setsm(lv,val,info,pos) import :: psb_dpk_, mld_d_onelev_type, mld_d_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_d_onelev_mod end subroutine mld_d_base_onelev_setag end interface - interface - subroutine mld_d_base_onelev_setc(lv,what,val,info,pos) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_d_base_onelev_setc - end interface - - interface - subroutine mld_d_base_onelev_setr(lv,what,val,info,pos) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_d_base_onelev_setr - end interface - - interface subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_prec_mod.f90 b/mlprec/mld_d_prec_mod.f90 index e9ffb466..aff3a958 100644 --- a/mlprec/mld_d_prec_mod.f90 +++ b/mlprec/mld_d_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_d_prec_mod interface mld_precset module procedure mld_d_iprecsetsm, mld_d_iprecsetsv, & - & mld_d_iprecseti, mld_d_iprecsetc, mld_d_iprecsetr, & & mld_d_cprecseti, mld_d_cprecsetc, mld_d_cprecsetr, & & mld_d_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_d_iprecsetag - subroutine mld_d_iprecseti(p,what,val,info,pos) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_d_iprecseti - - subroutine mld_d_iprecsetr(p,what,val,info,pos) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_d_iprecsetr - - subroutine mld_d_iprecsetc(p,what,val,info,pos) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_d_iprecsetc - subroutine mld_d_cprecseti(p,what,val,info,pos) type(mld_dprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 64036b94..a2d6e763 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -128,14 +128,10 @@ module mld_d_prec_type procedure, pass(prec) :: setsm => mld_dprecsetsm procedure, pass(prec) :: setsv => mld_dprecsetsv procedure, pass(prec) :: setag => mld_dprecsetag - procedure, pass(prec) :: seti => mld_dprecseti - procedure, pass(prec) :: setc => mld_dprecsetc - procedure, pass(prec) :: setr => mld_dprecsetr procedure, pass(prec) :: cseti => mld_dcprecseti procedure, pass(prec) :: csetc => mld_dcprecsetc procedure, pass(prec) :: csetr => mld_dcprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_d_get_smootherp procedure, pass(prec) :: get_solver => mld_d_get_solverp procedure, pass(prec) :: move_alloc => d_prec_move_alloc @@ -245,36 +241,6 @@ module mld_d_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_dprecsetag - subroutine mld_dprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & - & mld_dprec_type, psb_ipk_ - class(mld_dprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_dprecseti - subroutine mld_dprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & - & mld_dprec_type, psb_ipk_ - class(mld_dprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_dprecsetr - subroutine mld_dprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & - & mld_dprec_type, psb_ipk_ - class(mld_dprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_dprecsetc subroutine mld_dcprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & mld_dprec_type, psb_ipk_ diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index a9ef488d..f7abe638 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_s_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_s_as_smoother_free - procedure, pass(sm) :: seti => mld_s_as_smoother_seti - procedure, pass(sm) :: setc => mld_s_as_smoother_setc procedure, pass(sm) :: cseti => mld_s_as_smoother_cseti procedure, pass(sm) :: csetc => mld_s_as_smoother_csetc procedure, pass(sm) :: descr => s_as_smoother_descr @@ -253,42 +251,6 @@ module mld_s_as_smoother end subroutine mld_s_as_smoother_cnv end interface - interface - subroutine mld_s_as_smoother_seti(sm,what,val,info) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_as_smoother_seti - end interface - - interface - subroutine mld_s_as_smoother_setc(sm,what,val,info) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_as_smoother_setc - end interface - - interface - subroutine mld_s_as_smoother_setr(sm,what,val,info) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_as_smoother_setr - end interface - interface subroutine mld_s_as_smoother_cseti(sm,what,val,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index f668023a..468ecbbc 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -105,11 +105,41 @@ module mld_s_base_aggregator_mod procedure, pass(ag) :: descr => mld_s_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_s_base_aggregator_set_aggr_type procedure, nopass :: fmt => mld_s_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_s_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_s_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_s_base_aggregator_type contains + subroutine mld_s_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_s_base_aggregator_cseti + + subroutine mld_s_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_s_base_aggregator_csetr + + subroutine mld_s_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_s_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +189,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_s_base_aggregator_fmt subroutine mld_s_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +199,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 25b35dae..0097e6e2 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_s_base_smoother_mod procedure, pass(sm) :: apply_a => mld_s_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_s_base_smoother_free - procedure, pass(sm) :: seti => mld_s_base_smoother_seti - procedure, pass(sm) :: setc => mld_s_base_smoother_setc - procedure, pass(sm) :: setr => mld_s_base_smoother_setr procedure, pass(sm) :: cseti => mld_s_base_smoother_cseti procedure, pass(sm) :: csetc => mld_s_base_smoother_csetc procedure, pass(sm) :: csetr => mld_s_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => s_base_smoother_default procedure, pass(sm) :: descr => mld_s_base_smoother_descr procedure, pass(sm) :: sizeof => s_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_s_base_smoother_mod end subroutine mld_s_base_smoother_check end interface - interface - subroutine mld_s_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_smoother_seti - end interface - - interface - subroutine mld_s_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_smoother_setc - end interface - - interface - subroutine mld_s_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_smoother_setr - end interface - interface subroutine mld_s_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 1282a8c7..2d31f730 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_s_base_solver_mod procedure, pass(sv) :: apply_a => mld_s_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_s_base_solver_free - procedure, pass(sv) :: seti => mld_s_base_solver_seti - procedure, pass(sv) :: setc => mld_s_base_solver_setc - procedure, pass(sv) :: setr => mld_s_base_solver_setr procedure, pass(sv) :: cseti => mld_s_base_solver_cseti procedure, pass(sv) :: csetc => mld_s_base_solver_csetc procedure, pass(sv) :: csetr => mld_s_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => s_base_solver_default procedure, pass(sv) :: descr => mld_s_base_solver_descr procedure, pass(sv) :: sizeof => s_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_s_base_solver_mod end subroutine mld_s_base_solver_check end interface - interface - subroutine mld_s_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_solver_seti - end interface - - interface - subroutine mld_s_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_solver_setc - end interface - - interface - subroutine mld_s_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_solver_setr - end interface - interface subroutine mld_s_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_dec_aggregator_mod.f90 b/mlprec/mld_s_dec_aggregator_mod.f90 index f1c80053..ccd4b1d6 100644 --- a/mlprec/mld_s_dec_aggregator_mod.f90 +++ b/mlprec/mld_s_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_s_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_s_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_s_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_s_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_s_dec_aggregator_descr procedure, nopass :: fmt => mld_s_dec_aggregator_fmt end type mld_s_dec_aggregator_type @@ -190,4 +191,18 @@ contains val = "Decoupled aggregation" end function mld_s_dec_aggregator_fmt + subroutine mld_s_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_s_dec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_s_dec_aggregator_descr + end module mld_s_dec_aggregator_mod diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index a9cb146a..6029c2bb 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_s_gs_solver procedure, pass(sv) :: apply_v => mld_s_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_gs_solver_apply procedure, pass(sv) :: free => s_gs_solver_free - procedure, pass(sv) :: seti => s_gs_solver_seti - procedure, pass(sv) :: setc => s_gs_solver_setc - procedure, pass(sv) :: setr => s_gs_solver_setr procedure, pass(sv) :: cseti => s_gs_solver_cseti procedure, pass(sv) :: csetc => s_gs_solver_csetc procedure, pass(sv) :: csetr => s_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_s_gs_solver private :: s_gs_solver_bld, s_gs_solver_apply, & - & s_gs_solver_free, s_gs_solver_seti, & - & s_gs_solver_setc, s_gs_solver_setr,& + & s_gs_solver_free, & & s_gs_solver_descr, s_gs_solver_sizeof, & & s_gs_solver_default, s_gs_solver_dmp, & & s_gs_solver_apply_vect, s_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine s_gs_solver_check - - subroutine s_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_gs_solver_seti - - subroutine s_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_gs_solver_setc - - subroutine s_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_gs_solver_setr - subroutine s_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index a8d0e919..b80632f1 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_s_ilu_solver procedure, pass(sv) :: apply_v => mld_s_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_ilu_solver_apply procedure, pass(sv) :: free => s_ilu_solver_free - procedure, pass(sv) :: seti => s_ilu_solver_seti - procedure, pass(sv) :: setc => s_ilu_solver_setc - procedure, pass(sv) :: setr => s_ilu_solver_setr procedure, pass(sv) :: cseti => s_ilu_solver_cseti procedure, pass(sv) :: csetc => s_ilu_solver_csetc procedure, pass(sv) :: csetr => s_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_s_ilu_solver private :: s_ilu_solver_bld, s_ilu_solver_apply, & - & s_ilu_solver_free, s_ilu_solver_seti, & - & s_ilu_solver_setc, s_ilu_solver_setr,& + & s_ilu_solver_free, & & s_ilu_solver_descr, s_ilu_solver_sizeof, & & s_ilu_solver_default, s_ilu_solver_dmp, & & s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine s_ilu_solver_check - - subroutine s_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_ilu_solver_seti - - subroutine s_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_ilu_solver_setc - - subroutine s_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_ilu_solver_setr - subroutine s_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_s_mumps_solver.F90 b/mlprec/mld_s_mumps_solver.F90 index 464f0a75..4b4e4f7e 100644 --- a/mlprec/mld_s_mumps_solver.F90 +++ b/mlprec/mld_s_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_s_mumps_solver procedure, pass(sv) :: free => s_mumps_solver_free procedure, pass(sv) :: descr => s_mumps_solver_descr procedure, pass(sv) :: sizeof => s_mumps_solver_sizeof - procedure, pass(sv) :: seti => s_mumps_solver_seti - procedure, pass(sv) :: setr => s_mumps_solver_setr procedure, pass(sv) :: cseti =>s_mumps_solver_cseti procedure, pass(sv) :: csetr => s_mumps_solver_csetr procedure, pass(sv) :: default => s_mumps_solver_default @@ -93,8 +91,7 @@ module mld_s_mumps_solver private :: s_mumps_solver_bld, s_mumps_solver_apply, & & s_mumps_solver_free, s_mumps_solver_descr, & & s_mumps_solver_sizeof, s_mumps_solver_apply_vect,& - & s_mumps_solver_seti, s_mumps_solver_setr, & - & s_mumps_solver_cseti, s_mumps_solver_csetri, & + & s_mumps_solver_cseti, s_mumps_solver_csetr, & & s_mumps_solver_default, s_mumps_solver_get_fmt, & & s_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine s_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine s_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_mumps_solver_seti - - - subroutine s_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_mumps_solver_setr subroutine s_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_s_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_s_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_s_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_s_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index ce5cd89e..251ee330 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_s_onelev_mod procedure, pass(lv) :: nullify => s_base_onelev_nullify procedure, pass(lv) :: check => mld_s_base_onelev_check procedure, pass(lv) :: dump => mld_s_base_onelev_dump - procedure, pass(lv) :: seti => mld_s_base_onelev_seti - procedure, pass(lv) :: setr => mld_s_base_onelev_setr - procedure, pass(lv) :: setc => mld_s_base_onelev_setc procedure, pass(lv) :: cseti => mld_s_base_onelev_cseti procedure, pass(lv) :: csetr => mld_s_base_onelev_csetr procedure, pass(lv) :: csetc => mld_s_base_onelev_csetc procedure, pass(lv) :: setsm => mld_s_base_onelev_setsm procedure, pass(lv) :: setsv => mld_s_base_onelev_setsv procedure, pass(lv) :: setag => mld_s_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => s_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_s_onelev_mod end subroutine mld_s_base_onelev_check end interface - interface - subroutine mld_s_base_onelev_seti(lv,what,val,info,pos) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_s_base_onelev_seti - end interface - interface subroutine mld_s_base_onelev_setsm(lv,val,info,pos) import :: psb_spk_, mld_s_onelev_type, mld_s_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_s_onelev_mod end subroutine mld_s_base_onelev_setag end interface - interface - subroutine mld_s_base_onelev_setc(lv,what,val,info,pos) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_s_base_onelev_setc - end interface - - interface - subroutine mld_s_base_onelev_setr(lv,what,val,info,pos) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_s_base_onelev_setr - end interface - - interface subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_prec_mod.f90 b/mlprec/mld_s_prec_mod.f90 index f7cd86bb..15655dba 100644 --- a/mlprec/mld_s_prec_mod.f90 +++ b/mlprec/mld_s_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_s_prec_mod interface mld_precset module procedure mld_s_iprecsetsm, mld_s_iprecsetsv, & - & mld_s_iprecseti, mld_s_iprecsetc, mld_s_iprecsetr, & & mld_s_cprecseti, mld_s_cprecsetc, mld_s_cprecsetr, & & mld_s_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_s_iprecsetag - subroutine mld_s_iprecseti(p,what,val,info,pos) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_s_iprecseti - - subroutine mld_s_iprecsetr(p,what,val,info,pos) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_s_iprecsetr - - subroutine mld_s_iprecsetc(p,what,val,info,pos) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_s_iprecsetc - subroutine mld_s_cprecseti(p,what,val,info,pos) type(mld_sprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 20adde41..a2b05ec1 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -128,14 +128,10 @@ module mld_s_prec_type procedure, pass(prec) :: setsm => mld_sprecsetsm procedure, pass(prec) :: setsv => mld_sprecsetsv procedure, pass(prec) :: setag => mld_sprecsetag - procedure, pass(prec) :: seti => mld_sprecseti - procedure, pass(prec) :: setc => mld_sprecsetc - procedure, pass(prec) :: setr => mld_sprecsetr procedure, pass(prec) :: cseti => mld_scprecseti procedure, pass(prec) :: csetc => mld_scprecsetc procedure, pass(prec) :: csetr => mld_scprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_s_get_smootherp procedure, pass(prec) :: get_solver => mld_s_get_solverp procedure, pass(prec) :: move_alloc => s_prec_move_alloc @@ -245,36 +241,6 @@ module mld_s_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_sprecsetag - subroutine mld_sprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_sspmat_type, psb_desc_type, psb_spk_, & - & mld_sprec_type, psb_ipk_ - class(mld_sprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_sprecseti - subroutine mld_sprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_sspmat_type, psb_desc_type, psb_spk_, & - & mld_sprec_type, psb_ipk_ - class(mld_sprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_sprecsetr - subroutine mld_sprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_sspmat_type, psb_desc_type, psb_spk_, & - & mld_sprec_type, psb_ipk_ - class(mld_sprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_sprecsetc subroutine mld_scprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & mld_sprec_type, psb_ipk_ diff --git a/mlprec/mld_s_symdec_aggregator_mod.f90 b/mlprec/mld_s_symdec_aggregator_mod.f90 index 152ede99..dd7ffb62 100644 --- a/mlprec/mld_s_symdec_aggregator_mod.f90 +++ b/mlprec/mld_s_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_s_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_s_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_s_symdec_aggregator_descr procedure, nopass :: fmt => mld_s_symdec_aggregator_fmt end type mld_s_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_s_symdec_aggregator_fmt + subroutine mld_s_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_s_symdec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_s_symdec_aggregator_descr + end module mld_s_symdec_aggregator_mod diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index 4e11a61a..2da97762 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_z_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_z_as_smoother_free - procedure, pass(sm) :: seti => mld_z_as_smoother_seti - procedure, pass(sm) :: setc => mld_z_as_smoother_setc procedure, pass(sm) :: cseti => mld_z_as_smoother_cseti procedure, pass(sm) :: csetc => mld_z_as_smoother_csetc procedure, pass(sm) :: descr => z_as_smoother_descr @@ -253,42 +251,6 @@ module mld_z_as_smoother end subroutine mld_z_as_smoother_cnv end interface - interface - subroutine mld_z_as_smoother_seti(sm,what,val,info) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_as_smoother_seti - end interface - - interface - subroutine mld_z_as_smoother_setc(sm,what,val,info) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_as_smoother_setc - end interface - - interface - subroutine mld_z_as_smoother_setr(sm,what,val,info) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_as_smoother_setr - end interface - interface subroutine mld_z_as_smoother_cseti(sm,what,val,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 660bc415..6c49ae2f 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -105,11 +105,41 @@ module mld_z_base_aggregator_mod procedure, pass(ag) :: descr => mld_z_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_z_base_aggregator_set_aggr_type procedure, nopass :: fmt => mld_z_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_z_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_z_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_z_base_aggregator_type contains + subroutine mld_z_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_z_base_aggregator_cseti + + subroutine mld_z_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_z_base_aggregator_csetr + + subroutine mld_z_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_z_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +189,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_z_base_aggregator_fmt subroutine mld_z_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +199,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index c73473e1..ca176c7a 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_z_base_smoother_mod procedure, pass(sm) :: apply_a => mld_z_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_z_base_smoother_free - procedure, pass(sm) :: seti => mld_z_base_smoother_seti - procedure, pass(sm) :: setc => mld_z_base_smoother_setc - procedure, pass(sm) :: setr => mld_z_base_smoother_setr procedure, pass(sm) :: cseti => mld_z_base_smoother_cseti procedure, pass(sm) :: csetc => mld_z_base_smoother_csetc procedure, pass(sm) :: csetr => mld_z_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => z_base_smoother_default procedure, pass(sm) :: descr => mld_z_base_smoother_descr procedure, pass(sm) :: sizeof => z_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_z_base_smoother_mod end subroutine mld_z_base_smoother_check end interface - interface - subroutine mld_z_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_smoother_seti - end interface - - interface - subroutine mld_z_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_smoother_setc - end interface - - interface - subroutine mld_z_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_smoother_setr - end interface - interface subroutine mld_z_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 37d2b03c..79e58678 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_z_base_solver_mod procedure, pass(sv) :: apply_a => mld_z_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_z_base_solver_free - procedure, pass(sv) :: seti => mld_z_base_solver_seti - procedure, pass(sv) :: setc => mld_z_base_solver_setc - procedure, pass(sv) :: setr => mld_z_base_solver_setr procedure, pass(sv) :: cseti => mld_z_base_solver_cseti procedure, pass(sv) :: csetc => mld_z_base_solver_csetc procedure, pass(sv) :: csetr => mld_z_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => z_base_solver_default procedure, pass(sv) :: descr => mld_z_base_solver_descr procedure, pass(sv) :: sizeof => z_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_z_base_solver_mod end subroutine mld_z_base_solver_check end interface - interface - subroutine mld_z_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_solver_seti - end interface - - interface - subroutine mld_z_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_solver_setc - end interface - - interface - subroutine mld_z_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_solver_setr - end interface - interface subroutine mld_z_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_dec_aggregator_mod.f90 b/mlprec/mld_z_dec_aggregator_mod.f90 index 6930230b..10989e0f 100644 --- a/mlprec/mld_z_dec_aggregator_mod.f90 +++ b/mlprec/mld_z_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_z_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_z_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_z_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_z_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_z_dec_aggregator_descr procedure, nopass :: fmt => mld_z_dec_aggregator_fmt end type mld_z_dec_aggregator_type @@ -190,4 +191,18 @@ contains val = "Decoupled aggregation" end function mld_z_dec_aggregator_fmt + subroutine mld_z_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_z_dec_aggregator_type), intent(in) :: ag + type(mld_dml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_z_dec_aggregator_descr + end module mld_z_dec_aggregator_mod diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index fe14eb15..79ee052d 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_z_gs_solver procedure, pass(sv) :: apply_v => mld_z_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_gs_solver_apply procedure, pass(sv) :: free => z_gs_solver_free - procedure, pass(sv) :: seti => z_gs_solver_seti - procedure, pass(sv) :: setc => z_gs_solver_setc - procedure, pass(sv) :: setr => z_gs_solver_setr procedure, pass(sv) :: cseti => z_gs_solver_cseti procedure, pass(sv) :: csetc => z_gs_solver_csetc procedure, pass(sv) :: csetr => z_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_z_gs_solver private :: z_gs_solver_bld, z_gs_solver_apply, & - & z_gs_solver_free, z_gs_solver_seti, & - & z_gs_solver_setc, z_gs_solver_setr,& + & z_gs_solver_free, & & z_gs_solver_descr, z_gs_solver_sizeof, & & z_gs_solver_default, z_gs_solver_dmp, & & z_gs_solver_apply_vect, z_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine z_gs_solver_check - - subroutine z_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_gs_solver_seti - - subroutine z_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_gs_solver_setc - - subroutine z_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_gs_solver_setr - subroutine z_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 1e7f563a..d1d9332f 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_z_ilu_solver procedure, pass(sv) :: apply_v => mld_z_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_ilu_solver_apply procedure, pass(sv) :: free => z_ilu_solver_free - procedure, pass(sv) :: seti => z_ilu_solver_seti - procedure, pass(sv) :: setc => z_ilu_solver_setc - procedure, pass(sv) :: setr => z_ilu_solver_setr procedure, pass(sv) :: cseti => z_ilu_solver_cseti procedure, pass(sv) :: csetc => z_ilu_solver_csetc procedure, pass(sv) :: csetr => z_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_z_ilu_solver private :: z_ilu_solver_bld, z_ilu_solver_apply, & - & z_ilu_solver_free, z_ilu_solver_seti, & - & z_ilu_solver_setc, z_ilu_solver_setr,& + & z_ilu_solver_free, & & z_ilu_solver_descr, z_ilu_solver_sizeof, & & z_ilu_solver_default, z_ilu_solver_dmp, & & z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine z_ilu_solver_check - - subroutine z_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_ilu_solver_seti - - subroutine z_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%stringval(val) - if (ival >= 0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_ilu_solver_setc - - subroutine z_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_ilu_solver_setr - subroutine z_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_z_mumps_solver.F90 b/mlprec/mld_z_mumps_solver.F90 index 5558ec2d..61699694 100644 --- a/mlprec/mld_z_mumps_solver.F90 +++ b/mlprec/mld_z_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_z_mumps_solver procedure, pass(sv) :: free => z_mumps_solver_free procedure, pass(sv) :: descr => z_mumps_solver_descr procedure, pass(sv) :: sizeof => z_mumps_solver_sizeof - procedure, pass(sv) :: seti => z_mumps_solver_seti - procedure, pass(sv) :: setr => z_mumps_solver_setr procedure, pass(sv) :: cseti =>z_mumps_solver_cseti procedure, pass(sv) :: csetr => z_mumps_solver_csetr procedure, pass(sv) :: default => z_mumps_solver_default @@ -93,8 +91,7 @@ module mld_z_mumps_solver private :: z_mumps_solver_bld, z_mumps_solver_apply, & & z_mumps_solver_free, z_mumps_solver_descr, & & z_mumps_solver_sizeof, z_mumps_solver_apply_vect,& - & z_mumps_solver_seti, z_mumps_solver_setr, & - & z_mumps_solver_cseti, z_mumps_solver_csetri, & + & z_mumps_solver_cseti, z_mumps_solver_csetr, & & z_mumps_solver_default, z_mumps_solver_get_fmt, & & z_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine z_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine z_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_mumps_solver_seti - - - subroutine z_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_mumps_solver_setr subroutine z_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_z_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_z_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_z_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_z_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 3f68c9e1..70dd6471 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_z_onelev_mod procedure, pass(lv) :: nullify => z_base_onelev_nullify procedure, pass(lv) :: check => mld_z_base_onelev_check procedure, pass(lv) :: dump => mld_z_base_onelev_dump - procedure, pass(lv) :: seti => mld_z_base_onelev_seti - procedure, pass(lv) :: setr => mld_z_base_onelev_setr - procedure, pass(lv) :: setc => mld_z_base_onelev_setc procedure, pass(lv) :: cseti => mld_z_base_onelev_cseti procedure, pass(lv) :: csetr => mld_z_base_onelev_csetr procedure, pass(lv) :: csetc => mld_z_base_onelev_csetc procedure, pass(lv) :: setsm => mld_z_base_onelev_setsm procedure, pass(lv) :: setsv => mld_z_base_onelev_setsv procedure, pass(lv) :: setag => mld_z_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => z_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => z_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_z_onelev_mod end subroutine mld_z_base_onelev_check end interface - interface - subroutine mld_z_base_onelev_seti(lv,what,val,info,pos) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_z_base_onelev_seti - end interface - interface subroutine mld_z_base_onelev_setsm(lv,val,info,pos) import :: psb_dpk_, mld_z_onelev_type, mld_z_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_z_onelev_mod end subroutine mld_z_base_onelev_setag end interface - interface - subroutine mld_z_base_onelev_setc(lv,what,val,info,pos) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_z_base_onelev_setc - end interface - - interface - subroutine mld_z_base_onelev_setr(lv,what,val,info,pos) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_z_base_onelev_setr - end interface - - interface subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_prec_mod.f90 b/mlprec/mld_z_prec_mod.f90 index 2c402d10..f1c0443a 100644 --- a/mlprec/mld_z_prec_mod.f90 +++ b/mlprec/mld_z_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_z_prec_mod interface mld_precset module procedure mld_z_iprecsetsm, mld_z_iprecsetsv, & - & mld_z_iprecseti, mld_z_iprecsetc, mld_z_iprecsetr, & & mld_z_cprecseti, mld_z_cprecsetc, mld_z_cprecsetr, & & mld_z_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_z_iprecsetag - subroutine mld_z_iprecseti(p,what,val,info,pos) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_z_iprecseti - - subroutine mld_z_iprecsetr(p,what,val,info,pos) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_z_iprecsetr - - subroutine mld_z_iprecsetc(p,what,val,info,pos) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_z_iprecsetc - subroutine mld_z_cprecseti(p,what,val,info,pos) type(mld_zprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 880085f1..ce1d0a81 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -128,14 +128,10 @@ module mld_z_prec_type procedure, pass(prec) :: setsm => mld_zprecsetsm procedure, pass(prec) :: setsv => mld_zprecsetsv procedure, pass(prec) :: setag => mld_zprecsetag - procedure, pass(prec) :: seti => mld_zprecseti - procedure, pass(prec) :: setc => mld_zprecsetc - procedure, pass(prec) :: setr => mld_zprecsetr procedure, pass(prec) :: cseti => mld_zcprecseti procedure, pass(prec) :: csetc => mld_zcprecsetc procedure, pass(prec) :: csetr => mld_zcprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_z_get_smootherp procedure, pass(prec) :: get_solver => mld_z_get_solverp procedure, pass(prec) :: move_alloc => z_prec_move_alloc @@ -245,36 +241,6 @@ module mld_z_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_zprecsetag - subroutine mld_zprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & - & mld_zprec_type, psb_ipk_ - class(mld_zprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_zprecseti - subroutine mld_zprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & - & mld_zprec_type, psb_ipk_ - class(mld_zprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_zprecsetr - subroutine mld_zprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & - & mld_zprec_type, psb_ipk_ - class(mld_zprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_zprecsetc subroutine mld_zcprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & mld_zprec_type, psb_ipk_ diff --git a/mlprec/mld_z_symdec_aggregator_mod.f90 b/mlprec/mld_z_symdec_aggregator_mod.f90 index 2044c273..1397a532 100644 --- a/mlprec/mld_z_symdec_aggregator_mod.f90 +++ b/mlprec/mld_z_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_z_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_z_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_z_symdec_aggregator_descr procedure, nopass :: fmt => mld_z_symdec_aggregator_fmt end type mld_z_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_z_symdec_aggregator_fmt + subroutine mld_z_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_z_symdec_aggregator_type), intent(in) :: ag + type(mld_dml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_z_symdec_aggregator_descr + end module mld_z_symdec_aggregator_mod diff --git a/tests/Bcmatch/mld_d_pde3d.f90 b/tests/Bcmatch/mld_d_pde3d.f90 index de89f105..e2a335ff 100644 --- a/tests/Bcmatch/mld_d_pde3d.f90 +++ b/tests/Bcmatch/mld_d_pde3d.f90 @@ -638,7 +638,9 @@ program mld_d_pde3d integer(psb_ipk_) :: thrvsz ! size of threshold vector real(psb_dpk_) :: athres ! smoothed aggregation threshold integer(psb_ipk_) :: csize ! minimum size of coarsest matrix - + logical :: use_bcm ! use BootCMatch + integer(psb_ipk_) :: bcm_alg ! Matching method: 0 PREIS, 1 MC64, 2 SPRAL (auction) + integer(psb_ipk_) :: bcm_sweeps ! Pairing sweeps ! AMG smoother or pre-smoother; also 1-lev preconditioner character(len=16) :: smther ! (pre-)smoother type: BJAC, AS integer(psb_ipk_) :: jsweeps ! (pre-)smoother / 1-lev prec. sweeps @@ -671,7 +673,6 @@ program mld_d_pde3d integer(psb_ipk_) :: cfill ! fill-in for incomplete LU factorization real(psb_dpk_) :: cthres ! threshold for ILUT factorization integer(psb_ipk_) :: cjswp ! sweeps for GS or JAC coarsest-lev subsolver - logical :: use_bcm ! Use BootCMatch aggregation end type precdata type(precdata) :: p_choice @@ -819,8 +820,8 @@ program mld_d_pde3d call prec%set('coarse_sweeps', p_choice%cjswp, info) if (p_choice%use_bcm) then call prec%set(bcmag,info) - call prec%set('BCM_MATCH_ALG',2, info) - call prec%set('BCM_SWEEPS',3, info) + call prec%set('BCM_MATCH_ALG',p_choice%bcm_alg, info) + call prec%set('BCM_SWEEPS',p_choice%bcm_sweeps, info) !!$ if (p_choice%csize>0) call prec%set('BCM_MAX_CSIZE',p_choice%csize, info) call prec%set('BCM_MAX_NLEVELS',p_choice%maxlevs, info) !call prec%set('BCM_W_SIZE',desc_a%get_local_rows(), info,ilev=2) @@ -1035,7 +1036,9 @@ contains call read_data(prec%cfill,inp_unit) ! fill-in for incompl LU call read_data(prec%cthres,inp_unit) ! Threshold for ILUT call read_data(prec%cjswp,inp_unit) ! sweeps for GS/JAC subsolver - call read_data(prec%use_bcm,inp_unit) ! BootCMatch? + call read_data(prec%use_bcm,inp_unit) + call read_data(prec%bcm_alg,inp_unit) + call read_data(prec%bcm_sweeps,inp_unit) if (inp_unit /= psb_inp_unit) then close(inp_unit) end if @@ -1097,7 +1100,9 @@ contains call psb_bcast(icontxt,prec%cfill) call psb_bcast(icontxt,prec%cthres) call psb_bcast(icontxt,prec%cjswp) - call psb_bcast(icontxt,prec%use_bcm) + call psb_bcast(ictxt,prec%use_bcm) + call psb_bcast(ictxt,prec%bcm_alg) + call psb_bcast(ictxt,prec%bcm_sweeps) end subroutine get_parms diff --git a/tests/Bcmatch/runs/mld-bcm.inp b/tests/Bcmatch/runs/mld-bcm.inp index 374d5139..c07fea1e 100644 --- a/tests/Bcmatch/runs/mld-bcm.inp +++ b/tests/Bcmatch/runs/mld-bcm.inp @@ -1,17 +1,17 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. CSR ! Storage format CSR COO JAD -0040 ! IDIM; domain size. Linear system size is IDIM**2 -CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES +0100 ! IDIM; domain size. Linear system size is IDIM**2 +FCG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES 2 ! ISTOPC 00500 ! ITMAX 1 ! ITRACE 30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS -ML-VCYCLE-FBGS-ILU ! Longer descriptive name for preconditioner (up to 20 chars) +ML-KCYCLE-FBGS-ILU ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML %%%%%%%%%%% First smoother (for all levels but coarsest) %%%%%%%%%%%%%%%% FBGS ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. -2 ! Number of sweeps for smoother +1 ! Number of sweeps for smoother 0 ! Number of overlap layers for AS preconditioner HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG @@ -28,11 +28,11 @@ ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU IL 0 ! Fill level P for ILU(P) and ILU(T,P) 1.d-4 ! Threshold T for ILU(T,P) %%%%%%%%%%% Multilevel parameters %%%%%%%%%%%%%%%% -VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD +KCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD 1 ! Number of outer sweeps for ML -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default -SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED +UNSMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED DEC ! Parallel aggregation: DEC, SYMDEC NATURAL ! Ordering of aggregation NATURAL DEGREE NOFILTER ! Filtering of matrix: FILTER NOFILTER @@ -47,4 +47,6 @@ DIST ! Coarsest-level matrix distribution: DIST REPL, DE 1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) 1.d-4 ! Coarsest-level threshold T for ILU(T,P) 1 ! Number of sweeps for JACOBI/GS/BJAC coarsest-level solver -T ! Use BootCMatch aggregator \ No newline at end of file +T ! Use BootCMatch +2 ! Matching method: 0 PREIS, 1 MC64, 2 SPRAL (auction) +2 ! Pairing sweeps From 743dd381218eb3931031c805e05fd831999e2789 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 1 Oct 2018 15:35:27 +0100 Subject: [PATCH 09/16] Fix configry. Fixed onelev%SET to call aggr method. --- config/pac.m4 | 4 ++-- configure | 4 ++-- mlprec/impl/level/mld_c_base_onelev_csetc.f90 | 1 + mlprec/impl/level/mld_c_base_onelev_cseti.F90 | 1 + mlprec/impl/level/mld_c_base_onelev_csetr.f90 | 2 ++ mlprec/impl/level/mld_d_base_onelev_csetc.f90 | 1 + mlprec/impl/level/mld_d_base_onelev_cseti.F90 | 1 + mlprec/impl/level/mld_d_base_onelev_csetr.f90 | 2 ++ mlprec/impl/level/mld_s_base_onelev_csetc.f90 | 1 + mlprec/impl/level/mld_s_base_onelev_cseti.F90 | 1 + mlprec/impl/level/mld_s_base_onelev_csetr.f90 | 2 ++ mlprec/impl/level/mld_z_base_onelev_csetc.f90 | 1 + mlprec/impl/level/mld_z_base_onelev_cseti.F90 | 1 + mlprec/impl/level/mld_z_base_onelev_csetr.f90 | 2 ++ mlprec/mld_c_base_aggregator_mod.f90 | 16 +++++++++++++++- mlprec/mld_d_base_aggregator_mod.f90 | 16 +++++++++++++++- mlprec/mld_s_base_aggregator_mod.f90 | 16 +++++++++++++++- mlprec/mld_z_base_aggregator_mod.f90 | 16 +++++++++++++++- 18 files changed, 80 insertions(+), 8 deletions(-) diff --git a/config/pac.m4 b/config/pac.m4 index ec20cd12..095a5a8f 100644 --- a/config/pac.m4 +++ b/config/pac.m4 @@ -635,7 +635,7 @@ if test "x$pac_slu_header_ok" == "xyes" ; then LIBS="$SLU_LIBS -lm $save_LIBS"; AC_TRY_LINK_FUNC(superlu_malloc, [mld2p4_cv_have_superlu=yes;pac_slu_lib_ok=yes;], - [mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; SLU_INCLUDES=""]) + [mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; ]) fi if test "x$pac_slu_lib_ok" == "xno" ; then dnl Maybe lib64? @@ -643,7 +643,7 @@ if test "x$pac_slu_header_ok" == "xyes" ; then LIBS="$SLU_LIBS -lm $save_LIBS"; AC_TRY_LINK_FUNC(superlu_malloc, [mld2p4_cv_have_superlu=yes;pac_slu_lib_ok=yes;], - [mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; SLU_INCLUDES=""]) + [mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; ]) fi AC_MSG_RESULT($pac_slu_lib_ok) fi diff --git a/configure b/configure index 0b9df7ce..78f8eacd 100755 --- a/configure +++ b/configure @@ -11798,7 +11798,7 @@ else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; SLU_INCLUDES="" + mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; fi rm -rf conftest.dSYM @@ -11856,7 +11856,7 @@ else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 - mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; SLU_INCLUDES="" + mld2p4_cv_have_superlu=no;pac_slu_lib_ok=no; SLU_LIBS=""; fi rm -rf conftest.dSYM diff --git a/mlprec/impl/level/mld_c_base_onelev_csetc.f90 b/mlprec/impl/level/mld_c_base_onelev_csetc.f90 index 781ceef0..c293c3b8 100644 --- a/mlprec/impl/level/mld_c_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_csetc.f90 @@ -86,6 +86,7 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end if diff --git a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 index f412093e..dc11e2c6 100644 --- a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 @@ -240,6 +240,7 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_c_base_onelev_csetr.f90 b/mlprec/impl/level/mld_c_base_onelev_csetr.f90 index 922496dd..2b773c27 100644 --- a/mlprec/impl/level/mld_c_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_csetr.f90 @@ -90,6 +90,8 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 index 1ac67d26..5a86527e 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 @@ -86,6 +86,7 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end if diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index d76c5b59..34826a7e 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -260,6 +260,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 index 33f5a5a5..40b6de33 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 @@ -90,6 +90,8 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_s_base_onelev_csetc.f90 b/mlprec/impl/level/mld_s_base_onelev_csetc.f90 index 2443b4e5..11644212 100644 --- a/mlprec/impl/level/mld_s_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_csetc.f90 @@ -86,6 +86,7 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end if diff --git a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 index 8ca26b54..e3dbca73 100644 --- a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 @@ -240,6 +240,7 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_s_base_onelev_csetr.f90 b/mlprec/impl/level/mld_s_base_onelev_csetr.f90 index f75849cc..da4dc302 100644 --- a/mlprec/impl/level/mld_s_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_csetr.f90 @@ -90,6 +90,8 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_z_base_onelev_csetc.f90 b/mlprec/impl/level/mld_z_base_onelev_csetc.f90 index a09be534..85bf48dc 100644 --- a/mlprec/impl/level/mld_z_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_csetc.f90 @@ -86,6 +86,7 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end if diff --git a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 index bee8ba2b..303d788c 100644 --- a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 @@ -260,6 +260,7 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_z_base_onelev_csetr.f90 b/mlprec/impl/level/mld_z_base_onelev_csetr.f90 index 28a7d61a..e5d55883 100644 --- a/mlprec/impl/level/mld_z_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_csetr.f90 @@ -90,6 +90,8 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index 7e816283..a30b8723 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -107,7 +107,8 @@ module mld_c_base_aggregator_mod procedure, nopass :: fmt => mld_c_base_aggregator_fmt procedure, pass(ag) :: cseti => mld_c_base_aggregator_cseti procedure, pass(ag) :: csetr => mld_c_base_aggregator_csetr - generic, public :: set => cseti, csetr + procedure, pass(ag) :: csetc => mld_c_base_aggregator_csetc + generic, public :: set => cseti, csetr, csetc end type mld_c_base_aggregator_type @@ -139,6 +140,19 @@ contains info = 0 end subroutine mld_c_base_aggregator_csetr + subroutine mld_c_base_aggregator_csetc(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_c_base_aggregator_csetc + subroutine mld_c_base_aggregator_update_next(ag,agnext,info) implicit none diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 71d73c60..cbd57fd3 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -107,7 +107,8 @@ module mld_d_base_aggregator_mod procedure, nopass :: fmt => mld_d_base_aggregator_fmt procedure, pass(ag) :: cseti => mld_d_base_aggregator_cseti procedure, pass(ag) :: csetr => mld_d_base_aggregator_csetr - generic, public :: set => cseti, csetr + procedure, pass(ag) :: csetc => mld_d_base_aggregator_csetc + generic, public :: set => cseti, csetr, csetc end type mld_d_base_aggregator_type @@ -139,6 +140,19 @@ contains info = 0 end subroutine mld_d_base_aggregator_csetr + subroutine mld_d_base_aggregator_csetc(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_d_base_aggregator_csetc + subroutine mld_d_base_aggregator_update_next(ag,agnext,info) implicit none diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index 468ecbbc..acfc456a 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -107,7 +107,8 @@ module mld_s_base_aggregator_mod procedure, nopass :: fmt => mld_s_base_aggregator_fmt procedure, pass(ag) :: cseti => mld_s_base_aggregator_cseti procedure, pass(ag) :: csetr => mld_s_base_aggregator_csetr - generic, public :: set => cseti, csetr + procedure, pass(ag) :: csetc => mld_s_base_aggregator_csetc + generic, public :: set => cseti, csetr, csetc end type mld_s_base_aggregator_type @@ -139,6 +140,19 @@ contains info = 0 end subroutine mld_s_base_aggregator_csetr + subroutine mld_s_base_aggregator_csetc(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_s_base_aggregator_csetc + subroutine mld_s_base_aggregator_update_next(ag,agnext,info) implicit none diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 6c49ae2f..552a2ce0 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -107,7 +107,8 @@ module mld_z_base_aggregator_mod procedure, nopass :: fmt => mld_z_base_aggregator_fmt procedure, pass(ag) :: cseti => mld_z_base_aggregator_cseti procedure, pass(ag) :: csetr => mld_z_base_aggregator_csetr - generic, public :: set => cseti, csetr + procedure, pass(ag) :: csetc => mld_z_base_aggregator_csetc + generic, public :: set => cseti, csetr, csetc end type mld_z_base_aggregator_type @@ -139,6 +140,19 @@ contains info = 0 end subroutine mld_z_base_aggregator_csetr + subroutine mld_z_base_aggregator_csetc(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_z_base_aggregator_csetc + subroutine mld_z_base_aggregator_update_next(ag,agnext,info) implicit none From 7afcdb7ec23649ade4d1203d5e69d0593b3c60c2 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 3 Oct 2018 16:55:48 +0100 Subject: [PATCH 10/16] Add optional IDX argument to %SET calls. --- mlprec/impl/level/mld_c_base_onelev_csetc.f90 | 11 ++++---- mlprec/impl/level/mld_c_base_onelev_cseti.F90 | 11 ++++---- mlprec/impl/level/mld_c_base_onelev_csetr.f90 | 11 ++++---- mlprec/impl/level/mld_d_base_onelev_csetc.f90 | 11 ++++---- mlprec/impl/level/mld_d_base_onelev_cseti.F90 | 11 ++++---- mlprec/impl/level/mld_d_base_onelev_csetr.f90 | 11 ++++---- mlprec/impl/level/mld_s_base_onelev_csetc.f90 | 11 ++++---- mlprec/impl/level/mld_s_base_onelev_cseti.F90 | 11 ++++---- mlprec/impl/level/mld_s_base_onelev_csetr.f90 | 11 ++++---- mlprec/impl/level/mld_z_base_onelev_csetc.f90 | 11 ++++---- mlprec/impl/level/mld_z_base_onelev_cseti.F90 | 11 ++++---- mlprec/impl/level/mld_z_base_onelev_csetr.f90 | 11 ++++---- mlprec/impl/mld_ccprecset.F90 | 25 +++++++++++-------- mlprec/impl/mld_dcprecset.F90 | 25 +++++++++++-------- mlprec/impl/mld_scprecset.F90 | 25 +++++++++++-------- mlprec/impl/mld_zcprecset.F90 | 25 +++++++++++-------- .../impl/smoother/mld_c_as_smoother_csetc.f90 | 7 +++--- .../impl/smoother/mld_c_as_smoother_cseti.f90 | 5 ++-- .../impl/smoother/mld_c_as_smoother_csetr.f90 | 5 ++-- .../smoother/mld_c_base_smoother_csetc.f90 | 7 +++--- .../smoother/mld_c_base_smoother_cseti.f90 | 5 ++-- .../smoother/mld_c_base_smoother_csetr.f90 | 5 ++-- .../impl/smoother/mld_d_as_smoother_csetc.f90 | 7 +++--- .../impl/smoother/mld_d_as_smoother_cseti.f90 | 5 ++-- .../impl/smoother/mld_d_as_smoother_csetr.f90 | 5 ++-- .../smoother/mld_d_base_smoother_csetc.f90 | 7 +++--- .../smoother/mld_d_base_smoother_cseti.f90 | 5 ++-- .../smoother/mld_d_base_smoother_csetr.f90 | 5 ++-- .../impl/smoother/mld_s_as_smoother_csetc.f90 | 7 +++--- .../impl/smoother/mld_s_as_smoother_cseti.f90 | 5 ++-- .../impl/smoother/mld_s_as_smoother_csetr.f90 | 5 ++-- .../smoother/mld_s_base_smoother_csetc.f90 | 7 +++--- .../smoother/mld_s_base_smoother_cseti.f90 | 5 ++-- .../smoother/mld_s_base_smoother_csetr.f90 | 5 ++-- .../impl/smoother/mld_z_as_smoother_csetc.f90 | 7 +++--- .../impl/smoother/mld_z_as_smoother_cseti.f90 | 5 ++-- .../impl/smoother/mld_z_as_smoother_csetr.f90 | 5 ++-- .../smoother/mld_z_base_smoother_csetc.f90 | 7 +++--- .../smoother/mld_z_base_smoother_cseti.f90 | 5 ++-- .../smoother/mld_z_base_smoother_csetr.f90 | 5 ++-- .../impl/solver/mld_c_base_solver_csetc.f90 | 5 ++-- .../impl/solver/mld_c_base_solver_cseti.f90 | 3 ++- .../impl/solver/mld_c_base_solver_csetr.f90 | 3 ++- .../impl/solver/mld_d_base_solver_csetc.f90 | 5 ++-- .../impl/solver/mld_d_base_solver_cseti.f90 | 3 ++- .../impl/solver/mld_d_base_solver_csetr.f90 | 3 ++- .../impl/solver/mld_s_base_solver_csetc.f90 | 5 ++-- .../impl/solver/mld_s_base_solver_cseti.f90 | 3 ++- .../impl/solver/mld_s_base_solver_csetr.f90 | 3 ++- .../impl/solver/mld_z_base_solver_csetc.f90 | 5 ++-- .../impl/solver/mld_z_base_solver_cseti.f90 | 3 ++- .../impl/solver/mld_z_base_solver_csetr.f90 | 3 ++- mlprec/mld_c_as_smoother.f90 | 6 +++-- mlprec/mld_c_base_aggregator_mod.f90 | 9 ++++--- mlprec/mld_c_base_smoother_mod.f90 | 9 ++++--- mlprec/mld_c_base_solver_mod.f90 | 9 ++++--- mlprec/mld_c_gs_solver.f90 | 15 ++++++----- mlprec/mld_c_ilu_solver.f90 | 15 ++++++----- mlprec/mld_c_mumps_solver.F90 | 14 ++++++++--- mlprec/mld_c_onelev_mod.f90 | 9 ++++--- mlprec/mld_c_prec_type.f90 | 12 ++++----- mlprec/mld_d_as_smoother.f90 | 6 +++-- mlprec/mld_d_base_aggregator_mod.f90 | 9 ++++--- mlprec/mld_d_base_smoother_mod.f90 | 9 ++++--- mlprec/mld_d_base_solver_mod.f90 | 9 ++++--- mlprec/mld_d_gs_solver.f90 | 15 ++++++----- mlprec/mld_d_ilu_solver.f90 | 15 ++++++----- mlprec/mld_d_mumps_solver.F90 | 14 ++++++++--- mlprec/mld_d_onelev_mod.f90 | 9 ++++--- mlprec/mld_d_prec_type.f90 | 12 ++++----- mlprec/mld_s_as_smoother.f90 | 6 +++-- mlprec/mld_s_base_aggregator_mod.f90 | 9 ++++--- mlprec/mld_s_base_smoother_mod.f90 | 9 ++++--- mlprec/mld_s_base_solver_mod.f90 | 9 ++++--- mlprec/mld_s_gs_solver.f90 | 15 ++++++----- mlprec/mld_s_ilu_solver.f90 | 15 ++++++----- mlprec/mld_s_mumps_solver.F90 | 14 ++++++++--- mlprec/mld_s_onelev_mod.f90 | 9 ++++--- mlprec/mld_s_prec_type.f90 | 12 ++++----- mlprec/mld_z_as_smoother.f90 | 6 +++-- mlprec/mld_z_base_aggregator_mod.f90 | 9 ++++--- mlprec/mld_z_base_smoother_mod.f90 | 9 ++++--- mlprec/mld_z_base_solver_mod.f90 | 9 ++++--- mlprec/mld_z_gs_solver.f90 | 15 ++++++----- mlprec/mld_z_ilu_solver.f90 | 15 ++++++----- mlprec/mld_z_mumps_solver.F90 | 14 ++++++++--- mlprec/mld_z_onelev_mod.f90 | 9 ++++--- mlprec/mld_z_prec_type.f90 | 12 ++++----- 88 files changed, 484 insertions(+), 320 deletions(-) diff --git a/mlprec/impl/level/mld_c_base_onelev_csetc.f90 b/mlprec/impl/level/mld_c_base_onelev_csetc.f90 index c293c3b8..17840211 100644 --- a/mlprec/impl/level/mld_c_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos) +subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx) use psb_base_mod use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_csetc @@ -47,7 +47,8 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='c_base_onelev_csetc' @@ -77,16 +78,16 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end if diff --git a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 index dc11e2c6..2aede23f 100644 --- a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) +subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx) use psb_base_mod use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_cseti @@ -62,7 +62,8 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='c_base_onelev_cseti' @@ -232,15 +233,15 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) case default if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_c_base_onelev_csetr.f90 b/mlprec/impl/level/mld_c_base_onelev_csetr.f90 index 2b773c27..4e69ac5e 100644 --- a/mlprec/impl/level/mld_c_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos) +subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos,idx) use psb_base_mod use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_csetr @@ -47,7 +47,8 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos) character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='c_base_onelev_csetr' @@ -82,15 +83,15 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select diff --git a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 index 5a86527e..c301e5ad 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos) +subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos,idx) use psb_base_mod use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetc @@ -47,7 +47,8 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='d_base_onelev_csetc' @@ -77,16 +78,16 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end if diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index 34826a7e..74631029 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) +subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos,idx) use psb_base_mod use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_cseti @@ -68,7 +68,8 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='d_base_onelev_cseti' @@ -252,15 +253,15 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) case default if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 index 40b6de33..1fd2654c 100644 --- a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos) +subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos,idx) use psb_base_mod use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetr @@ -47,7 +47,8 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos) character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='d_base_onelev_csetr' @@ -82,15 +83,15 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select diff --git a/mlprec/impl/level/mld_s_base_onelev_csetc.f90 b/mlprec/impl/level/mld_s_base_onelev_csetc.f90 index 11644212..f99df0c0 100644 --- a/mlprec/impl/level/mld_s_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos) +subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx) use psb_base_mod use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_csetc @@ -47,7 +47,8 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='s_base_onelev_csetc' @@ -77,16 +78,16 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end if diff --git a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 index e3dbca73..5c5ffbf1 100644 --- a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) +subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx) use psb_base_mod use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_cseti @@ -62,7 +62,8 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='s_base_onelev_cseti' @@ -232,15 +233,15 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) case default if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_s_base_onelev_csetr.f90 b/mlprec/impl/level/mld_s_base_onelev_csetr.f90 index da4dc302..f49ac7e3 100644 --- a/mlprec/impl/level/mld_s_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos) +subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos,idx) use psb_base_mod use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_csetr @@ -47,7 +47,8 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos) character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='s_base_onelev_csetr' @@ -82,15 +83,15 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select diff --git a/mlprec/impl/level/mld_z_base_onelev_csetc.f90 b/mlprec/impl/level/mld_z_base_onelev_csetc.f90 index 85bf48dc..8553011e 100644 --- a/mlprec/impl/level/mld_z_base_onelev_csetc.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos) +subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx) use psb_base_mod use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_csetc @@ -47,7 +47,8 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='z_base_onelev_csetc' @@ -77,16 +78,16 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end if diff --git a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 index 303d788c..9ea87251 100644 --- a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) +subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx) use psb_base_mod use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_cseti @@ -68,7 +68,8 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='z_base_onelev_cseti' @@ -252,15 +253,15 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) case default if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_z_base_onelev_csetr.f90 b/mlprec/impl/level/mld_z_base_onelev_csetr.f90 index e5d55883..565524b9 100644 --- a/mlprec/impl/level/mld_z_base_onelev_csetr.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos) +subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos,idx) use psb_base_mod use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_csetr @@ -47,7 +47,8 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos) character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local integer(psb_ipk_) :: ipos_, err_act character(len=20) :: name='z_base_onelev_csetr' @@ -82,15 +83,15 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos) if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) + call lv%sm%set(what,val,info,idx=idx) end if end if if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) + call lv%sm2a%set(what,val,info,idx=idx) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) + if (allocated(lv%aggr)) call lv%aggr%set(what,val,info,idx=idx) end select diff --git a/mlprec/impl/mld_ccprecset.F90 b/mlprec/impl/mld_ccprecset.F90 index 79bfdd29..04684638 100644 --- a/mlprec/impl/mld_ccprecset.F90 +++ b/mlprec/impl/mld_ccprecset.F90 @@ -75,7 +75,7 @@ ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos) +subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_c_prec_mod, mld_protect_name => mld_ccprecseti @@ -102,6 +102,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il @@ -283,7 +284,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos) case default do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -410,7 +411,7 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos) case default do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) + call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -457,7 +458,7 @@ end subroutine mld_ccprecseti ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos) +subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_c_prec_mod, mld_protect_name => mld_ccprecsetc @@ -470,7 +471,8 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos) character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il @@ -486,7 +488,7 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos) if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) + call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx) else nlev_ = size(p%precv) @@ -515,7 +517,7 @@ subroutine mld_ccprecsetc(p,what,string,info,ilev,ilmax,pos) return endif do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) + call p%precv(il)%set(what,string,info,pos=pos,idx=idx) end do end if @@ -560,7 +562,7 @@ end subroutine mld_ccprecsetc ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos) +subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_c_prec_mod, mld_protect_name => mld_ccprecsetr @@ -573,7 +575,8 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos) real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il @@ -634,7 +637,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos) if (present(ilev)) then do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do else if (.not.present(ilev)) then @@ -650,7 +653,7 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos) case default do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select diff --git a/mlprec/impl/mld_dcprecset.F90 b/mlprec/impl/mld_dcprecset.F90 index 7838dea6..2532504f 100644 --- a/mlprec/impl/mld_dcprecset.F90 +++ b/mlprec/impl/mld_dcprecset.F90 @@ -75,7 +75,7 @@ ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos) +subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_d_prec_mod, mld_protect_name => mld_dcprecseti @@ -108,6 +108,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il @@ -303,7 +304,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos) case default do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -444,7 +445,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos) case default do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) + call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -491,7 +492,7 @@ end subroutine mld_dcprecseti ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos) +subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_d_prec_mod, mld_protect_name => mld_dcprecsetc @@ -504,7 +505,8 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos) character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il @@ -520,7 +522,7 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos) if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) + call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx) else nlev_ = size(p%precv) @@ -549,7 +551,7 @@ subroutine mld_dcprecsetc(p,what,string,info,ilev,ilmax,pos) return endif do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) + call p%precv(il)%set(what,string,info,pos=pos,idx=idx) end do end if @@ -594,7 +596,7 @@ end subroutine mld_dcprecsetc ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos) +subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_d_prec_mod, mld_protect_name => mld_dcprecsetr @@ -607,7 +609,8 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos) real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il @@ -668,7 +671,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos) if (present(ilev)) then do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do else if (.not.present(ilev)) then @@ -684,7 +687,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos) case default do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select diff --git a/mlprec/impl/mld_scprecset.F90 b/mlprec/impl/mld_scprecset.F90 index b887d878..7af6c714 100644 --- a/mlprec/impl/mld_scprecset.F90 +++ b/mlprec/impl/mld_scprecset.F90 @@ -75,7 +75,7 @@ ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos) +subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_s_prec_mod, mld_protect_name => mld_scprecseti @@ -102,6 +102,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il @@ -283,7 +284,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos) case default do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -410,7 +411,7 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos) case default do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) + call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -457,7 +458,7 @@ end subroutine mld_scprecseti ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos) +subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_s_prec_mod, mld_protect_name => mld_scprecsetc @@ -470,7 +471,8 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos) character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il @@ -486,7 +488,7 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos) if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) + call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx) else nlev_ = size(p%precv) @@ -515,7 +517,7 @@ subroutine mld_scprecsetc(p,what,string,info,ilev,ilmax,pos) return endif do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) + call p%precv(il)%set(what,string,info,pos=pos,idx=idx) end do end if @@ -560,7 +562,7 @@ end subroutine mld_scprecsetc ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos) +subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_s_prec_mod, mld_protect_name => mld_scprecsetr @@ -573,7 +575,8 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos) real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il @@ -634,7 +637,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos) if (present(ilev)) then do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do else if (.not.present(ilev)) then @@ -650,7 +653,7 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos) case default do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select diff --git a/mlprec/impl/mld_zcprecset.F90 b/mlprec/impl/mld_zcprecset.F90 index 871a03d4..37b41d67 100644 --- a/mlprec/impl/mld_zcprecset.F90 +++ b/mlprec/impl/mld_zcprecset.F90 @@ -75,7 +75,7 @@ ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos) +subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_z_prec_mod, mld_protect_name => mld_zcprecseti @@ -108,6 +108,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il @@ -303,7 +304,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos) case default do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -444,7 +445,7 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos) case default do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) + call p%precv(ilev_)%set(what,val,info,pos=pos,idx=idx) end do end select @@ -491,7 +492,7 @@ end subroutine mld_zcprecseti ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos) +subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_z_prec_mod, mld_protect_name => mld_zcprecsetc @@ -504,7 +505,8 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos) character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il @@ -520,7 +522,7 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos) if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) + call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos,idx=idx) else nlev_ = size(p%precv) @@ -549,7 +551,7 @@ subroutine mld_zcprecsetc(p,what,string,info,ilev,ilmax,pos) return endif do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) + call p%precv(il)%set(what,string,info,pos=pos,idx=idx) end do end if @@ -594,7 +596,7 @@ end subroutine mld_zcprecsetc ! For this reason, the interface mld_precset to this routine has been built in ! such a way that ilev is not visible to the user (see mld_prec_mod.f90). ! -subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos) +subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos,idx) use psb_base_mod use mld_z_prec_mod, mld_protect_name => mld_zcprecsetr @@ -607,7 +609,8 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos) real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos + character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx ! Local variables integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il @@ -668,7 +671,7 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos) if (present(ilev)) then do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do else if (.not.present(ilev)) then @@ -684,7 +687,7 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos) case default do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) + call p%precv(il)%set(what,val,info,pos=pos,idx=idx) end do end select diff --git a/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 index b48f58ed..a46f7bff 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_as_smoother_csetc(sm,what,val,info) +subroutine mld_c_as_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_csetc @@ -45,6 +45,7 @@ subroutine mld_c_as_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='c_as_smoother_csetc' @@ -54,9 +55,9 @@ subroutine mld_c_as_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else - call sm%mld_c_base_smoother_type%set(what,val,info) + call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx) end if if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 index 6414ed84..5a17adaf 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_as_smoother_cseti(sm,what,val,info) +subroutine mld_c_as_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_cseti @@ -46,6 +46,7 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_as_smoother_cseti' @@ -60,7 +61,7 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info) case('SUB_PROL') sm%prol = val case default - call sm%mld_c_base_smoother_type%set(what,val,info) + call sm%mld_c_base_smoother_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 index ea438b55..cdc2abe8 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_as_smoother_csetr(sm,what,val,info) +subroutine mld_c_as_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_csetr @@ -45,6 +45,7 @@ subroutine mld_c_as_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_as_smoother_csetr' @@ -53,7 +54,7 @@ subroutine mld_c_as_smoother_csetr(sm,what,val,info) if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) else !!$ write(0,*) trim(name),' Missing component, not setting!' !!$ info = 1121 diff --git a/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 index 94387853..58355833 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_smoother_csetc(sm,what,val,info) +subroutine mld_c_base_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_csetc @@ -46,6 +46,7 @@ subroutine mld_c_base_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='c_base_smoother_csetc' @@ -55,10 +56,10 @@ subroutine mld_c_base_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if end if diff --git a/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 index d04cc545..41ac305d 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_smoother_cseti(sm,what,val,info) +subroutine mld_c_base_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_cseti @@ -45,6 +45,7 @@ subroutine mld_c_base_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_base_smoother_cseti' @@ -52,7 +53,7 @@ subroutine mld_c_base_smoother_cseti(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 index 6890258e..5cd3ad34 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_smoother_csetr(sm,what,val,info) +subroutine mld_c_base_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_csetr @@ -46,6 +46,7 @@ subroutine mld_c_base_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_base_smoother_csetr' @@ -55,7 +56,7 @@ subroutine mld_c_base_smoother_csetr(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 index 13edd238..39b48836 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_as_smoother_csetc(sm,what,val,info) +subroutine mld_d_as_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_csetc @@ -45,6 +45,7 @@ subroutine mld_d_as_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='d_as_smoother_csetc' @@ -54,9 +55,9 @@ subroutine mld_d_as_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else - call sm%mld_d_base_smoother_type%set(what,val,info) + call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx) end if if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 index 269e90ce..0e51c2c7 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_as_smoother_cseti(sm,what,val,info) +subroutine mld_d_as_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_cseti @@ -46,6 +46,7 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_as_smoother_cseti' @@ -60,7 +61,7 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info) case('SUB_PROL') sm%prol = val case default - call sm%mld_d_base_smoother_type%set(what,val,info) + call sm%mld_d_base_smoother_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 index 29324f20..11547d4f 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_as_smoother_csetr(sm,what,val,info) +subroutine mld_d_as_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_csetr @@ -45,6 +45,7 @@ subroutine mld_d_as_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_as_smoother_csetr' @@ -53,7 +54,7 @@ subroutine mld_d_as_smoother_csetr(sm,what,val,info) if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) else !!$ write(0,*) trim(name),' Missing component, not setting!' !!$ info = 1121 diff --git a/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 index 64fb2902..b0a425c2 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_smoother_csetc(sm,what,val,info) +subroutine mld_d_base_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_csetc @@ -46,6 +46,7 @@ subroutine mld_d_base_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='d_base_smoother_csetc' @@ -55,10 +56,10 @@ subroutine mld_d_base_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if end if diff --git a/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 index 923288c8..20175edc 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_smoother_cseti(sm,what,val,info) +subroutine mld_d_base_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_cseti @@ -45,6 +45,7 @@ subroutine mld_d_base_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_smoother_cseti' @@ -52,7 +53,7 @@ subroutine mld_d_base_smoother_cseti(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 index 2048835f..bdae241d 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_smoother_csetr(sm,what,val,info) +subroutine mld_d_base_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_csetr @@ -46,6 +46,7 @@ subroutine mld_d_base_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_smoother_csetr' @@ -55,7 +56,7 @@ subroutine mld_d_base_smoother_csetr(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 index 08abf889..841f5adb 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_as_smoother_csetc(sm,what,val,info) +subroutine mld_s_as_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_csetc @@ -45,6 +45,7 @@ subroutine mld_s_as_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='s_as_smoother_csetc' @@ -54,9 +55,9 @@ subroutine mld_s_as_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else - call sm%mld_s_base_smoother_type%set(what,val,info) + call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx) end if if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 index 53950e47..4f0c2f9a 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_as_smoother_cseti(sm,what,val,info) +subroutine mld_s_as_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_cseti @@ -46,6 +46,7 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_as_smoother_cseti' @@ -60,7 +61,7 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info) case('SUB_PROL') sm%prol = val case default - call sm%mld_s_base_smoother_type%set(what,val,info) + call sm%mld_s_base_smoother_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 index 5cdb1a35..d0d3445a 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_as_smoother_csetr(sm,what,val,info) +subroutine mld_s_as_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_csetr @@ -45,6 +45,7 @@ subroutine mld_s_as_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_as_smoother_csetr' @@ -53,7 +54,7 @@ subroutine mld_s_as_smoother_csetr(sm,what,val,info) if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) else !!$ write(0,*) trim(name),' Missing component, not setting!' !!$ info = 1121 diff --git a/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 index 27c7d700..871f66fd 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_smoother_csetc(sm,what,val,info) +subroutine mld_s_base_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_csetc @@ -46,6 +46,7 @@ subroutine mld_s_base_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='s_base_smoother_csetc' @@ -55,10 +56,10 @@ subroutine mld_s_base_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if end if diff --git a/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 index 81808a41..8600372a 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_smoother_cseti(sm,what,val,info) +subroutine mld_s_base_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_cseti @@ -45,6 +45,7 @@ subroutine mld_s_base_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_base_smoother_cseti' @@ -52,7 +53,7 @@ subroutine mld_s_base_smoother_cseti(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 index 2e20b226..31a99c91 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_smoother_csetr(sm,what,val,info) +subroutine mld_s_base_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_csetr @@ -46,6 +46,7 @@ subroutine mld_s_base_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_base_smoother_csetr' @@ -55,7 +56,7 @@ subroutine mld_s_base_smoother_csetr(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 index 553a2d20..98749555 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_as_smoother_csetc(sm,what,val,info) +subroutine mld_z_as_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_csetc @@ -45,6 +45,7 @@ subroutine mld_z_as_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='z_as_smoother_csetc' @@ -54,9 +55,9 @@ subroutine mld_z_as_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else - call sm%mld_z_base_smoother_type%set(what,val,info) + call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx) end if if (info /= psb_success_) then diff --git a/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 index 0b7915be..03b47764 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_as_smoother_cseti(sm,what,val,info) +subroutine mld_z_as_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_cseti @@ -46,6 +46,7 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_as_smoother_cseti' @@ -60,7 +61,7 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info) case('SUB_PROL') sm%prol = val case default - call sm%mld_z_base_smoother_type%set(what,val,info) + call sm%mld_z_base_smoother_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 index c781b8ad..84aa75d9 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_as_smoother_csetr(sm,what,val,info) +subroutine mld_z_as_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_csetr @@ -45,6 +45,7 @@ subroutine mld_z_as_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_as_smoother_csetr' @@ -53,7 +54,7 @@ subroutine mld_z_as_smoother_csetr(sm,what,val,info) if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) else !!$ write(0,*) trim(name),' Missing component, not setting!' !!$ info = 1121 diff --git a/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 index 361fc3a0..fba8da22 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_smoother_csetc(sm,what,val,info) +subroutine mld_z_base_smoother_csetc(sm,what,val,info,idx) use psb_base_mod use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_csetc @@ -46,6 +46,7 @@ subroutine mld_z_base_smoother_csetc(sm,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='z_base_smoother_csetc' @@ -55,10 +56,10 @@ subroutine mld_z_base_smoother_csetc(sm,what,val,info) ival = sm%stringval(val) if (ival >= 0) then - call sm%set(what,ival,info) + call sm%set(what,ival,info,idx=idx) else if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if end if diff --git a/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 index f87f49c5..f431efd6 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_smoother_cseti(sm,what,val,info) +subroutine mld_z_base_smoother_cseti(sm,what,val,info,idx) use psb_base_mod use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_cseti @@ -45,6 +45,7 @@ subroutine mld_z_base_smoother_cseti(sm,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_base_smoother_cseti' @@ -52,7 +53,7 @@ subroutine mld_z_base_smoother_cseti(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 index 730df7ad..07be9ab8 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_smoother_csetr(sm,what,val,info) +subroutine mld_z_base_smoother_csetr(sm,what,val,info,idx) use psb_base_mod use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_csetr @@ -46,6 +46,7 @@ subroutine mld_z_base_smoother_csetr(sm,what,val,info) character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_base_smoother_csetr' @@ -55,7 +56,7 @@ subroutine mld_z_base_smoother_csetr(sm,what,val,info) info = psb_success_ if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + call sm%sv%set(what,val,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_c_base_solver_csetc.f90 b/mlprec/impl/solver/mld_c_base_solver_csetc.f90 index c11c2a23..48cf9ed9 100644 --- a/mlprec/impl/solver/mld_c_base_solver_csetc.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_solver_csetc(sv,what,val,info) +subroutine mld_c_base_solver_csetc(sv,what,val,info,idx) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_csetc @@ -45,6 +45,7 @@ subroutine mld_c_base_solver_csetc(sv,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx Integer(Psb_ipk_) :: err_act, ival character(len=20) :: name='d_base_solver_csetc' @@ -54,7 +55,7 @@ subroutine mld_c_base_solver_csetc(sv,what,val,info) ival = sv%stringval(val) if (ival >=0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_c_base_solver_cseti.f90 b/mlprec/impl/solver/mld_c_base_solver_cseti.f90 index 34bda825..be11d0b3 100644 --- a/mlprec/impl/solver/mld_c_base_solver_cseti.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_solver_cseti(sv,what,val,info) +subroutine mld_c_base_solver_cseti(sv,what,val,info,idx) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_cseti @@ -45,6 +45,7 @@ subroutine mld_c_base_solver_cseti(sv,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_cseti' diff --git a/mlprec/impl/solver/mld_c_base_solver_csetr.f90 b/mlprec/impl/solver/mld_c_base_solver_csetr.f90 index 5a210ded..b0373816 100644 --- a/mlprec/impl/solver/mld_c_base_solver_csetr.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_c_base_solver_csetr(sv,what,val,info) +subroutine mld_c_base_solver_csetr(sv,what,val,info,idx) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_csetr @@ -45,6 +45,7 @@ subroutine mld_c_base_solver_csetr(sv,what,val,info) integer(psb_ipk_), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_csetr' diff --git a/mlprec/impl/solver/mld_d_base_solver_csetc.f90 b/mlprec/impl/solver/mld_d_base_solver_csetc.f90 index 706d4ee1..0198ff40 100644 --- a/mlprec/impl/solver/mld_d_base_solver_csetc.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_solver_csetc(sv,what,val,info) +subroutine mld_d_base_solver_csetc(sv,what,val,info,idx) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_csetc @@ -45,6 +45,7 @@ subroutine mld_d_base_solver_csetc(sv,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx Integer(Psb_ipk_) :: err_act, ival character(len=20) :: name='d_base_solver_csetc' @@ -54,7 +55,7 @@ subroutine mld_d_base_solver_csetc(sv,what,val,info) ival = sv%stringval(val) if (ival >=0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_d_base_solver_cseti.f90 b/mlprec/impl/solver/mld_d_base_solver_cseti.f90 index 07cbd399..c30cf96b 100644 --- a/mlprec/impl/solver/mld_d_base_solver_cseti.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_solver_cseti(sv,what,val,info) +subroutine mld_d_base_solver_cseti(sv,what,val,info,idx) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_cseti @@ -45,6 +45,7 @@ subroutine mld_d_base_solver_cseti(sv,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_cseti' diff --git a/mlprec/impl/solver/mld_d_base_solver_csetr.f90 b/mlprec/impl/solver/mld_d_base_solver_csetr.f90 index 1511eb26..b55377be 100644 --- a/mlprec/impl/solver/mld_d_base_solver_csetr.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_d_base_solver_csetr(sv,what,val,info) +subroutine mld_d_base_solver_csetr(sv,what,val,info,idx) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_csetr @@ -45,6 +45,7 @@ subroutine mld_d_base_solver_csetr(sv,what,val,info) integer(psb_ipk_), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_csetr' diff --git a/mlprec/impl/solver/mld_s_base_solver_csetc.f90 b/mlprec/impl/solver/mld_s_base_solver_csetc.f90 index 0525d845..c7004902 100644 --- a/mlprec/impl/solver/mld_s_base_solver_csetc.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_solver_csetc(sv,what,val,info) +subroutine mld_s_base_solver_csetc(sv,what,val,info,idx) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_csetc @@ -45,6 +45,7 @@ subroutine mld_s_base_solver_csetc(sv,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx Integer(Psb_ipk_) :: err_act, ival character(len=20) :: name='d_base_solver_csetc' @@ -54,7 +55,7 @@ subroutine mld_s_base_solver_csetc(sv,what,val,info) ival = sv%stringval(val) if (ival >=0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_s_base_solver_cseti.f90 b/mlprec/impl/solver/mld_s_base_solver_cseti.f90 index 73da04f4..ff11aa50 100644 --- a/mlprec/impl/solver/mld_s_base_solver_cseti.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_solver_cseti(sv,what,val,info) +subroutine mld_s_base_solver_cseti(sv,what,val,info,idx) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_cseti @@ -45,6 +45,7 @@ subroutine mld_s_base_solver_cseti(sv,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_cseti' diff --git a/mlprec/impl/solver/mld_s_base_solver_csetr.f90 b/mlprec/impl/solver/mld_s_base_solver_csetr.f90 index 4afcd3a8..bd646583 100644 --- a/mlprec/impl/solver/mld_s_base_solver_csetr.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_s_base_solver_csetr(sv,what,val,info) +subroutine mld_s_base_solver_csetr(sv,what,val,info,idx) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_csetr @@ -45,6 +45,7 @@ subroutine mld_s_base_solver_csetr(sv,what,val,info) integer(psb_ipk_), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_csetr' diff --git a/mlprec/impl/solver/mld_z_base_solver_csetc.f90 b/mlprec/impl/solver/mld_z_base_solver_csetc.f90 index 048a4fdc..879b5d4d 100644 --- a/mlprec/impl/solver/mld_z_base_solver_csetc.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_csetc.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_solver_csetc(sv,what,val,info) +subroutine mld_z_base_solver_csetc(sv,what,val,info,idx) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_csetc @@ -45,6 +45,7 @@ subroutine mld_z_base_solver_csetc(sv,what,val,info) character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx Integer(Psb_ipk_) :: err_act, ival character(len=20) :: name='d_base_solver_csetc' @@ -54,7 +55,7 @@ subroutine mld_z_base_solver_csetc(sv,what,val,info) ival = sv%stringval(val) if (ival >=0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_z_base_solver_cseti.f90 b/mlprec/impl/solver/mld_z_base_solver_cseti.f90 index 25ac8f67..5cf357b8 100644 --- a/mlprec/impl/solver/mld_z_base_solver_cseti.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_cseti.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_solver_cseti(sv,what,val,info) +subroutine mld_z_base_solver_cseti(sv,what,val,info,idx) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_cseti @@ -45,6 +45,7 @@ subroutine mld_z_base_solver_cseti(sv,what,val,info) character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_cseti' diff --git a/mlprec/impl/solver/mld_z_base_solver_csetr.f90 b/mlprec/impl/solver/mld_z_base_solver_csetr.f90 index 739586fc..193fa789 100644 --- a/mlprec/impl/solver/mld_z_base_solver_csetr.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_csetr.f90 @@ -35,7 +35,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -subroutine mld_z_base_solver_csetr(sv,what,val,info) +subroutine mld_z_base_solver_csetr(sv,what,val,info,idx) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_csetr @@ -45,6 +45,7 @@ subroutine mld_z_base_solver_csetr(sv,what,val,info) integer(psb_ipk_), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_csetr' diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 9a84bad5..dcf26369 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -252,7 +252,7 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_cseti(sm,what,val,info) + subroutine mld_c_as_smoother_cseti(sm,what,val,info,idx) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -260,11 +260,12 @@ module mld_c_as_smoother character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_as_smoother_cseti end interface interface - subroutine mld_c_as_smoother_csetc(sm,what,val,info) + subroutine mld_c_as_smoother_csetc(sm,what,val,info,idx) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -272,6 +273,7 @@ module mld_c_as_smoother character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_as_smoother_csetc end interface diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index a30b8723..8bf95b5a 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -114,7 +114,7 @@ module mld_c_base_aggregator_mod contains - subroutine mld_c_base_aggregator_cseti(ag,what,val,info) + subroutine mld_c_base_aggregator_cseti(ag,what,val,info,idx) Implicit None @@ -123,11 +123,12 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_c_base_aggregator_cseti - subroutine mld_c_base_aggregator_csetr(ag,what,val,info) + subroutine mld_c_base_aggregator_csetr(ag,what,val,info,idx) Implicit None @@ -136,11 +137,12 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_c_base_aggregator_csetr - subroutine mld_c_base_aggregator_csetc(ag,what,val,info) + subroutine mld_c_base_aggregator_csetc(ag,what,val,info,idx) Implicit None @@ -149,6 +151,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_c_base_aggregator_csetc diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index a17300f5..1b4b7d59 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -186,7 +186,7 @@ module mld_c_base_smoother_mod end interface interface - subroutine mld_c_base_smoother_cseti(sm,what,val,info) + subroutine mld_c_base_smoother_cseti(sm,what,val,info,idx) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_smoother_type, psb_ipk_ @@ -195,11 +195,12 @@ module mld_c_base_smoother_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_smoother_cseti end interface interface - subroutine mld_c_base_smoother_csetc(sm,what,val,info) + subroutine mld_c_base_smoother_csetc(sm,what,val,info,idx) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_smoother_type, psb_ipk_ @@ -207,11 +208,12 @@ module mld_c_base_smoother_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_smoother_csetc end interface interface - subroutine mld_c_base_smoother_csetr(sm,what,val,info) + subroutine mld_c_base_smoother_csetr(sm,what,val,info,idx) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_smoother_type, psb_ipk_ @@ -220,6 +222,7 @@ module mld_c_base_smoother_mod character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_smoother_csetr end interface diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index 376abc61..c88965c7 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -207,7 +207,7 @@ module mld_c_base_solver_mod end interface interface - subroutine mld_c_base_solver_cseti(sv,what,val,info) + subroutine mld_c_base_solver_cseti(sv,what,val,info,idx) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_solver_type, psb_ipk_ @@ -218,11 +218,12 @@ module mld_c_base_solver_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_solver_cseti end interface interface - subroutine mld_c_base_solver_csetc(sv,what,val,info) + subroutine mld_c_base_solver_csetc(sv,what,val,info,idx) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_solver_type, psb_ipk_ @@ -233,11 +234,12 @@ module mld_c_base_solver_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_solver_csetc end interface interface - subroutine mld_c_base_solver_csetr(sv,what,val,info) + subroutine mld_c_base_solver_csetr(sv,what,val,info,idx) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & & mld_c_base_solver_type, psb_ipk_ @@ -247,6 +249,7 @@ module mld_c_base_solver_mod character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_solver_csetr end interface diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 746843ba..a40aede8 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -287,7 +287,7 @@ contains end subroutine c_gs_solver_check - subroutine c_gs_solver_cseti(sv,what,val,info) + subroutine c_gs_solver_cseti(sv,what,val,info,idx) Implicit None @@ -296,6 +296,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_gs_solver_cseti' @@ -306,7 +307,7 @@ contains case('SOLVER_SWEEPS') sv%sweeps = val case default - call sv%mld_c_base_solver_type%set(what,val,info) + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -316,7 +317,7 @@ contains return end subroutine c_gs_solver_cseti - subroutine c_gs_solver_csetc(sv,what,val,info) + subroutine c_gs_solver_csetc(sv,what,val,info,idx) Implicit None @@ -325,6 +326,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='c_gs_solver_csetc' @@ -334,7 +336,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -350,7 +352,7 @@ contains return end subroutine c_gs_solver_csetc - subroutine c_gs_solver_csetr(sv,what,val,info) + subroutine c_gs_solver_csetr(sv,what,val,info,idx) Implicit None @@ -359,6 +361,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_gs_solver_csetr' @@ -369,7 +372,7 @@ contains case('SOLVER_EPS') sv%eps = val case default - call sv%mld_c_base_solver_type%set(what,val,info) + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) end select diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index f7358797..0e88dba8 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -247,7 +247,7 @@ contains end subroutine c_ilu_solver_check - subroutine c_ilu_solver_cseti(sv,what,val,info) + subroutine c_ilu_solver_cseti(sv,what,val,info,idx) Implicit None @@ -256,6 +256,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_ilu_solver_cseti' @@ -268,7 +269,7 @@ contains case('SUB_FILLIN') sv%fill_in = val case default - call sv%mld_c_base_solver_type%set(what,val,info) + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -278,7 +279,7 @@ contains return end subroutine c_ilu_solver_cseti - subroutine c_ilu_solver_csetc(sv,what,val,info) + subroutine c_ilu_solver_csetc(sv,what,val,info,idx) Implicit None @@ -287,6 +288,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='c_ilu_solver_csetc' @@ -296,7 +298,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -312,7 +314,7 @@ contains return end subroutine c_ilu_solver_csetc - subroutine c_ilu_solver_csetr(sv,what,val,info) + subroutine c_ilu_solver_csetr(sv,what,val,info,idx) Implicit None @@ -321,6 +323,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_ilu_solver_csetr' @@ -331,7 +334,7 @@ contains case('SUB_ILUTHRS') sv%thresh = val case default - call sv%mld_c_base_solver_type%set(what,val,info) + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_c_mumps_solver.F90 b/mlprec/mld_c_mumps_solver.F90 index 0e2baca4..c1d921fe 100644 --- a/mlprec/mld_c_mumps_solver.F90 +++ b/mlprec/mld_c_mumps_solver.F90 @@ -255,7 +255,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine c_mumps_solver_cseti(sv,what,val,info) + subroutine c_mumps_solver_cseti(sv,what,val,info,idx) Implicit None @@ -264,6 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_cseti' @@ -276,9 +277,13 @@ contains sv%ipar(1)=val case('MUMPS_PRINT_ERR') sv%ipar(2)=val + case('MUMPS_IPAR_ENTRY') + if(present(idx)) then + sv%ipar(idx)=val + end if #endif case default - call sv%mld_c_base_solver_type%set(what,val,info) + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -293,7 +298,7 @@ contains return end subroutine c_mumps_solver_cseti - subroutine c_mumps_solver_csetr(sv,what,val,info) + subroutine c_mumps_solver_csetr(sv,what,val,info,idx) Implicit None @@ -302,6 +307,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_csetr' @@ -310,7 +316,7 @@ contains select case(psb_toupper(what)) case default - call sv%mld_c_base_solver_type%set(what,val,info) + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index b836b66b..6d0c0295 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -313,7 +313,7 @@ module mld_c_onelev_mod end interface interface - subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) + subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos,idx) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -325,11 +325,12 @@ module mld_c_onelev_mod integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_onelev_cseti end interface interface - subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos) + subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos,idx) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -340,11 +341,12 @@ module mld_c_onelev_mod character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_onelev_csetc end interface interface - subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos) + subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos,idx) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -355,6 +357,7 @@ module mld_c_onelev_mod real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_c_base_onelev_csetr end interface diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 7a9d4d13..bafc6a03 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -241,34 +241,34 @@ module mld_c_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_cprecsetag - subroutine mld_ccprecseti(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_ccprecseti(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & mld_cprec_type, psb_ipk_ class(mld_cprec_type), intent(inout) :: prec character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_ccprecseti - subroutine mld_ccprecsetr(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_ccprecsetr(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & mld_cprec_type, psb_ipk_ class(mld_cprec_type), intent(inout) :: prec character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_ccprecsetr - subroutine mld_ccprecsetc(prec,what,string,info,ilev,ilmax,pos) + subroutine mld_ccprecsetc(prec,what,string,info,ilev,ilmax,pos,idx) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & mld_cprec_type, psb_ipk_ class(mld_cprec_type), intent(inout) :: prec character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_ccprecsetc end interface diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 8aaee4b9..44d57ea4 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -252,7 +252,7 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_cseti(sm,what,val,info) + subroutine mld_d_as_smoother_cseti(sm,what,val,info,idx) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -260,11 +260,12 @@ module mld_d_as_smoother character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_as_smoother_cseti end interface interface - subroutine mld_d_as_smoother_csetc(sm,what,val,info) + subroutine mld_d_as_smoother_csetc(sm,what,val,info,idx) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -272,6 +273,7 @@ module mld_d_as_smoother character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_as_smoother_csetc end interface diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index cbd57fd3..97d8796a 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -114,7 +114,7 @@ module mld_d_base_aggregator_mod contains - subroutine mld_d_base_aggregator_cseti(ag,what,val,info) + subroutine mld_d_base_aggregator_cseti(ag,what,val,info,idx) Implicit None @@ -123,11 +123,12 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_d_base_aggregator_cseti - subroutine mld_d_base_aggregator_csetr(ag,what,val,info) + subroutine mld_d_base_aggregator_csetr(ag,what,val,info,idx) Implicit None @@ -136,11 +137,12 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_d_base_aggregator_csetr - subroutine mld_d_base_aggregator_csetc(ag,what,val,info) + subroutine mld_d_base_aggregator_csetc(ag,what,val,info,idx) Implicit None @@ -149,6 +151,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_d_base_aggregator_csetc diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 18391f39..84ccb79e 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -186,7 +186,7 @@ module mld_d_base_smoother_mod end interface interface - subroutine mld_d_base_smoother_cseti(sm,what,val,info) + subroutine mld_d_base_smoother_cseti(sm,what,val,info,idx) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_ @@ -195,11 +195,12 @@ module mld_d_base_smoother_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_smoother_cseti end interface interface - subroutine mld_d_base_smoother_csetc(sm,what,val,info) + subroutine mld_d_base_smoother_csetc(sm,what,val,info,idx) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_ @@ -207,11 +208,12 @@ module mld_d_base_smoother_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_smoother_csetc end interface interface - subroutine mld_d_base_smoother_csetr(sm,what,val,info) + subroutine mld_d_base_smoother_csetr(sm,what,val,info,idx) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_ @@ -220,6 +222,7 @@ module mld_d_base_smoother_mod character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_smoother_csetr end interface diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 536f4ee6..b2e70450 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -207,7 +207,7 @@ module mld_d_base_solver_mod end interface interface - subroutine mld_d_base_solver_cseti(sv,what,val,info) + subroutine mld_d_base_solver_cseti(sv,what,val,info,idx) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_solver_type, psb_ipk_ @@ -218,11 +218,12 @@ module mld_d_base_solver_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_solver_cseti end interface interface - subroutine mld_d_base_solver_csetc(sv,what,val,info) + subroutine mld_d_base_solver_csetc(sv,what,val,info,idx) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_solver_type, psb_ipk_ @@ -233,11 +234,12 @@ module mld_d_base_solver_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_solver_csetc end interface interface - subroutine mld_d_base_solver_csetr(sv,what,val,info) + subroutine mld_d_base_solver_csetr(sv,what,val,info,idx) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_solver_type, psb_ipk_ @@ -247,6 +249,7 @@ module mld_d_base_solver_mod character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_solver_csetr end interface diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 46ac5898..5bedce92 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -287,7 +287,7 @@ contains end subroutine d_gs_solver_check - subroutine d_gs_solver_cseti(sv,what,val,info) + subroutine d_gs_solver_cseti(sv,what,val,info,idx) Implicit None @@ -296,6 +296,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_gs_solver_cseti' @@ -306,7 +307,7 @@ contains case('SOLVER_SWEEPS') sv%sweeps = val case default - call sv%mld_d_base_solver_type%set(what,val,info) + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -316,7 +317,7 @@ contains return end subroutine d_gs_solver_cseti - subroutine d_gs_solver_csetc(sv,what,val,info) + subroutine d_gs_solver_csetc(sv,what,val,info,idx) Implicit None @@ -325,6 +326,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='d_gs_solver_csetc' @@ -334,7 +336,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -350,7 +352,7 @@ contains return end subroutine d_gs_solver_csetc - subroutine d_gs_solver_csetr(sv,what,val,info) + subroutine d_gs_solver_csetr(sv,what,val,info,idx) Implicit None @@ -359,6 +361,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_gs_solver_csetr' @@ -369,7 +372,7 @@ contains case('SOLVER_EPS') sv%eps = val case default - call sv%mld_d_base_solver_type%set(what,val,info) + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) end select diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index e6b177a2..e6a5894b 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -247,7 +247,7 @@ contains end subroutine d_ilu_solver_check - subroutine d_ilu_solver_cseti(sv,what,val,info) + subroutine d_ilu_solver_cseti(sv,what,val,info,idx) Implicit None @@ -256,6 +256,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_ilu_solver_cseti' @@ -268,7 +269,7 @@ contains case('SUB_FILLIN') sv%fill_in = val case default - call sv%mld_d_base_solver_type%set(what,val,info) + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -278,7 +279,7 @@ contains return end subroutine d_ilu_solver_cseti - subroutine d_ilu_solver_csetc(sv,what,val,info) + subroutine d_ilu_solver_csetc(sv,what,val,info,idx) Implicit None @@ -287,6 +288,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='d_ilu_solver_csetc' @@ -296,7 +298,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -312,7 +314,7 @@ contains return end subroutine d_ilu_solver_csetc - subroutine d_ilu_solver_csetr(sv,what,val,info) + subroutine d_ilu_solver_csetr(sv,what,val,info,idx) Implicit None @@ -321,6 +323,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_ilu_solver_csetr' @@ -331,7 +334,7 @@ contains case('SUB_ILUTHRS') sv%thresh = val case default - call sv%mld_d_base_solver_type%set(what,val,info) + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_d_mumps_solver.F90 b/mlprec/mld_d_mumps_solver.F90 index f41822d8..41e09a6c 100644 --- a/mlprec/mld_d_mumps_solver.F90 +++ b/mlprec/mld_d_mumps_solver.F90 @@ -255,7 +255,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine d_mumps_solver_cseti(sv,what,val,info) + subroutine d_mumps_solver_cseti(sv,what,val,info,idx) Implicit None @@ -264,6 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_cseti' @@ -276,9 +277,13 @@ contains sv%ipar(1)=val case('MUMPS_PRINT_ERR') sv%ipar(2)=val + case('MUMPS_IPAR_ENTRY') + if(present(idx)) then + sv%ipar(idx)=val + end if #endif case default - call sv%mld_d_base_solver_type%set(what,val,info) + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -293,7 +298,7 @@ contains return end subroutine d_mumps_solver_cseti - subroutine d_mumps_solver_csetr(sv,what,val,info) + subroutine d_mumps_solver_csetr(sv,what,val,info,idx) Implicit None @@ -302,6 +307,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_csetr' @@ -310,7 +316,7 @@ contains select case(psb_toupper(what)) case default - call sv%mld_d_base_solver_type%set(what,val,info) + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index 7cc6a728..e465667b 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -313,7 +313,7 @@ module mld_d_onelev_mod end interface interface - subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) + subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos,idx) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -325,11 +325,12 @@ module mld_d_onelev_mod integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_onelev_cseti end interface interface - subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos) + subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos,idx) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -340,11 +341,12 @@ module mld_d_onelev_mod character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_onelev_csetc end interface interface - subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos) + subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos,idx) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -355,6 +357,7 @@ module mld_d_onelev_mod real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_d_base_onelev_csetr end interface diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index a2d6e763..c1cbe45d 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -241,34 +241,34 @@ module mld_d_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_dprecsetag - subroutine mld_dcprecseti(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_dcprecseti(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & mld_dprec_type, psb_ipk_ class(mld_dprec_type), intent(inout) :: prec character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_dcprecseti - subroutine mld_dcprecsetr(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_dcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & mld_dprec_type, psb_ipk_ class(mld_dprec_type), intent(inout) :: prec character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_dcprecsetr - subroutine mld_dcprecsetc(prec,what,string,info,ilev,ilmax,pos) + subroutine mld_dcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & mld_dprec_type, psb_ipk_ class(mld_dprec_type), intent(inout) :: prec character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_dcprecsetc end interface diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index f7abe638..0f3ec7d7 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -252,7 +252,7 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_cseti(sm,what,val,info) + subroutine mld_s_as_smoother_cseti(sm,what,val,info,idx) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -260,11 +260,12 @@ module mld_s_as_smoother character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_as_smoother_cseti end interface interface - subroutine mld_s_as_smoother_csetc(sm,what,val,info) + subroutine mld_s_as_smoother_csetc(sm,what,val,info,idx) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -272,6 +273,7 @@ module mld_s_as_smoother character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_as_smoother_csetc end interface diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index acfc456a..6a180825 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -114,7 +114,7 @@ module mld_s_base_aggregator_mod contains - subroutine mld_s_base_aggregator_cseti(ag,what,val,info) + subroutine mld_s_base_aggregator_cseti(ag,what,val,info,idx) Implicit None @@ -123,11 +123,12 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_s_base_aggregator_cseti - subroutine mld_s_base_aggregator_csetr(ag,what,val,info) + subroutine mld_s_base_aggregator_csetr(ag,what,val,info,idx) Implicit None @@ -136,11 +137,12 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_s_base_aggregator_csetr - subroutine mld_s_base_aggregator_csetc(ag,what,val,info) + subroutine mld_s_base_aggregator_csetc(ag,what,val,info,idx) Implicit None @@ -149,6 +151,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_s_base_aggregator_csetc diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 0097e6e2..ab7590ea 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -186,7 +186,7 @@ module mld_s_base_smoother_mod end interface interface - subroutine mld_s_base_smoother_cseti(sm,what,val,info) + subroutine mld_s_base_smoother_cseti(sm,what,val,info,idx) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_smoother_type, psb_ipk_ @@ -195,11 +195,12 @@ module mld_s_base_smoother_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_smoother_cseti end interface interface - subroutine mld_s_base_smoother_csetc(sm,what,val,info) + subroutine mld_s_base_smoother_csetc(sm,what,val,info,idx) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_smoother_type, psb_ipk_ @@ -207,11 +208,12 @@ module mld_s_base_smoother_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_smoother_csetc end interface interface - subroutine mld_s_base_smoother_csetr(sm,what,val,info) + subroutine mld_s_base_smoother_csetr(sm,what,val,info,idx) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_smoother_type, psb_ipk_ @@ -220,6 +222,7 @@ module mld_s_base_smoother_mod character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_smoother_csetr end interface diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 2d31f730..ee0f7bba 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -207,7 +207,7 @@ module mld_s_base_solver_mod end interface interface - subroutine mld_s_base_solver_cseti(sv,what,val,info) + subroutine mld_s_base_solver_cseti(sv,what,val,info,idx) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_solver_type, psb_ipk_ @@ -218,11 +218,12 @@ module mld_s_base_solver_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_solver_cseti end interface interface - subroutine mld_s_base_solver_csetc(sv,what,val,info) + subroutine mld_s_base_solver_csetc(sv,what,val,info,idx) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_solver_type, psb_ipk_ @@ -233,11 +234,12 @@ module mld_s_base_solver_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_solver_csetc end interface interface - subroutine mld_s_base_solver_csetr(sv,what,val,info) + subroutine mld_s_base_solver_csetr(sv,what,val,info,idx) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & & mld_s_base_solver_type, psb_ipk_ @@ -247,6 +249,7 @@ module mld_s_base_solver_mod character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_solver_csetr end interface diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index 6029c2bb..17389073 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -287,7 +287,7 @@ contains end subroutine s_gs_solver_check - subroutine s_gs_solver_cseti(sv,what,val,info) + subroutine s_gs_solver_cseti(sv,what,val,info,idx) Implicit None @@ -296,6 +296,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_gs_solver_cseti' @@ -306,7 +307,7 @@ contains case('SOLVER_SWEEPS') sv%sweeps = val case default - call sv%mld_s_base_solver_type%set(what,val,info) + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -316,7 +317,7 @@ contains return end subroutine s_gs_solver_cseti - subroutine s_gs_solver_csetc(sv,what,val,info) + subroutine s_gs_solver_csetc(sv,what,val,info,idx) Implicit None @@ -325,6 +326,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='s_gs_solver_csetc' @@ -334,7 +336,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -350,7 +352,7 @@ contains return end subroutine s_gs_solver_csetc - subroutine s_gs_solver_csetr(sv,what,val,info) + subroutine s_gs_solver_csetr(sv,what,val,info,idx) Implicit None @@ -359,6 +361,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_gs_solver_csetr' @@ -369,7 +372,7 @@ contains case('SOLVER_EPS') sv%eps = val case default - call sv%mld_s_base_solver_type%set(what,val,info) + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) end select diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index b80632f1..02d464f9 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -247,7 +247,7 @@ contains end subroutine s_ilu_solver_check - subroutine s_ilu_solver_cseti(sv,what,val,info) + subroutine s_ilu_solver_cseti(sv,what,val,info,idx) Implicit None @@ -256,6 +256,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_ilu_solver_cseti' @@ -268,7 +269,7 @@ contains case('SUB_FILLIN') sv%fill_in = val case default - call sv%mld_s_base_solver_type%set(what,val,info) + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -278,7 +279,7 @@ contains return end subroutine s_ilu_solver_cseti - subroutine s_ilu_solver_csetc(sv,what,val,info) + subroutine s_ilu_solver_csetc(sv,what,val,info,idx) Implicit None @@ -287,6 +288,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='s_ilu_solver_csetc' @@ -296,7 +298,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -312,7 +314,7 @@ contains return end subroutine s_ilu_solver_csetc - subroutine s_ilu_solver_csetr(sv,what,val,info) + subroutine s_ilu_solver_csetr(sv,what,val,info,idx) Implicit None @@ -321,6 +323,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_ilu_solver_csetr' @@ -331,7 +334,7 @@ contains case('SUB_ILUTHRS') sv%thresh = val case default - call sv%mld_s_base_solver_type%set(what,val,info) + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_s_mumps_solver.F90 b/mlprec/mld_s_mumps_solver.F90 index 4b4e4f7e..6c69583e 100644 --- a/mlprec/mld_s_mumps_solver.F90 +++ b/mlprec/mld_s_mumps_solver.F90 @@ -255,7 +255,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine s_mumps_solver_cseti(sv,what,val,info) + subroutine s_mumps_solver_cseti(sv,what,val,info,idx) Implicit None @@ -264,6 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_cseti' @@ -276,9 +277,13 @@ contains sv%ipar(1)=val case('MUMPS_PRINT_ERR') sv%ipar(2)=val + case('MUMPS_IPAR_ENTRY') + if(present(idx)) then + sv%ipar(idx)=val + end if #endif case default - call sv%mld_s_base_solver_type%set(what,val,info) + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -293,7 +298,7 @@ contains return end subroutine s_mumps_solver_cseti - subroutine s_mumps_solver_csetr(sv,what,val,info) + subroutine s_mumps_solver_csetr(sv,what,val,info,idx) Implicit None @@ -302,6 +307,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_csetr' @@ -310,7 +316,7 @@ contains select case(psb_toupper(what)) case default - call sv%mld_s_base_solver_type%set(what,val,info) + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index 251ee330..e40ae8fb 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -313,7 +313,7 @@ module mld_s_onelev_mod end interface interface - subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) + subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos,idx) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -325,11 +325,12 @@ module mld_s_onelev_mod integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_onelev_cseti end interface interface - subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos) + subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos,idx) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -340,11 +341,12 @@ module mld_s_onelev_mod character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_onelev_csetc end interface interface - subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos) + subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos,idx) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -355,6 +357,7 @@ module mld_s_onelev_mod real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_s_base_onelev_csetr end interface diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index a2b05ec1..21dbfb27 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -241,34 +241,34 @@ module mld_s_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_sprecsetag - subroutine mld_scprecseti(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_scprecseti(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & mld_sprec_type, psb_ipk_ class(mld_sprec_type), intent(inout) :: prec character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_scprecseti - subroutine mld_scprecsetr(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_scprecsetr(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & mld_sprec_type, psb_ipk_ class(mld_sprec_type), intent(inout) :: prec character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_scprecsetr - subroutine mld_scprecsetc(prec,what,string,info,ilev,ilmax,pos) + subroutine mld_scprecsetc(prec,what,string,info,ilev,ilmax,pos,idx) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & mld_sprec_type, psb_ipk_ class(mld_sprec_type), intent(inout) :: prec character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_scprecsetc end interface diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index 2da97762..63de5ba3 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -252,7 +252,7 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_cseti(sm,what,val,info) + subroutine mld_z_as_smoother_cseti(sm,what,val,info,idx) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -260,11 +260,12 @@ module mld_z_as_smoother character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_as_smoother_cseti end interface interface - subroutine mld_z_as_smoother_csetc(sm,what,val,info) + subroutine mld_z_as_smoother_csetc(sm,what,val,info,idx) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ implicit none @@ -272,6 +273,7 @@ module mld_z_as_smoother character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_as_smoother_csetc end interface diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 552a2ce0..017b1f36 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -114,7 +114,7 @@ module mld_z_base_aggregator_mod contains - subroutine mld_z_base_aggregator_cseti(ag,what,val,info) + subroutine mld_z_base_aggregator_cseti(ag,what,val,info,idx) Implicit None @@ -123,11 +123,12 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_z_base_aggregator_cseti - subroutine mld_z_base_aggregator_csetr(ag,what,val,info) + subroutine mld_z_base_aggregator_csetr(ag,what,val,info,idx) Implicit None @@ -136,11 +137,12 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_z_base_aggregator_csetr - subroutine mld_z_base_aggregator_csetc(ag,what,val,info) + subroutine mld_z_base_aggregator_csetc(ag,what,val,info,idx) Implicit None @@ -149,6 +151,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx ! Do nothing info = 0 end subroutine mld_z_base_aggregator_csetc diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index ca176c7a..97fdaf1b 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -186,7 +186,7 @@ module mld_z_base_smoother_mod end interface interface - subroutine mld_z_base_smoother_cseti(sm,what,val,info) + subroutine mld_z_base_smoother_cseti(sm,what,val,info,idx) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_smoother_type, psb_ipk_ @@ -195,11 +195,12 @@ module mld_z_base_smoother_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_smoother_cseti end interface interface - subroutine mld_z_base_smoother_csetc(sm,what,val,info) + subroutine mld_z_base_smoother_csetc(sm,what,val,info,idx) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_smoother_type, psb_ipk_ @@ -207,11 +208,12 @@ module mld_z_base_smoother_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_smoother_csetc end interface interface - subroutine mld_z_base_smoother_csetr(sm,what,val,info) + subroutine mld_z_base_smoother_csetr(sm,what,val,info,idx) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_smoother_type, psb_ipk_ @@ -220,6 +222,7 @@ module mld_z_base_smoother_mod character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_smoother_csetr end interface diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 79e58678..3a1bf16a 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -207,7 +207,7 @@ module mld_z_base_solver_mod end interface interface - subroutine mld_z_base_solver_cseti(sv,what,val,info) + subroutine mld_z_base_solver_cseti(sv,what,val,info,idx) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_solver_type, psb_ipk_ @@ -218,11 +218,12 @@ module mld_z_base_solver_mod character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_solver_cseti end interface interface - subroutine mld_z_base_solver_csetc(sv,what,val,info) + subroutine mld_z_base_solver_csetc(sv,what,val,info,idx) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_solver_type, psb_ipk_ @@ -233,11 +234,12 @@ module mld_z_base_solver_mod character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_solver_csetc end interface interface - subroutine mld_z_base_solver_csetr(sv,what,val,info) + subroutine mld_z_base_solver_csetr(sv,what,val,info,idx) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & & mld_z_base_solver_type, psb_ipk_ @@ -247,6 +249,7 @@ module mld_z_base_solver_mod character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_solver_csetr end interface diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index 79ee052d..31f09c84 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -287,7 +287,7 @@ contains end subroutine z_gs_solver_check - subroutine z_gs_solver_cseti(sv,what,val,info) + subroutine z_gs_solver_cseti(sv,what,val,info,idx) Implicit None @@ -296,6 +296,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_gs_solver_cseti' @@ -306,7 +307,7 @@ contains case('SOLVER_SWEEPS') sv%sweeps = val case default - call sv%mld_z_base_solver_type%set(what,val,info) + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -316,7 +317,7 @@ contains return end subroutine z_gs_solver_cseti - subroutine z_gs_solver_csetc(sv,what,val,info) + subroutine z_gs_solver_csetc(sv,what,val,info,idx) Implicit None @@ -325,6 +326,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='z_gs_solver_csetc' @@ -334,7 +336,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -350,7 +352,7 @@ contains return end subroutine z_gs_solver_csetc - subroutine z_gs_solver_csetr(sv,what,val,info) + subroutine z_gs_solver_csetr(sv,what,val,info,idx) Implicit None @@ -359,6 +361,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_gs_solver_csetr' @@ -369,7 +372,7 @@ contains case('SOLVER_EPS') sv%eps = val case default - call sv%mld_z_base_solver_type%set(what,val,info) + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) end select diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index d1d9332f..398bcfee 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -247,7 +247,7 @@ contains end subroutine z_ilu_solver_check - subroutine z_ilu_solver_cseti(sv,what,val,info) + subroutine z_ilu_solver_cseti(sv,what,val,info,idx) Implicit None @@ -256,6 +256,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_ilu_solver_cseti' @@ -268,7 +269,7 @@ contains case('SUB_FILLIN') sv%fill_in = val case default - call sv%mld_z_base_solver_type%set(what,val,info) + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -278,7 +279,7 @@ contains return end subroutine z_ilu_solver_cseti - subroutine z_ilu_solver_csetc(sv,what,val,info) + subroutine z_ilu_solver_csetc(sv,what,val,info,idx) Implicit None @@ -287,6 +288,7 @@ contains character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act, ival character(len=20) :: name='z_ilu_solver_csetc' @@ -296,7 +298,7 @@ contains ival = sv%stringval(val) if (ival >= 0) then - call sv%set(what,ival,info) + call sv%set(what,ival,info,idx=idx) end if if (info /= psb_success_) then @@ -312,7 +314,7 @@ contains return end subroutine z_ilu_solver_csetc - subroutine z_ilu_solver_csetr(sv,what,val,info) + subroutine z_ilu_solver_csetr(sv,what,val,info,idx) Implicit None @@ -321,6 +323,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_ilu_solver_csetr' @@ -331,7 +334,7 @@ contains case('SUB_ILUTHRS') sv%thresh = val case default - call sv%mld_z_base_solver_type%set(what,val,info) + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_z_mumps_solver.F90 b/mlprec/mld_z_mumps_solver.F90 index 61699694..95a7115c 100644 --- a/mlprec/mld_z_mumps_solver.F90 +++ b/mlprec/mld_z_mumps_solver.F90 @@ -255,7 +255,7 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine z_mumps_solver_cseti(sv,what,val,info) + subroutine z_mumps_solver_cseti(sv,what,val,info,idx) Implicit None @@ -264,6 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_cseti' @@ -276,9 +277,13 @@ contains sv%ipar(1)=val case('MUMPS_PRINT_ERR') sv%ipar(2)=val + case('MUMPS_IPAR_ENTRY') + if(present(idx)) then + sv%ipar(idx)=val + end if #endif case default - call sv%mld_z_base_solver_type%set(what,val,info) + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) @@ -293,7 +298,7 @@ contains return end subroutine z_mumps_solver_cseti - subroutine z_mumps_solver_csetr(sv,what,val,info) + subroutine z_mumps_solver_csetr(sv,what,val,info,idx) Implicit None @@ -302,6 +307,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_csetr' @@ -310,7 +316,7 @@ contains select case(psb_toupper(what)) case default - call sv%mld_z_base_solver_type%set(what,val,info) + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) end select call psb_erractionrestore(err_act) diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 70dd6471..ceaa300e 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -313,7 +313,7 @@ module mld_z_onelev_mod end interface interface - subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) + subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos,idx) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -325,11 +325,12 @@ module mld_z_onelev_mod integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_onelev_cseti end interface interface - subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos) + subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos,idx) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -340,11 +341,12 @@ module mld_z_onelev_mod character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_onelev_csetc end interface interface - subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos) + subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos,idx) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & & psb_ipk_, psb_long_int_k_, psb_desc_type @@ -355,6 +357,7 @@ module mld_z_onelev_mod real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos + integer(psb_ipk_), intent(in), optional :: idx end subroutine mld_z_base_onelev_csetr end interface diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index ce1d0a81..db29b60b 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -241,34 +241,34 @@ module mld_z_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_zprecsetag - subroutine mld_zcprecseti(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_zcprecseti(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & mld_zprec_type, psb_ipk_ class(mld_zprec_type), intent(inout) :: prec character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_zcprecseti - subroutine mld_zcprecsetr(prec,what,val,info,ilev,ilmax,pos) + subroutine mld_zcprecsetr(prec,what,val,info,ilev,ilmax,pos,idx) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & mld_zprec_type, psb_ipk_ class(mld_zprec_type), intent(inout) :: prec character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_zcprecsetr - subroutine mld_zcprecsetc(prec,what,string,info,ilev,ilmax,pos) + subroutine mld_zcprecsetc(prec,what,string,info,ilev,ilmax,pos,idx) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & mld_zprec_type, psb_ipk_ class(mld_zprec_type), intent(inout) :: prec character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax + integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx character(len=*), optional, intent(in) :: pos end subroutine mld_zcprecsetc end interface From 4ffbd6516632f1bb596425516982b6c2bee95387 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 4 Oct 2018 08:21:43 +0100 Subject: [PATCH 11/16] Added average coarsening ratio --- mlprec/impl/mld_c_hierarchy_bld.f90 | 1 + mlprec/impl/mld_cfile_prec_descr.f90 | 1 + mlprec/impl/mld_d_hierarchy_bld.f90 | 1 + mlprec/impl/mld_dfile_prec_descr.f90 | 1 + mlprec/impl/mld_s_hierarchy_bld.f90 | 1 + mlprec/impl/mld_sfile_prec_descr.f90 | 1 + mlprec/impl/mld_z_hierarchy_bld.f90 | 1 + mlprec/impl/mld_zfile_prec_descr.f90 | 1 + mlprec/mld_c_prec_type.f90 | 44 +++++++++++++++++++++++++++- mlprec/mld_d_prec_type.f90 | 44 +++++++++++++++++++++++++++- mlprec/mld_s_prec_type.f90 | 44 +++++++++++++++++++++++++++- mlprec/mld_z_prec_type.f90 | 44 +++++++++++++++++++++++++++- 12 files changed, 180 insertions(+), 4 deletions(-) diff --git a/mlprec/impl/mld_c_hierarchy_bld.f90 b/mlprec/impl/mld_c_hierarchy_bld.f90 index 5511fcdc..4ebaa374 100644 --- a/mlprec/impl/mld_c_hierarchy_bld.f90 +++ b/mlprec/impl/mld_c_hierarchy_bld.f90 @@ -444,6 +444,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) iszv = size(prec%precv) call prec%cmp_complexity() + call prec%cmp_avg_cr() if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_cfile_prec_descr.f90 b/mlprec/impl/mld_cfile_prec_descr.f90 index 1f243756..499421d0 100644 --- a/mlprec/impl/mld_cfile_prec_descr.f90 +++ b/mlprec/impl/mld_cfile_prec_descr.f90 @@ -172,6 +172,7 @@ subroutine mld_cfile_prec_descr(prec,iout,root) write(iout_,*) 'Multilevel hierarchy: ' write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev diff --git a/mlprec/impl/mld_d_hierarchy_bld.f90 b/mlprec/impl/mld_d_hierarchy_bld.f90 index b3b68307..0a40dcb8 100644 --- a/mlprec/impl/mld_d_hierarchy_bld.f90 +++ b/mlprec/impl/mld_d_hierarchy_bld.f90 @@ -444,6 +444,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) iszv = size(prec%precv) call prec%cmp_complexity() + call prec%cmp_avg_cr() if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_dfile_prec_descr.f90 b/mlprec/impl/mld_dfile_prec_descr.f90 index d129e434..d2c3735b 100644 --- a/mlprec/impl/mld_dfile_prec_descr.f90 +++ b/mlprec/impl/mld_dfile_prec_descr.f90 @@ -172,6 +172,7 @@ subroutine mld_dfile_prec_descr(prec,iout,root) write(iout_,*) 'Multilevel hierarchy: ' write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev diff --git a/mlprec/impl/mld_s_hierarchy_bld.f90 b/mlprec/impl/mld_s_hierarchy_bld.f90 index aa23b70c..e4951c7c 100644 --- a/mlprec/impl/mld_s_hierarchy_bld.f90 +++ b/mlprec/impl/mld_s_hierarchy_bld.f90 @@ -444,6 +444,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) iszv = size(prec%precv) call prec%cmp_complexity() + call prec%cmp_avg_cr() if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_sfile_prec_descr.f90 b/mlprec/impl/mld_sfile_prec_descr.f90 index c90976e2..7bb0a150 100644 --- a/mlprec/impl/mld_sfile_prec_descr.f90 +++ b/mlprec/impl/mld_sfile_prec_descr.f90 @@ -172,6 +172,7 @@ subroutine mld_sfile_prec_descr(prec,iout,root) write(iout_,*) 'Multilevel hierarchy: ' write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev diff --git a/mlprec/impl/mld_z_hierarchy_bld.f90 b/mlprec/impl/mld_z_hierarchy_bld.f90 index 895b9a9c..638021ee 100644 --- a/mlprec/impl/mld_z_hierarchy_bld.f90 +++ b/mlprec/impl/mld_z_hierarchy_bld.f90 @@ -444,6 +444,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) iszv = size(prec%precv) call prec%cmp_complexity() + call prec%cmp_avg_cr() if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/mld_zfile_prec_descr.f90 b/mlprec/impl/mld_zfile_prec_descr.f90 index e54e3a4f..ab1789f0 100644 --- a/mlprec/impl/mld_zfile_prec_descr.f90 +++ b/mlprec/impl/mld_zfile_prec_descr.f90 @@ -172,6 +172,7 @@ subroutine mld_zfile_prec_descr(prec,iout,root) write(iout_,*) 'Multilevel hierarchy: ' write(iout_,*) ' Number of levels : ',nlev write(iout_,*) ' Operator complexity: ',prec%get_complexity() + write(iout_,*) ' Average coarsening : ',prec%get_avg_cr() ilmin = 2 if (nlev == 2) ilmin=1 do ilev=ilmin,nlev diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index bafc6a03..59597e89 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -95,6 +95,7 @@ module mld_c_prec_type ! 3. min_cr_ratio = 1.5 real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_ real(psb_spk_) :: op_complexity = szero + real(psb_spk_) :: avg_cr = szero ! ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! @@ -122,6 +123,8 @@ module mld_c_prec_type procedure, pass(prec) :: free_wrk => mld_c_free_wrk procedure, pass(prec) :: get_complexity => mld_c_get_compl procedure, pass(prec) :: cmp_complexity => mld_c_cmp_compl + procedure, pass(prec) :: get_avg_cr => mld_c_get_avg_cr + procedure, pass(prec) :: cmp_avg_cr => mld_c_cmp_avg_cr procedure, pass(prec) :: get_nlevs => mld_c_get_nlevs procedure, pass(prec) :: get_nzeros => mld_c_get_nzeros procedure, pass(prec) :: sizeof => mld_cprec_sizeof @@ -143,7 +146,8 @@ module mld_c_prec_type end type mld_cprec_type private :: mld_c_dump, mld_c_get_compl, mld_c_cmp_compl,& - & mld_c_get_nzeros, mld_c_get_nlevs, c_prec_move_alloc + & mld_c_get_avg_cr, mld_c_cmp_avg_cr,& + & mld_c_get_nzeros, mld_c_get_nlevs, c_prec_move_alloc ! @@ -476,6 +480,43 @@ contains prec%op_complexity = num/den end subroutine mld_c_cmp_compl + ! + ! Average coarsening ratio + ! + + function mld_c_get_avg_cr(prec) result(val) + implicit none + class(mld_cprec_type), intent(in) :: prec + complex(psb_spk_) :: val + + val = prec%avg_cr + + end function mld_c_get_avg_cr + + subroutine mld_c_cmp_avg_cr(prec) + + implicit none + class(mld_cprec_type), intent(inout) :: prec + + real(psb_spk_) :: avgcr + integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: il, nl, iam, np + + + avgcr = szero + ictxt = prec%ictxt + call psb_info(ictxt,iam,np) + if (allocated(prec%precv)) then + nl = size(prec%precv) + do il=2,nl + avgcr = avgcr + max(szero,prec%precv(il)%szratio) + end do + avgcr = avgcr / (nl-1) + end if + call psb_sum(ictxt,avgcr) + prec%avg_cr = avgcr/np + end subroutine mld_c_cmp_avg_cr + ! ! Subroutines: mld_Tprec_free ! Version: complex @@ -740,6 +781,7 @@ contains pout%min_cr_ratio = prec%min_cr_ratio pout%outer_sweeps = prec%outer_sweeps pout%op_complexity = prec%op_complexity + pout%avg_cr = prec%avg_cr if (allocated(prec%precv)) then ln = size(prec%precv) allocate(pout%precv(ln),stat=info) diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index c1cbe45d..c8b5d623 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -95,6 +95,7 @@ module mld_d_prec_type ! 3. min_cr_ratio = 1.5 real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_ real(psb_dpk_) :: op_complexity = dzero + real(psb_dpk_) :: avg_cr = dzero ! ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! @@ -122,6 +123,8 @@ module mld_d_prec_type procedure, pass(prec) :: free_wrk => mld_d_free_wrk procedure, pass(prec) :: get_complexity => mld_d_get_compl procedure, pass(prec) :: cmp_complexity => mld_d_cmp_compl + procedure, pass(prec) :: get_avg_cr => mld_d_get_avg_cr + procedure, pass(prec) :: cmp_avg_cr => mld_d_cmp_avg_cr procedure, pass(prec) :: get_nlevs => mld_d_get_nlevs procedure, pass(prec) :: get_nzeros => mld_d_get_nzeros procedure, pass(prec) :: sizeof => mld_dprec_sizeof @@ -143,7 +146,8 @@ module mld_d_prec_type end type mld_dprec_type private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,& - & mld_d_get_nzeros, mld_d_get_nlevs, d_prec_move_alloc + & mld_d_get_avg_cr, mld_d_cmp_avg_cr,& + & mld_d_get_nzeros, mld_d_get_nlevs, d_prec_move_alloc ! @@ -476,6 +480,43 @@ contains prec%op_complexity = num/den end subroutine mld_d_cmp_compl + ! + ! Average coarsening ratio + ! + + function mld_d_get_avg_cr(prec) result(val) + implicit none + class(mld_dprec_type), intent(in) :: prec + real(psb_dpk_) :: val + + val = prec%avg_cr + + end function mld_d_get_avg_cr + + subroutine mld_d_cmp_avg_cr(prec) + + implicit none + class(mld_dprec_type), intent(inout) :: prec + + real(psb_dpk_) :: avgcr + integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: il, nl, iam, np + + + avgcr = dzero + ictxt = prec%ictxt + call psb_info(ictxt,iam,np) + if (allocated(prec%precv)) then + nl = size(prec%precv) + do il=2,nl + avgcr = avgcr + max(dzero,prec%precv(il)%szratio) + end do + avgcr = avgcr / (nl-1) + end if + call psb_sum(ictxt,avgcr) + prec%avg_cr = avgcr/np + end subroutine mld_d_cmp_avg_cr + ! ! Subroutines: mld_Tprec_free ! Version: real @@ -740,6 +781,7 @@ contains pout%min_cr_ratio = prec%min_cr_ratio pout%outer_sweeps = prec%outer_sweeps pout%op_complexity = prec%op_complexity + pout%avg_cr = prec%avg_cr if (allocated(prec%precv)) then ln = size(prec%precv) allocate(pout%precv(ln),stat=info) diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 21dbfb27..9d2f0eb0 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -95,6 +95,7 @@ module mld_s_prec_type ! 3. min_cr_ratio = 1.5 real(psb_spk_) :: min_cr_ratio = 1.5_psb_spk_ real(psb_spk_) :: op_complexity = szero + real(psb_spk_) :: avg_cr = szero ! ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! @@ -122,6 +123,8 @@ module mld_s_prec_type procedure, pass(prec) :: free_wrk => mld_s_free_wrk procedure, pass(prec) :: get_complexity => mld_s_get_compl procedure, pass(prec) :: cmp_complexity => mld_s_cmp_compl + procedure, pass(prec) :: get_avg_cr => mld_s_get_avg_cr + procedure, pass(prec) :: cmp_avg_cr => mld_s_cmp_avg_cr procedure, pass(prec) :: get_nlevs => mld_s_get_nlevs procedure, pass(prec) :: get_nzeros => mld_s_get_nzeros procedure, pass(prec) :: sizeof => mld_sprec_sizeof @@ -143,7 +146,8 @@ module mld_s_prec_type end type mld_sprec_type private :: mld_s_dump, mld_s_get_compl, mld_s_cmp_compl,& - & mld_s_get_nzeros, mld_s_get_nlevs, s_prec_move_alloc + & mld_s_get_avg_cr, mld_s_cmp_avg_cr,& + & mld_s_get_nzeros, mld_s_get_nlevs, s_prec_move_alloc ! @@ -476,6 +480,43 @@ contains prec%op_complexity = num/den end subroutine mld_s_cmp_compl + ! + ! Average coarsening ratio + ! + + function mld_s_get_avg_cr(prec) result(val) + implicit none + class(mld_sprec_type), intent(in) :: prec + real(psb_spk_) :: val + + val = prec%avg_cr + + end function mld_s_get_avg_cr + + subroutine mld_s_cmp_avg_cr(prec) + + implicit none + class(mld_sprec_type), intent(inout) :: prec + + real(psb_spk_) :: avgcr + integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: il, nl, iam, np + + + avgcr = szero + ictxt = prec%ictxt + call psb_info(ictxt,iam,np) + if (allocated(prec%precv)) then + nl = size(prec%precv) + do il=2,nl + avgcr = avgcr + max(szero,prec%precv(il)%szratio) + end do + avgcr = avgcr / (nl-1) + end if + call psb_sum(ictxt,avgcr) + prec%avg_cr = avgcr/np + end subroutine mld_s_cmp_avg_cr + ! ! Subroutines: mld_Tprec_free ! Version: real @@ -740,6 +781,7 @@ contains pout%min_cr_ratio = prec%min_cr_ratio pout%outer_sweeps = prec%outer_sweeps pout%op_complexity = prec%op_complexity + pout%avg_cr = prec%avg_cr if (allocated(prec%precv)) then ln = size(prec%precv) allocate(pout%precv(ln),stat=info) diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index db29b60b..d4226422 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -95,6 +95,7 @@ module mld_z_prec_type ! 3. min_cr_ratio = 1.5 real(psb_dpk_) :: min_cr_ratio = 1.5_psb_dpk_ real(psb_dpk_) :: op_complexity = dzero + real(psb_dpk_) :: avg_cr = dzero ! ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! @@ -122,6 +123,8 @@ module mld_z_prec_type procedure, pass(prec) :: free_wrk => mld_z_free_wrk procedure, pass(prec) :: get_complexity => mld_z_get_compl procedure, pass(prec) :: cmp_complexity => mld_z_cmp_compl + procedure, pass(prec) :: get_avg_cr => mld_z_get_avg_cr + procedure, pass(prec) :: cmp_avg_cr => mld_z_cmp_avg_cr procedure, pass(prec) :: get_nlevs => mld_z_get_nlevs procedure, pass(prec) :: get_nzeros => mld_z_get_nzeros procedure, pass(prec) :: sizeof => mld_zprec_sizeof @@ -143,7 +146,8 @@ module mld_z_prec_type end type mld_zprec_type private :: mld_z_dump, mld_z_get_compl, mld_z_cmp_compl,& - & mld_z_get_nzeros, mld_z_get_nlevs, z_prec_move_alloc + & mld_z_get_avg_cr, mld_z_cmp_avg_cr,& + & mld_z_get_nzeros, mld_z_get_nlevs, z_prec_move_alloc ! @@ -476,6 +480,43 @@ contains prec%op_complexity = num/den end subroutine mld_z_cmp_compl + ! + ! Average coarsening ratio + ! + + function mld_z_get_avg_cr(prec) result(val) + implicit none + class(mld_zprec_type), intent(in) :: prec + complex(psb_dpk_) :: val + + val = prec%avg_cr + + end function mld_z_get_avg_cr + + subroutine mld_z_cmp_avg_cr(prec) + + implicit none + class(mld_zprec_type), intent(inout) :: prec + + real(psb_dpk_) :: avgcr + integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: il, nl, iam, np + + + avgcr = dzero + ictxt = prec%ictxt + call psb_info(ictxt,iam,np) + if (allocated(prec%precv)) then + nl = size(prec%precv) + do il=2,nl + avgcr = avgcr + max(dzero,prec%precv(il)%szratio) + end do + avgcr = avgcr / (nl-1) + end if + call psb_sum(ictxt,avgcr) + prec%avg_cr = avgcr/np + end subroutine mld_z_cmp_avg_cr + ! ! Subroutines: mld_Tprec_free ! Version: complex @@ -740,6 +781,7 @@ contains pout%min_cr_ratio = prec%min_cr_ratio pout%outer_sweeps = prec%outer_sweeps pout%op_complexity = prec%op_complexity + pout%avg_cr = prec%avg_cr if (allocated(prec%precv)) then ln = size(prec%precv) allocate(pout%precv(ln),stat=info) From c64eef2eb11bf12c34ae423cc35f5810c6ac121f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 5 Oct 2018 16:37:03 +0100 Subject: [PATCH 12/16] Formatting source code in mumps module. Updated docs for IDX in %SET. --- docs/html/node13.html | 4 +- docs/html/node20.html | 47 +- docs/html/node24.html | 2 +- docs/html/node33.html | 5 +- docs/html/node37.html | 2 +- docs/mld2p4-2.2-guide.pdf | 1410 +++++++++++++++++---------------- docs/src/newobjects.tex | 5 +- docs/src/userinterface.tex | 20 +- mlprec/mld_c_mumps_solver.F90 | 10 +- mlprec/mld_d_mumps_solver.F90 | 10 +- mlprec/mld_s_mumps_solver.F90 | 10 +- mlprec/mld_z_mumps_solver.F90 | 10 +- 12 files changed, 817 insertions(+), 718 deletions(-) diff --git a/docs/html/node13.html b/docs/html/node13.html index 26b49b23..ed74739a 100644 --- a/docs/html/node13.html +++ b/docs/html/node13.html @@ -262,8 +262,8 @@ end \begin{tabbing} \quad \=\quad \=\quad... ...[1mm] -\>endif \\ [1mm] -\>return $u^k$\ \\ [1mm] +\>endif [1mm] +\>return $u^k$ [1mm] end \end{tabbing}\end{minipage}}"> diff --git a/docs/html/node20.html b/docs/html/node20.html index f22f9a27..12074b7b 100644 --- a/docs/html/node20.html +++ b/docs/html/node20.html @@ -54,7 +54,7 @@ Method set

-

call p%set(what,val,info [,ilev, ilmax, pos]) +
call p%set(what,val,info [,ilev, ilmax, pos, idx])

@@ -139,7 +139,16 @@ contained in val. or to the post-smoother ('POST'). If pos is not present, the other arguments are applied to both smoothers. If the preconditioner is one-level or the parameter identified by what - does not concern the smoothers, pos is ignored. + does not concern the smoothers, pos is ignored. + + +idx + integer, optional, intent(in). + + + + An auxiliary input argument that can be passed to the + underlying objects. @@ -153,7 +162,8 @@ as follows:

-However, in this case the optional arguments ilev, ilmax, and pos +However, in this case the optional arguments ilev, +ilmax, pos and idx cannot be used.

@@ -245,9 +255,16 @@ therefore, if SuperLu_Dist has been previously set, the coarsest-level solver is changed to the default sequential solver.

+Remark 4. The argument idx can be used to allow finer +control for those solvers; for instance, by specifying the keyword +MUMPS_IPAR_ENTRY and an appropriate value for idx, it is +possible to set any entry in the MUMPS integer control array. +See also Sec. 7. + +


-
+
Table 2: Parameters defining the multilevel cycle and the number of cycles to @@ -300,7 +317,7 @@ number

-
+
Table 3: Parameters defining the aggregation algorithm. @@ -419,7 +436,7 @@ of levels.


-
+
Table 4: Parameters defining the aggregation algorithm (continued). @@ -486,7 +503,7 @@ the parameter ilev.


-
+
Table 5: Parameters defining the coarse-space correction at the coarsest @@ -593,7 +610,7 @@ Note that UMF and SLU require the coarsest


-
+
Table 6: Parameters defining the coarse-space correction at the coarsest @@ -659,7 +676,7 @@ number

-
+
Table 7: Parameters defining the smoother or the details of the one-level preconditioner. @@ -786,7 +803,7 @@ Parameters defining the smoother or the details of the one-level preconditioner.


-
+
+ + + + + diff --git a/docs/html/node24.html b/docs/html/node24.html index 447807ca..dd20f43a 100644 --- a/docs/html/node24.html +++ b/docs/html/node24.html @@ -64,7 +64,7 @@ This method computes
Table 8: Parameters defining the smoother or the details of the one-level preconditioner @@ -873,6 +890,16 @@ Parameters defining the smoother or the details of the one-level preconditioner SRC="img83.png" ALT="$p,t$">) factorization. +
'MUMPS_IPAR_ENTRY' integer + Any integer number + 0 + Set an entry in the MUMPS control array, as + chosen via the idx optional argument.