diff --git a/README b/README index 6528601e..e23b55a2 100644 --- a/README +++ b/README @@ -8,7 +8,7 @@ In version 1.0.1: - The internals of the multilevel preconditioner have been repackaged in a more structured fashion; no changes are needed in the user code. -- Note that we now need version 2.3.1 of PSBLAS. +- Note that we now need version 2.3.1 of PSBLAS. To compile: diff --git a/config/pac.m4 b/config/pac.m4 index cf6d8927..064bbd1d 100644 --- a/config/pac.m4 +++ b/config/pac.m4 @@ -141,8 +141,8 @@ dnl Warning : square brackets are EVIL! [ cat > conftest.$ac_ext <= 4 && __GNUC_MINOR__ >= 2 ) || ( __GNUC__ > 4 ) - print *, "ciao" +#if ( __GNUC__ >= 4 && __GNUC_MINOR__ > 2 ) || ( __GNUC__ > 4 ) + print *, "ok" #else this program will fail #endif diff --git a/krylov/psb_prec_mod.F90 b/krylov/psb_prec_mod.F90 index 99fc7d92..be1dec72 100644 --- a/krylov/psb_prec_mod.F90 +++ b/krylov/psb_prec_mod.F90 @@ -50,50 +50,6 @@ ! module psb_prec_mod -#if (__GNUC__==4) && (__GNUC_MINOR__<=2) - - ! - ! GNU Fortran 4.2. - ! Workaround for PR 32634, it is fixed in GNU Fortran 4.3, will - ! it be fixed in 4.2??? - ! - - use mld_prec_type, & - & psb_dbaseprc_type => mld_dbaseprc_type,& - & psb_zbaseprc_type => mld_zbaseprc_type,& - & psb_dprec_type => mld_dprec_type,& - & psb_zprec_type => mld_zprec_type,& - & psb_base_precfree => mld_base_precfree,& - & psb_nullify_baseprec => mld_nullify_baseprec,& - & psb_precdescr => mld_precdescr,& - & psb_prec_short_descr => mld_prec_short_descr - - use mld_prec_mod - - interface psb_precbld - module procedure mld_dprecbld, mld_zprecbld - end interface - - interface psb_precinit - module procedure mld_dprecinit, mld_zprecinit - end interface - - interface psb_precset - module procedure mld_dprecseti, mld_dprecsetd,& - & mld_zprecseti, mld_zprecsetd - end interface - - interface psb_precfree - module procedure mld_dprecfree, mld_zprecfree - end interface - - interface psb_precaply - module procedure mld_dprec_aply, mld_dprec_aply1, & - & mld_zprec_aply, mld_zprec_aply1 - end interface - -#else - use mld_prec_mod, & & psb_sbaseprc_type => mld_sbaseprc_type,& & psb_dbaseprc_type => mld_dbaseprc_type,& @@ -103,7 +59,6 @@ module psb_prec_mod & psb_dprec_type => mld_dprec_type,& & psb_cprec_type => mld_cprec_type,& & psb_zprec_type => mld_zprec_type,& - & psb_base_precfree => mld_base_precfree,& & psb_nullify_baseprec => mld_nullify_baseprec,& & psb_precdescr => mld_precdescr,& & psb_prec_short_descr => mld_prec_short_descr,& @@ -113,8 +68,6 @@ module psb_prec_mod & psb_precset => mld_precset, & & psb_precaply => mld_precaply -#endif - integer, parameter :: psb_noprec_=mld_noprec_, psb_diag_=mld_diag_,& & psb_bjac_=mld_bjac_ diff --git a/mlprec/Makefile b/mlprec/Makefile index 1155f711..25da7f36 100644 --- a/mlprec/Makefile +++ b/mlprec/Makefile @@ -6,32 +6,34 @@ HERE=. FINCLUDES=$(FMFLAG). $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBLIBDIR) -MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o +MODOBJS=mld_prec_type.o mld_prec_mod.o mld_inner_mod.o mld_transfer_mod.o MPFOBJS=mld_saggrmat_raw_asb.o mld_saggrmat_smth_asb.o \ mld_daggrmat_raw_asb.o mld_daggrmat_smth_asb.o \ mld_caggrmat_raw_asb.o mld_caggrmat_smth_asb.o \ mld_zaggrmat_raw_asb.o mld_zaggrmat_smth_asb.o MPCOBJS=mld_sslud_interface.o mld_dslud_interface.o mld_cslud_interface.o mld_zslud_interface.o -INNEROBJS=mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\ - mld_smlprec_bld.o mld_ssp_renum.o mld_sfact_bld.o mld_silu_bld.o \ +INNEROBJS=mld_saggr_bld.o mld_daggr_bld.o \ + mld_caggr_bld.o mld_zaggr_bld.o \ + mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\ + mld_ssp_renum.o mld_sfact_bld.o mld_silu_bld.o \ mld_sbaseprec_bld.o mld_sdiag_bld.o mld_saggrmap_bld.o \ mld_smlprec_aply.o mld_sslud_bld.o\ mld_sbaseprec_aply.o mld_ssub_aply.o mld_ssub_solve.o \ mld_sas_aply.o mld_saggrmat_asb.o \ mld_das_bld.o mld_dslu_bld.o mld_dumf_bld.o mld_dilu0_fact.o\ - mld_dmlprec_bld.o mld_dsp_renum.o mld_dfact_bld.o mld_dilu_bld.o \ + mld_dsp_renum.o mld_dfact_bld.o mld_dilu_bld.o \ mld_dbaseprec_bld.o mld_ddiag_bld.o mld_daggrmap_bld.o \ mld_dmlprec_aply.o mld_dslud_bld.o\ mld_dbaseprec_aply.o mld_dsub_aply.o mld_dsub_solve.o \ mld_das_aply.o mld_daggrmat_asb.o \ mld_cas_bld.o mld_cslu_bld.o mld_cumf_bld.o mld_cilu0_fact.o\ - mld_cmlprec_bld.o mld_csp_renum.o mld_cfact_bld.o mld_cilu_bld.o \ + mld_csp_renum.o mld_cfact_bld.o mld_cilu_bld.o \ mld_cbaseprec_bld.o mld_cdiag_bld.o mld_caggrmap_bld.o \ mld_cmlprec_aply.o mld_cslud_bld.o\ mld_cbaseprec_aply.o mld_csub_aply.o mld_csub_solve.o \ mld_cas_aply.o mld_caggrmat_asb.o\ mld_zas_bld.o mld_zslu_bld.o mld_zumf_bld.o mld_zilu0_fact.o\ - mld_zmlprec_bld.o mld_zsp_renum.o mld_zfact_bld.o mld_zilu_bld.o \ + mld_zsp_renum.o mld_zfact_bld.o mld_zilu_bld.o \ mld_zbaseprec_bld.o mld_zdiag_bld.o mld_zaggrmap_bld.o \ mld_zmlprec_aply.o mld_zslud_bld.o\ mld_zbaseprec_aply.o mld_zsub_aply.o mld_zsub_solve.o \ @@ -39,13 +41,13 @@ INNEROBJS=mld_sas_bld.o mld_sslu_bld.o mld_sumf_bld.o mld_silu0_fact.o\ mld_siluk_fact.o mld_ciluk_fact.o mld_silut_fact.o mld_cilut_fact.o \ mld_diluk_fact.o mld_ziluk_fact.o mld_dilut_fact.o mld_zilut_fact.o \ $(MPFOBJS) -OUTEROBJS=mld_sprecbld.o mld_sprecfree.o mld_sprecset.o mld_sprecinit.o\ +OUTEROBJS=mld_sprecbld.o mld_sprecset.o mld_sprecinit.o\ mld_sprec_aply.o \ - mld_dprecbld.o mld_dprecfree.o mld_dprecset.o mld_dprecinit.o\ + mld_dprecbld.o mld_dprecset.o mld_dprecinit.o\ mld_dprec_aply.o \ - mld_cprecbld.o mld_cprecfree.o mld_cprecset.o mld_cprecinit.o\ + mld_cprecbld.o mld_cprecset.o mld_cprecinit.o\ mld_cprec_aply.o \ - mld_zprecbld.o mld_zprecfree.o mld_zprecset.o mld_zprecinit.o \ + mld_zprecbld.o mld_zprecset.o mld_zprecinit.o \ mld_zprec_aply.o F90OBJS=$(OUTEROBJS) $(INNEROBJS) @@ -67,6 +69,8 @@ lib: mpobjs $(OBJS) $(F90OBJS) $(MPFOBJS): $(MODOBJS:.o=$(.mod)) mld_prec_mod.o mld_innner_mod.o: mld_prec_type.o +mld_inner_mod.o: mld_transfer_mod.o +mld_transfer_mod.o: mld_prec_type.o $(MODOBJS): $(PSBLIBDIR)/psb_base_mod$(.mod) diff --git a/mlprec/mld_caggrmat_asb.f90 b/mlprec/mld_caggrmat_asb.f90 index 0f500205..ed62616f 100644 --- a/mlprec/mld_caggrmat_asb.f90 +++ b/mlprec/mld_caggrmat_asb.f90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_c_onelev_prec_type), input/output. +! p - type(mld_c_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -100,7 +100,7 @@ subroutine mld_caggrmat_asb(a,desc_a,p,info) ! Arguments type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_c_onelev_prec_type), intent(inout), target :: p + type(mld_c_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_caggrmat_raw_asb.F90 b/mlprec/mld_caggrmat_raw_asb.F90 index 6db5f368..57545b80 100644 --- a/mlprec/mld_caggrmat_raw_asb.F90 +++ b/mlprec/mld_caggrmat_raw_asb.F90 @@ -66,7 +66,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_c_onelev_prec_type), input/output. +! p - type(mld_c_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -88,7 +88,7 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info) ! Arguments type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_c_onelev_prec_type), intent(inout), target :: p + type(mld_c_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_caggrmat_smth_asb.F90 b/mlprec/mld_caggrmat_smth_asb.F90 index 94a5ac17..c559c356 100644 --- a/mlprec/mld_caggrmat_smth_asb.F90 +++ b/mlprec/mld_caggrmat_smth_asb.F90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_c_onelev_prec_type), input/output. +! p - type(mld_c_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -105,7 +105,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info) ! Arguments type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_c_onelev_prec_type), intent(inout), target :: p + type(mld_c_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_cbaseprec_bld.f90 b/mlprec/mld_cbaseprec_bld.f90 index fa69616a..269c3a83 100644 --- a/mlprec/mld_cbaseprec_bld.f90 +++ b/mlprec/mld_cbaseprec_bld.f90 @@ -38,7 +38,7 @@ !!$ ! File: mld_cbaseprec_bld.f90 ! -! Subroutine: mld_cbaseprc_bld +! Subroutine: mld_cbaseprec_bld ! Version: complex ! ! This routine builds a 'base preconditioner' related to a matrix A. @@ -68,10 +68,10 @@ ! previously preconditioned, hence some information is reused ! in building the new preconditioner. ! -subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd) +subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod - use mld_inner_mod, mld_protect_name => mld_cbaseprc_bld + use mld_inner_mod, mld_protect_name => mld_cbaseprec_bld Implicit None @@ -211,5 +211,5 @@ subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd) end if return -end subroutine mld_cbaseprc_bld +end subroutine mld_cbaseprec_bld diff --git a/mlprec/mld_cmlprec_aply.f90 b/mlprec/mld_cmlprec_aply.f90 index 57709b06..aad45c0e 100644 --- a/mlprec/mld_cmlprec_aply.f90 +++ b/mlprec/mld_cmlprec_aply.f90 @@ -78,7 +78,7 @@ ! Arguments: ! alpha - complex(psb_spk_), input. ! The scalar alpha. -! precv - type(mld_c_onelev_prec_type), dimension(:), input. +! precv - type(mld_c_interlev_prec_type), dimension(:), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. ! Note that nlev = size(precv) = number of levels. @@ -148,7 +148,7 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_c_onelev_prec_type), intent(in) :: precv(:) + type(mld_c_interlev_prec_type), intent(in) :: precv(:) complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(inout) :: y(:) @@ -341,7 +341,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_c_onelev_prec_type), intent(in) :: precv(:) + type(mld_c_interlev_prec_type), intent(in) :: precv(:) complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(inout) :: y(:) @@ -577,7 +577,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_c_onelev_prec_type), intent(in) :: precv(:) + type(mld_c_interlev_prec_type), intent(in) :: precv(:) complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(inout) :: y(:) @@ -837,7 +837,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_c_onelev_prec_type), intent(in) :: precv(:) + type(mld_c_interlev_prec_type), intent(in) :: precv(:) complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(inout) :: y(:) @@ -1135,7 +1135,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_c_onelev_prec_type), intent(in) :: precv(:) + type(mld_c_interlev_prec_type), intent(in) :: precv(:) complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(inout) :: y(:) diff --git a/mlprec/mld_cmlprec_bld.f90 b/mlprec/mld_cmlprec_bld.f90 index e2da034b..a06744cc 100644 --- a/mlprec/mld_cmlprec_bld.f90 +++ b/mlprec/mld_cmlprec_bld.f90 @@ -69,7 +69,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info) ! Arguments type(psb_cspmat_type), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a - type(mld_c_onelev_prec_type), intent(inout),target :: p + type(mld_c_interlev_prec_type), intent(inout),target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_cprecbld.f90 b/mlprec/mld_cprecbld.f90 index 9f73769d..2674e55c 100644 --- a/mlprec/mld_cprecbld.f90 +++ b/mlprec/mld_cprecbld.f90 @@ -73,13 +73,14 @@ subroutine mld_cprecbld(a,desc_a,p,info) ! Arguments type(psb_cspmat_type), target :: a type(psb_desc_type), intent(in), target :: desc_a - type(mld_cprec_type),intent(inout) :: p + type(mld_cprec_type),intent(inout), target :: p integer, intent(out) :: info !!$ character, intent(in), optional :: upd ! Local Variables - Integer :: err,i,k,ictxt, me,np, err_act, iszv + type(mld_cprec_type) :: t_prec + Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz integer :: ipv(mld_ifpsz_), val integer :: int_err(5) character :: upd_ @@ -129,7 +130,8 @@ subroutine mld_cprecbld(a,desc_a,p,info) ! ! Check to ensure all procs have the same ! - iszv = size(p%precv) + newsz = -1 + iszv = size(p%precv) call psb_bcast(ictxt,iszv) if (iszv /= size(p%precv)) then info=4001 @@ -153,7 +155,6 @@ subroutine mld_cprecbld(a,desc_a,p,info) ! Finest level first; remember to fix base_a and base_desc ! call init_baseprc_av(p%precv(1)%prec,info) - if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_) p%precv(1)%base_a => a p%precv(1)%base_desc => desc_a @@ -187,7 +188,7 @@ subroutine mld_cprecbld(a,desc_a,p,info) &': Inconsistent arguments among processes, resetting.' p%precv(i)%iprcparm(:) = ipv(:) end if - + ! ! Sanity checks on the parameters ! @@ -199,36 +200,8 @@ subroutine mld_cprecbld(a,desc_a,p,info) & mld_distr_mat_,is_distr_ml_coarse_mat) else if (i == iszv) then - ! - ! At the coarsest level, check mld_coarse_solve_ - ! - val = p%precv(i)%iprcparm(mld_coarse_solve_) - select case (val) - case(mld_umf_, mld_slu_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - end if - case(mld_sludist_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1 - end if - - end select + + call check_coarse_lev(p%precv(i)) end if @@ -240,40 +213,110 @@ subroutine mld_cprecbld(a,desc_a,p,info) ! baseprec_bld is called inside mlprec_bld. ! call init_baseprc_av(p%precv(i)%prec,info) - if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,& + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& & p%precv(i-1)%base_desc, p%precv(i),info) if (info /= 0) then - call psb_errpush(4001,name,a_err='Init & build upper level preconditioner') + call psb_errpush(4001,name,a_err='Init upper level preconditioner') goto 9999 endif if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Return from ',i,' call to mlprcbld ',info - end do - ! - ! Check on sizes from level 2 onwards - ! - if (me==0) then - k = iszv+1 - do i=iszv,3,-1 + if (i>2) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then - k=i-1 + newsz=i-1 end if - end do - if (k<=iszv) then - write(debug_unit,*) me,trim(name),& + call psb_bcast(ictxt,newsz) + if (newsz > 0) exit + end if + end do + + if (newsz > 0) then + if (me == 0) then + write(debug_unit,*) trim(name),& &': Warning: aggregates from level ',& - & k, ' to ',iszv,' coincide.' - write(debug_unit,*) me,trim(name),& - &': Maximum recommended NLEV:',k + & newsz + write(debug_unit,*) trim(name),& + &': to level ',& + & iszv + write(debug_unit,*) trim(name),& + &': coincide.' + write(debug_unit,*) trim(name),& + &': Number of levels actually used :',newsz write(debug_unit,*) end if + allocate(t_prec%precv(newsz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='prec reallocation') + goto 9999 + endif + do i=1,newsz-1 + call mld_transfer(p%precv(i),t_prec%precv(i),info) + end do + call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) + do i=newsz+1, iszv + call mld_precfree(p%precv(i),info) + end do + call mld_transfer(t_prec,p,info) + ! Ignore errors from transfer + info = 0 + ! + ! Restart + iszv = newsz + ! Fix the pointers, but the level 1 should + ! be already OK + do i=2, iszv - 1 + p%precv(i)%base_a => p%precv(i)%ac + p%precv(i)%base_desc => p%precv(i)%desc_ac + p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc + p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc + end do + + + i = iszv + call check_coarse_lev(p%precv(i)) + call init_baseprc_av(p%precv(i)%prec,info) + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& + & p%precv(i-1)%base_desc, p%precv(i),info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='coarse rebuild') + goto 9999 + endif end if - - endif + end if + + do i=1, iszv + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Calling mlprcbld at level ',i + select case(p%precv(i)%prec%iprcparm(mld_sub_solve_)) + case(mld_ilu_n_,mld_milu_n_) + call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),& + & 'Level',0,is_legal_ml_lev) + case(mld_ilu_t_) + call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),& + & 'Eps',szero,is_legal_s_fact_thrs) + end select + call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),& + & 'Jacobi sweeps',1,is_legal_jac_sweeps) + + call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,& + & p%precv(i)%prec,info) + + if (info /= 0) then + call psb_errpush(4001,name,a_err='One level preconditioner build.') + goto 9999 + endif + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Return from ',i,' call to mlprcbld ',info + end do + call psb_erractionrestore(err_act) return @@ -307,5 +350,39 @@ contains end subroutine init_baseprc_av + subroutine check_coarse_lev(prec) + type(mld_c_interlev_prec_type) :: prec + + ! + ! At the coarsest level, check mld_coarse_solve_ + ! + val = prec%iprcparm(mld_coarse_solve_) + select case (val) + case(mld_umf_, mld_slu_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + end if + case(mld_sludist_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + prec%prec%iprcparm(mld_smoother_sweeps_) = 1 + end if + end select + end subroutine check_coarse_lev + end subroutine mld_cprecbld diff --git a/mlprec/mld_cprecfree.f90 b/mlprec/mld_cprecfree.f90 index 1fb06335..85dc8f0f 100644 --- a/mlprec/mld_cprecfree.f90 +++ b/mlprec/mld_cprecfree.f90 @@ -76,7 +76,7 @@ subroutine mld_cprecfree(p,info) if (allocated(p%precv)) then do i=1,size(p%precv) - call mld_onelev_precfree(p%precv(i),info) + call mld_precfree(p%precv(i),info) end do deallocate(p%precv) end if diff --git a/mlprec/mld_daggrmat_asb.f90 b/mlprec/mld_daggrmat_asb.f90 index 55df7c27..6f2ba817 100644 --- a/mlprec/mld_daggrmat_asb.f90 +++ b/mlprec/mld_daggrmat_asb.f90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_d_onelev_prec_type), input/output. +! p - type(mld_d_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -100,7 +100,7 @@ subroutine mld_daggrmat_asb(a,desc_a,p,info) ! Arguments type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p + type(mld_d_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_daggrmat_raw_asb.F90 b/mlprec/mld_daggrmat_raw_asb.F90 index c963ee05..f3b50841 100644 --- a/mlprec/mld_daggrmat_raw_asb.F90 +++ b/mlprec/mld_daggrmat_raw_asb.F90 @@ -66,7 +66,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_d_onelev_prec_type), input/output. +! p - type(mld_d_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -88,7 +88,7 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info) ! Arguments type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p + type(mld_d_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_daggrmat_smth_asb.F90 b/mlprec/mld_daggrmat_smth_asb.F90 index c471a0db..2e3b2f98 100644 --- a/mlprec/mld_daggrmat_smth_asb.F90 +++ b/mlprec/mld_daggrmat_smth_asb.F90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_d_onelev_prec_type), input/output. +! p - type(mld_d_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -105,7 +105,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info) ! Arguments type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p + type(mld_d_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_dbaseprec_bld.f90 b/mlprec/mld_dbaseprec_bld.f90 index 0bed4616..ffbc5f6c 100644 --- a/mlprec/mld_dbaseprec_bld.f90 +++ b/mlprec/mld_dbaseprec_bld.f90 @@ -68,10 +68,10 @@ ! previously preconditioned, hence some information is reused ! in building the new preconditioner. ! -subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) +subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod - use mld_inner_mod, mld_protect_name => mld_dbaseprc_bld + use mld_inner_mod, mld_protect_name => mld_dbaseprec_bld Implicit None @@ -211,5 +211,5 @@ subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) end if return -end subroutine mld_dbaseprc_bld +end subroutine mld_dbaseprec_bld diff --git a/mlprec/mld_dmlprec_aply.f90 b/mlprec/mld_dmlprec_aply.f90 index c7001e8b..d668746b 100644 --- a/mlprec/mld_dmlprec_aply.f90 +++ b/mlprec/mld_dmlprec_aply.f90 @@ -78,7 +78,7 @@ ! Arguments: ! alpha - real(psb_dpk_), input. ! The scalar alpha. -! precv - type(mld_d_onelev_prec_type), dimension(:), input. +! precv - type(mld_d_interlev_prec_type), dimension(:), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. ! Note that nlev = size(precv) = number of levels. @@ -148,7 +148,7 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_d_onelev_prec_type), intent(in) :: precv(:) + type(mld_d_interlev_prec_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) @@ -340,7 +340,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_d_onelev_prec_type), intent(in) :: precv(:) + type(mld_d_interlev_prec_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) @@ -575,7 +575,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_d_onelev_prec_type), intent(in) :: precv(:) + type(mld_d_interlev_prec_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) @@ -834,7 +834,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_d_onelev_prec_type), intent(in) :: precv(:) + type(mld_d_interlev_prec_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) @@ -1131,7 +1131,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_d_onelev_prec_type), intent(in) :: precv(:) + type(mld_d_interlev_prec_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) diff --git a/mlprec/mld_dmlprec_bld.f90 b/mlprec/mld_dmlprec_bld.f90 index 863101e5..a013d421 100644 --- a/mlprec/mld_dmlprec_bld.f90 +++ b/mlprec/mld_dmlprec_bld.f90 @@ -70,7 +70,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info) ! Arguments type(psb_dspmat_type), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a - type(mld_d_onelev_prec_type), intent(inout),target :: p + type(mld_d_interlev_prec_type), intent(inout),target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_dprecbld.f90 b/mlprec/mld_dprecbld.f90 index 1ef662d6..29961922 100644 --- a/mlprec/mld_dprecbld.f90 +++ b/mlprec/mld_dprecbld.f90 @@ -67,19 +67,20 @@ subroutine mld_dprecbld(a,desc_a,p,info) use psb_base_mod use mld_inner_mod - use mld_prec_mod, protect => mld_dprecbld - + use mld_prec_mod, mld_protect_name => mld_dprecbld + Implicit None ! Arguments - type(psb_dspmat_type), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_dprec_type),intent(inout) :: p - integer, intent(out) :: info + type(psb_dspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(mld_dprec_type),intent(inout),target :: p + integer, intent(out) :: info !!$ character, intent(in), optional :: upd ! Local Variables - Integer :: err,i,k,ictxt, me,np, err_act, iszv + type(mld_dprec_type) :: t_prec + Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz integer :: ipv(mld_ifpsz_), val integer :: int_err(5) character :: upd_ @@ -129,7 +130,8 @@ subroutine mld_dprecbld(a,desc_a,p,info) ! ! Check to ensure all procs have the same ! - iszv = size(p%precv) + newsz = -1 + iszv = size(p%precv) call psb_bcast(ictxt,iszv) if (iszv /= size(p%precv)) then info=4001 @@ -153,7 +155,6 @@ subroutine mld_dprecbld(a,desc_a,p,info) ! Finest level first; remember to fix base_a and base_desc ! call init_baseprc_av(p%precv(1)%prec,info) - if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_) p%precv(1)%base_a => a p%precv(1)%base_desc => desc_a @@ -187,7 +188,7 @@ subroutine mld_dprecbld(a,desc_a,p,info) &': Inconsistent arguments among processes, resetting.' p%precv(i)%iprcparm(:) = ipv(:) end if - + ! ! Sanity checks on the parameters ! @@ -199,36 +200,8 @@ subroutine mld_dprecbld(a,desc_a,p,info) & mld_distr_mat_,is_distr_ml_coarse_mat) else if (i == iszv) then - ! - ! At the coarsest level, check mld_coarse_solve_ - ! - val = p%precv(i)%iprcparm(mld_coarse_solve_) - select case (val) - case(mld_umf_, mld_slu_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - end if - case(mld_sludist_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1 - end if - - end select + + call check_coarse_lev(p%precv(i)) end if @@ -240,40 +213,110 @@ subroutine mld_dprecbld(a,desc_a,p,info) ! baseprec_bld is called inside mlprec_bld. ! call init_baseprc_av(p%precv(i)%prec,info) - if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,& + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& & p%precv(i-1)%base_desc, p%precv(i),info) if (info /= 0) then - call psb_errpush(4001,name,a_err='Init & build upper level preconditioner') + call psb_errpush(4001,name,a_err='Init upper level preconditioner') goto 9999 endif if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Return from ',i,' call to mlprcbld ',info - end do - ! - ! Check on sizes from level 2 onwards - ! - if (me==0) then - k = iszv+1 - do i=iszv,3,-1 + if (i>2) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then - k=i-1 + newsz=i-1 end if - end do - if (k<=iszv) then - write(debug_unit,*) me,trim(name),& + call psb_bcast(ictxt,newsz) + if (newsz > 0) exit + end if + end do + + if (newsz > 0) then + if (me == 0) then + write(debug_unit,*) trim(name),& &': Warning: aggregates from level ',& - & k, ' to ',iszv,' coincide.' - write(debug_unit,*) me,trim(name),& - &': Maximum recommended NLEV:',k + & newsz + write(debug_unit,*) trim(name),& + &': to level ',& + & iszv + write(debug_unit,*) trim(name),& + &': coincide.' + write(debug_unit,*) trim(name),& + &': Number of levels actually used :',newsz write(debug_unit,*) end if + allocate(t_prec%precv(newsz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='prec reallocation') + goto 9999 + endif + do i=1,newsz-1 + call mld_transfer(p%precv(i),t_prec%precv(i),info) + end do + call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) + do i=newsz+1, iszv + call mld_precfree(p%precv(i),info) + end do + call mld_transfer(t_prec,p,info) + ! Ignore errors from transfer + info = 0 + ! + ! Restart + iszv = newsz + ! Fix the pointers, but the level 1 should + ! be already OK + do i=2, iszv - 1 + p%precv(i)%base_a => p%precv(i)%ac + p%precv(i)%base_desc => p%precv(i)%desc_ac + p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc + p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc + end do + + + i = iszv + call check_coarse_lev(p%precv(i)) + call init_baseprc_av(p%precv(i)%prec,info) + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& + & p%precv(i-1)%base_desc, p%precv(i),info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='coarse rebuild') + goto 9999 + endif end if - - endif + end if + + do i=1, iszv + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Calling mlprcbld at level ',i + select case(p%precv(i)%prec%iprcparm(mld_sub_solve_)) + case(mld_ilu_n_,mld_milu_n_) + call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),& + & 'Level',0,is_legal_ml_lev) + case(mld_ilu_t_) + call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),& + & 'Eps',dzero,is_legal_fact_thrs) + end select + call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),& + & 'Jacobi sweeps',1,is_legal_jac_sweeps) + + call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,& + & p%precv(i)%prec,info) + + if (info /= 0) then + call psb_errpush(4001,name,a_err='One level preconditioner build.') + goto 9999 + endif + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Return from ',i,' call to mlprcbld ',info + end do + call psb_erractionrestore(err_act) return @@ -304,8 +347,42 @@ contains do k=1,size(p%av) call psb_nullify_sp(p%av(k)) end do - + end subroutine init_baseprc_av + subroutine check_coarse_lev(prec) + type(mld_d_interlev_prec_type) :: prec + + ! + ! At the coarsest level, check mld_coarse_solve_ + ! + val = prec%iprcparm(mld_coarse_solve_) + select case (val) + case(mld_umf_, mld_slu_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + end if + case(mld_sludist_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + prec%prec%iprcparm(mld_smoother_sweeps_) = 1 + end if + end select + end subroutine check_coarse_lev + end subroutine mld_dprecbld diff --git a/mlprec/mld_inner_mod.f90 b/mlprec/mld_inner_mod.f90 index 41d76ab2..3c789ee0 100644 --- a/mlprec/mld_inner_mod.f90 +++ b/mlprec/mld_inner_mod.f90 @@ -38,6 +38,7 @@ !!$ module mld_inner_mod use mld_prec_type + use mld_transfer_mod interface mld_baseprec_aply subroutine mld_sbaseprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) @@ -144,9 +145,9 @@ module mld_inner_mod interface mld_mlprec_aply subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type + use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type type(psb_desc_type),intent(in) :: desc_data - type(mld_s_onelev_prec_type), intent(in) :: precv(:) + type(mld_s_interlev_prec_type), intent(in) :: precv(:) real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) @@ -156,9 +157,9 @@ module mld_inner_mod end subroutine mld_smlprec_aply subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type + use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type type(psb_desc_type),intent(in) :: desc_data - type(mld_d_onelev_prec_type), intent(in) :: precv(:) + type(mld_d_interlev_prec_type), intent(in) :: precv(:) real(psb_dpk_),intent(in) :: alpha,beta real(psb_dpk_),intent(in) :: x(:) real(psb_dpk_),intent(inout) :: y(:) @@ -168,9 +169,9 @@ module mld_inner_mod end subroutine mld_dmlprec_aply subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type + use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type type(psb_desc_type),intent(in) :: desc_data - type(mld_c_onelev_prec_type), intent(in) :: baseprecv(:) + type(mld_c_interlev_prec_type), intent(in) :: baseprecv(:) complex(psb_spk_),intent(in) :: alpha,beta complex(psb_spk_),intent(in) :: x(:) complex(psb_spk_),intent(inout) :: y(:) @@ -180,9 +181,9 @@ module mld_inner_mod end subroutine mld_cmlprec_aply subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info) use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type + use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type type(psb_desc_type),intent(in) :: desc_data - type(mld_z_onelev_prec_type), intent(in) :: baseprecv(:) + type(mld_z_interlev_prec_type), intent(in) :: baseprecv(:) complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) @@ -383,6 +384,41 @@ module mld_inner_mod end subroutine mld_zsp_renum end interface + interface mld_aggr_bld + subroutine mld_saggr_bld(a,desc_a,p,info) + use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ + use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(mld_s_interlev_prec_type), intent(inout), target :: p + integer, intent(out) :: info + end subroutine mld_saggr_bld + subroutine mld_daggr_bld(a,desc_a,p,info) + use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ + use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(mld_d_interlev_prec_type), intent(inout), target :: p + integer, intent(out) :: info + end subroutine mld_daggr_bld + subroutine mld_caggr_bld(a,desc_a,p,info) + use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ + use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(mld_c_interlev_prec_type), intent(inout), target :: p + integer, intent(out) :: info + end subroutine mld_caggr_bld + subroutine mld_zaggr_bld(a,desc_a,p,info) + use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ + use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + type(mld_z_interlev_prec_type), intent(inout), target :: p + integer, intent(out) :: info + end subroutine mld_zaggr_bld + end interface + interface mld_aggrmap_bld subroutine mld_saggrmap_bld(aggr_type,theta,a,desc_a,nlaggr,ilaggr,info) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ @@ -429,34 +465,34 @@ module mld_inner_mod interface mld_aggrmat_asb subroutine mld_saggrmat_asb(a,desc_a,p,info) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type + use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p + type(mld_s_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_saggrmat_asb subroutine mld_daggrmat_asb(a,desc_a,p,info) use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type + use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p + type(mld_d_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_daggrmat_asb subroutine mld_caggrmat_asb(a,desc_a,p,info) use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type + use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_c_onelev_prec_type), intent(inout), target :: p + type(mld_c_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_caggrmat_asb subroutine mld_zaggrmat_asb(a,desc_a,p,info) use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type + use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_z_onelev_prec_type), intent(inout), target :: p + type(mld_z_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_zaggrmat_asb end interface @@ -464,34 +500,34 @@ module mld_inner_mod interface mld_aggrmat_raw_asb subroutine mld_saggrmat_raw_asb(a,desc_a,p,info) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type + use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p + type(mld_s_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_saggrmat_raw_asb subroutine mld_daggrmat_raw_asb(a,desc_a,p,info) use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type + use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p + type(mld_d_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_daggrmat_raw_asb subroutine mld_caggrmat_raw_asb(a,desc_a,p,info) use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type + use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_c_onelev_prec_type), intent(inout), target :: p + type(mld_c_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_caggrmat_raw_asb subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info) use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type + use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_z_onelev_prec_type), intent(inout), target :: p + type(mld_z_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_zaggrmat_raw_asb end interface @@ -499,40 +535,40 @@ module mld_inner_mod interface mld_aggrmat_smth_asb subroutine mld_saggrmat_smth_asb(a,desc_a,p,info) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type + use mld_prec_type, only : mld_sbaseprc_type, mld_s_interlev_prec_type type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p + type(mld_s_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_saggrmat_smth_asb subroutine mld_daggrmat_smth_asb(a,desc_a,p,info) use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type + use mld_prec_type, only : mld_dbaseprc_type, mld_d_interlev_prec_type type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p + type(mld_d_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_daggrmat_smth_asb subroutine mld_caggrmat_smth_asb(a,desc_a,p,info) use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type + use mld_prec_type, only : mld_cbaseprc_type, mld_c_interlev_prec_type type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_c_onelev_prec_type), intent(inout), target :: p + type(mld_c_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_caggrmat_smth_asb subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info) use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type + use mld_prec_type, only : mld_zbaseprc_type, mld_z_interlev_prec_type type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_z_onelev_prec_type), intent(inout), target :: p + type(mld_z_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info end subroutine mld_zaggrmat_smth_asb end interface - interface mld_baseprc_bld - subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd) + interface mld_baseprec_bld + subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ use mld_prec_type, only : mld_sbaseprc_type type(psb_sspmat_type), target :: a @@ -540,8 +576,8 @@ module mld_inner_mod type(mld_sbaseprc_type),intent(inout) :: p integer, intent(out) :: info character, intent(in), optional :: upd - end subroutine mld_sbaseprc_bld - subroutine mld_dbaseprc_bld(a,desc_a,p,info,upd) + end subroutine mld_sbaseprec_bld + subroutine mld_dbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ use mld_prec_type, only : mld_dbaseprc_type type(psb_dspmat_type), target :: a @@ -549,8 +585,8 @@ module mld_inner_mod type(mld_dbaseprc_type),intent(inout) :: p integer, intent(out) :: info character, intent(in), optional :: upd - end subroutine mld_dbaseprc_bld - subroutine mld_cbaseprc_bld(a,desc_a,p,info,upd) + end subroutine mld_dbaseprec_bld + subroutine mld_cbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ use mld_prec_type, only : mld_cbaseprc_type type(psb_cspmat_type), target :: a @@ -558,8 +594,8 @@ module mld_inner_mod type(mld_cbaseprc_type),intent(inout) :: p integer, intent(out) :: info character, intent(in), optional :: upd - end subroutine mld_cbaseprc_bld - subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) + end subroutine mld_cbaseprec_bld + subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ use mld_prec_type, only : mld_zbaseprc_type type(psb_zspmat_type), target :: a @@ -567,7 +603,7 @@ module mld_inner_mod type(mld_zbaseprc_type),intent(inout) :: p integer, intent(out) :: info character, intent(in), optional :: upd - end subroutine mld_zbaseprc_bld + end subroutine mld_zbaseprec_bld end interface interface mld_as_bld @@ -609,41 +645,6 @@ module mld_inner_mod end subroutine mld_zas_bld end interface - interface mld_mlprec_bld - subroutine mld_smlprec_bld(a,desc_a,p,info) - use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_sbaseprc_type, mld_s_onelev_prec_type - type(psb_sspmat_type), intent(inout), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p - integer, intent(out) :: info - end subroutine mld_smlprec_bld - subroutine mld_dmlprec_bld(a,desc_a,p,info) - use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_dbaseprc_type, mld_d_onelev_prec_type - type(psb_dspmat_type), intent(inout), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_d_onelev_prec_type), intent(inout), target :: p - integer, intent(out) :: info - end subroutine mld_dmlprec_bld - subroutine mld_cmlprec_bld(a,desc_a,p,info) - use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_cbaseprc_type, mld_c_onelev_prec_type - type(psb_cspmat_type), intent(inout), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_c_onelev_prec_type), intent(inout),target :: p - integer, intent(out) :: info - end subroutine mld_cmlprec_bld - subroutine mld_zmlprec_bld(a,desc_a,p,info) - use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_zbaseprc_type, mld_z_onelev_prec_type - type(psb_zspmat_type), intent(inout), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_z_onelev_prec_type), intent(inout),target :: p - integer, intent(out) :: info - end subroutine mld_zmlprec_bld - end interface - interface mld_diag_bld subroutine mld_sdiag_bld(a,desc_data,p,info) use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ diff --git a/mlprec/mld_prec_mod.f90 b/mlprec/mld_prec_mod.f90 index a618281a..2541a37e 100644 --- a/mlprec/mld_prec_mod.f90 +++ b/mlprec/mld_prec_mod.f90 @@ -199,33 +199,33 @@ module mld_prec_mod integer, optional, intent(in) :: ilev end subroutine mld_zprecsetc end interface - - interface mld_precfree - subroutine mld_sprecfree(p,info) - use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_sprec_type - type(mld_sprec_type), intent(inout) :: p - integer, intent(out) :: info - end subroutine mld_sprecfree - subroutine mld_dprecfree(p,info) - use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_dprec_type - type(mld_dprec_type), intent(inout) :: p - integer, intent(out) :: info - end subroutine mld_dprecfree - subroutine mld_cprecfree(p,info) - use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ - use mld_prec_type, only : mld_cprec_type - type(mld_cprec_type), intent(inout) :: p - integer, intent(out) :: info - end subroutine mld_cprecfree - subroutine mld_zprecfree(p,info) - use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ - use mld_prec_type, only : mld_zprec_type - type(mld_zprec_type), intent(inout) :: p - integer, intent(out) :: info - end subroutine mld_zprecfree - end interface +!!$ +!!$ interface mld_precfree +!!$ subroutine mld_sprecfree(p,info) +!!$ use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ +!!$ use mld_prec_type, only : mld_sprec_type +!!$ type(mld_sprec_type), intent(inout) :: p +!!$ integer, intent(out) :: info +!!$ end subroutine mld_sprecfree +!!$ subroutine mld_dprecfree(p,info) +!!$ use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ +!!$ use mld_prec_type, only : mld_dprec_type +!!$ type(mld_dprec_type), intent(inout) :: p +!!$ integer, intent(out) :: info +!!$ end subroutine mld_dprecfree +!!$ subroutine mld_cprecfree(p,info) +!!$ use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ +!!$ use mld_prec_type, only : mld_cprec_type +!!$ type(mld_cprec_type), intent(inout) :: p +!!$ integer, intent(out) :: info +!!$ end subroutine mld_cprecfree +!!$ subroutine mld_zprecfree(p,info) +!!$ use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_ +!!$ use mld_prec_type, only : mld_zprec_type +!!$ type(mld_zprec_type), intent(inout) :: p +!!$ integer, intent(out) :: info +!!$ end subroutine mld_zprecfree +!!$ end interface interface mld_precaply subroutine mld_sprec_aply(prec,x,y,desc_data,info,trans,work) @@ -315,30 +315,30 @@ module mld_prec_mod use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_ use mld_prec_type, only : mld_sprec_type implicit none - type(psb_sspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_sprec_type), intent(inout) :: prec - integer, intent(out) :: info + type(psb_sspmat_type), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(mld_sprec_type), intent(inout), target :: prec + integer, intent(out) :: info !!$ character, intent(in),optional :: upd end subroutine mld_sprecbld subroutine mld_dprecbld(a,desc_a,prec,info) use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_ use mld_prec_type, only : mld_dprec_type implicit none - type(psb_dspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_dprec_type), intent(inout) :: prec - integer, intent(out) :: info + type(psb_dspmat_type), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(mld_dprec_type), intent(inout), target :: prec + integer, intent(out) :: info !!$ character, intent(in),optional :: upd end subroutine mld_dprecbld subroutine mld_cprecbld(a,desc_a,prec,info) use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_ use mld_prec_type, only : mld_cprec_type implicit none - type(psb_cspmat_type), intent(in), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_cprec_type), intent(inout) :: prec - integer, intent(out) :: info + type(psb_cspmat_type), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(mld_cprec_type), intent(inout), target :: prec + integer, intent(out) :: info !!$ character, intent(in),optional :: upd end subroutine mld_cprecbld subroutine mld_zprecbld(a,desc_a,prec,info) diff --git a/mlprec/mld_prec_type.f90 b/mlprec/mld_prec_type.f90 index b6857833..a8c5a030 100644 --- a/mlprec/mld_prec_type.f90 +++ b/mlprec/mld_prec_type.f90 @@ -91,14 +91,14 @@ module mld_prec_type ! one, i.e. level 1 is the finest level and A(1) is the matrix A. ! !| type mld_Xprec_type - !| type(mld_X_onelev_prec_type), allocatable :: precv(:) + !| type(mld_X_interlev_prec_type), allocatable :: precv(:) !| end type mld_Xprec_type !| ! ! precv(ilev) is the preconditioner at level ilev. ! The number of levels is given by size(precv(:)). ! - ! Type: mld_X_onelev_prec_type. + ! Type: mld_X_interlev_prec_type. ! The data type containing necessary items for the current level. ! ! type(mld_Xbaseprc_type) - prec @@ -175,7 +175,7 @@ module mld_prec_type integer, allocatable :: perm(:), invperm(:) end type mld_sbaseprc_type - type mld_s_onelev_prec_type + type mld_s_interlev_prec_type type(mld_sbaseprc_type) :: prec integer, allocatable :: iprcparm(:) real(psb_spk_), allocatable :: rprcparm(:) @@ -185,10 +185,10 @@ module mld_prec_type type(psb_sspmat_type), pointer :: base_a => null() type(psb_desc_type), pointer :: base_desc => null() type(psb_linear_map_type) :: map_desc - end type mld_s_onelev_prec_type + end type mld_s_interlev_prec_type type mld_sprec_type - type(mld_s_onelev_prec_type), allocatable :: precv(:) + type(mld_s_interlev_prec_type), allocatable :: precv(:) end type mld_sprec_type type mld_dbaseprc_type @@ -200,7 +200,7 @@ module mld_prec_type integer, allocatable :: perm(:), invperm(:) end type mld_dbaseprc_type - type mld_d_onelev_prec_type + type mld_d_interlev_prec_type type(mld_dbaseprc_type) :: prec integer, allocatable :: iprcparm(:) real(psb_dpk_), allocatable :: rprcparm(:) @@ -210,10 +210,10 @@ module mld_prec_type type(psb_dspmat_type), pointer :: base_a => null() type(psb_desc_type), pointer :: base_desc => null() type(psb_linear_map_type) :: map_desc - end type mld_d_onelev_prec_type + end type mld_d_interlev_prec_type type mld_dprec_type - type(mld_d_onelev_prec_type), allocatable :: precv(:) + type(mld_d_interlev_prec_type), allocatable :: precv(:) end type mld_dprec_type @@ -226,7 +226,7 @@ module mld_prec_type integer, allocatable :: perm(:), invperm(:) end type mld_cbaseprc_type - type mld_c_onelev_prec_type + type mld_c_interlev_prec_type type(mld_cbaseprc_type) :: prec integer, allocatable :: iprcparm(:) real(psb_spk_), allocatable :: rprcparm(:) @@ -236,10 +236,10 @@ module mld_prec_type type(psb_cspmat_type), pointer :: base_a => null() type(psb_desc_type), pointer :: base_desc => null() type(psb_linear_map_type) :: map_desc - end type mld_c_onelev_prec_type + end type mld_c_interlev_prec_type type mld_cprec_type - type(mld_c_onelev_prec_type), allocatable :: precv(:) + type(mld_c_interlev_prec_type), allocatable :: precv(:) end type mld_cprec_type type mld_zbaseprc_type @@ -251,7 +251,7 @@ module mld_prec_type integer, allocatable :: perm(:), invperm(:) end type mld_zbaseprc_type - type mld_z_onelev_prec_type + type mld_z_interlev_prec_type type(mld_zbaseprc_type) :: prec integer, allocatable :: iprcparm(:) real(psb_dpk_), allocatable :: rprcparm(:) @@ -261,10 +261,10 @@ module mld_prec_type type(psb_zspmat_type), pointer :: base_a => null() type(psb_desc_type), pointer :: base_desc => null() type(psb_linear_map_type) :: map_desc - end type mld_z_onelev_prec_type + end type mld_z_interlev_prec_type type mld_zprec_type - type(mld_z_onelev_prec_type), allocatable :: precv(:) + type(mld_z_interlev_prec_type), allocatable :: precv(:) end type mld_zprec_type @@ -411,14 +411,13 @@ module mld_prec_type ! for printing its description and for deallocating its data structure ! - interface mld_base_precfree + interface mld_precfree module procedure mld_sbase_precfree, mld_cbase_precfree,& - & mld_dbase_precfree, mld_zbase_precfree - end interface - - interface mld_onelev_precfree - module procedure mld_s_onelev_precfree, mld_d_onelev_precfree, & - & mld_c_onelev_precfree, mld_z_onelev_precfree + & mld_dbase_precfree, mld_zbase_precfree, & + & mld_s_onelev_precfree, mld_d_onelev_precfree, & + & mld_c_onelev_precfree, mld_z_onelev_precfree, & + & mld_sprec_free, mld_dprec_free, & + & mld_cprec_free, mld_zprec_free end interface interface mld_nullify_baseprec @@ -435,6 +434,7 @@ module mld_prec_type module procedure mld_icheck_def, mld_scheck_def, mld_dcheck_def end interface + interface mld_precdescr module procedure mld_file_prec_descr, & & mld_zfile_prec_descr,& @@ -457,7 +457,6 @@ module mld_prec_type contains - ! ! Subroutine: mld_stringval ! @@ -755,7 +754,7 @@ contains function mld_s_onelev_prec_sizeof(prec) result(val) implicit none - type(mld_s_onelev_prec_type), intent(in) :: prec + type(mld_s_interlev_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val integer :: i @@ -772,7 +771,7 @@ contains function mld_d_onelev_prec_sizeof(prec) result(val) implicit none - type(mld_d_onelev_prec_type), intent(in) :: prec + type(mld_d_interlev_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val integer :: i @@ -789,7 +788,7 @@ contains function mld_c_onelev_prec_sizeof(prec) result(val) implicit none - type(mld_c_onelev_prec_type), intent(in) :: prec + type(mld_c_interlev_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val integer :: i @@ -806,7 +805,7 @@ contains function mld_z_onelev_prec_sizeof(prec) result(val) implicit none - type(mld_z_onelev_prec_type), intent(in) :: prec + type(mld_z_interlev_prec_type), intent(in) :: prec integer(psb_long_int_k_) :: val integer :: i @@ -1859,16 +1858,11 @@ contains endif if (allocated(p%iprcparm)) then - if (p%iprcparm(mld_sub_solve_)==mld_slu_) then -!!$ call mld_sslu_free(p%iprcparm(mld_slu_ptr_),info) + if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then + if (p%iprcparm(mld_sub_solve_)==mld_slu_) then + call mld_sslu_free(p%iprcparm(mld_slu_ptr_),info) + end if end if -!!$ if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then -!!$ call mld_ssludist_free(p%iprcparm(mld_slud_ptr_),info) -!!$ end if -!!$ if (p%iprcparm(mld_sub_solve_)==mld_umf_) then -!!$ call mld_dumf_free(p%iprcparm(mld_umf_symptr_),& -!!$ & p%iprcparm(mld_umf_numptr_),info) -!!$ end if deallocate(p%iprcparm,stat=info) end if call mld_nullify_baseprec(p) @@ -1878,7 +1872,7 @@ contains subroutine mld_s_onelev_precfree(p,info) implicit none - type(mld_s_onelev_prec_type), intent(inout) :: p + type(mld_s_interlev_prec_type), intent(inout) :: p integer, intent(out) :: info integer :: i @@ -1886,7 +1880,7 @@ contains ! Actually we might just deallocate the top level array, except ! for the inner UMFPACK or SLU stuff - call mld_base_precfree(p%prec,info) + call mld_precfree(p%prec,info) call psb_sp_free(p%ac,info) if (allocated(p%desc_ac%matrix_data)) & @@ -1921,7 +1915,7 @@ contains subroutine mld_nullify_s_onelevprec(p) implicit none - type(mld_s_onelev_prec_type), intent(inout) :: p + type(mld_s_interlev_prec_type), intent(inout) :: p nullify(p%base_a) nullify(p%base_desc) @@ -1983,15 +1977,17 @@ contains endif if (allocated(p%iprcparm)) then - if (p%iprcparm(mld_sub_solve_)==mld_slu_) then - call mld_dslu_free(p%iprcparm(mld_slu_ptr_),info) - end if - if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then - call mld_dsludist_free(p%iprcparm(mld_slud_ptr_),info) - end if - if (p%iprcparm(mld_sub_solve_)==mld_umf_) then - call mld_dumf_free(p%iprcparm(mld_umf_symptr_),& - & p%iprcparm(mld_umf_numptr_),info) + if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then + if (p%iprcparm(mld_sub_solve_)==mld_slu_) then + call mld_dslu_free(p%iprcparm(mld_slu_ptr_),info) + end if + if (p%iprcparm(mld_sub_solve_)==mld_sludist_) then + call mld_dsludist_free(p%iprcparm(mld_slud_ptr_),info) + end if + if (p%iprcparm(mld_sub_solve_)==mld_umf_) then + call mld_dumf_free(p%iprcparm(mld_umf_symptr_),& + & p%iprcparm(mld_umf_numptr_),info) + end if end if deallocate(p%iprcparm,stat=info) end if @@ -2001,7 +1997,7 @@ contains subroutine mld_d_onelev_precfree(p,info) implicit none - type(mld_d_onelev_prec_type), intent(inout) :: p + type(mld_d_interlev_prec_type), intent(inout) :: p integer, intent(out) :: info integer :: i @@ -2009,7 +2005,7 @@ contains ! Actually we might just deallocate the top level array, except ! for the inner UMFPACK or SLU stuff - call mld_base_precfree(p%prec,info) + call mld_precfree(p%prec,info) call psb_sp_free(p%ac,info) if (allocated(p%desc_ac%matrix_data)) & @@ -2053,7 +2049,7 @@ contains subroutine mld_nullify_d_onelevprec(p) implicit none - type(mld_d_onelev_prec_type), intent(inout) :: p + type(mld_d_interlev_prec_type), intent(inout) :: p nullify(p%base_a) nullify(p%base_desc) @@ -2100,13 +2096,11 @@ contains endif if (allocated(p%iprcparm)) then - if (p%iprcparm(mld_sub_solve_)==mld_slu_) then -!!$ call mld_cslu_free(p%iprcparm(mld_slu_ptr_),info) + if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then + if (p%iprcparm(mld_sub_solve_)==mld_slu_) then + call mld_cslu_free(p%iprcparm(mld_slu_ptr_),info) + end if end if -!!$ if (p%iprcparm(mld_sub_solve_)==mld_umf_) then -!!$ call mld_zumf_free(p%iprcparm(mld_umf_symptr_),& -!!$ & p%iprcparm(mld_umf_numptr_),info) -!!$ end if deallocate(p%iprcparm,stat=info) end if call mld_nullify_baseprec(p) @@ -2115,7 +2109,7 @@ contains subroutine mld_c_onelev_precfree(p,info) implicit none - type(mld_c_onelev_prec_type), intent(inout) :: p + type(mld_c_interlev_prec_type), intent(inout) :: p integer, intent(out) :: info integer :: i @@ -2123,7 +2117,7 @@ contains ! Actually we might just deallocate the top level array, except ! for the inner UMFPACK or SLU stuff - call mld_base_precfree(p%prec,info) + call mld_precfree(p%prec,info) call psb_sp_free(p%ac,info) if (allocated(p%desc_ac%matrix_data)) & @@ -2157,7 +2151,7 @@ contains subroutine mld_nullify_c_onelevprec(p) implicit none - type(mld_c_onelev_prec_type), intent(inout) :: p + type(mld_c_interlev_prec_type), intent(inout) :: p nullify(p%base_a) nullify(p%base_desc) @@ -2213,13 +2207,15 @@ contains deallocate(p%invperm,stat=info) endif - if (allocated(p%iprcparm)) then - if (p%iprcparm(mld_sub_solve_)==mld_slu_) then - call mld_zslu_free(p%iprcparm(mld_slu_ptr_),info) - end if - if (p%iprcparm(mld_sub_solve_)==mld_umf_) then - call mld_zumf_free(p%iprcparm(mld_umf_symptr_),& - & p%iprcparm(mld_umf_numptr_),info) + if (allocated(p%iprcparm)) then + if (p%iprcparm(mld_prec_status_) == mld_prec_built_) then + if (p%iprcparm(mld_sub_solve_)==mld_slu_) then + call mld_zslu_free(p%iprcparm(mld_slu_ptr_),info) + end if + if (p%iprcparm(mld_sub_solve_)==mld_umf_) then + call mld_zumf_free(p%iprcparm(mld_umf_symptr_),& + & p%iprcparm(mld_umf_numptr_),info) + end if end if deallocate(p%iprcparm,stat=info) end if @@ -2229,7 +2225,7 @@ contains subroutine mld_z_onelev_precfree(p,info) implicit none - type(mld_z_onelev_prec_type), intent(inout) :: p + type(mld_z_interlev_prec_type), intent(inout) :: p integer, intent(out) :: info integer :: i @@ -2237,7 +2233,7 @@ contains ! Actually we might just deallocate the top level array, except ! for the inner UMFPACK or SLU stuff - call mld_base_precfree(p%prec,info) + call mld_precfree(p%prec,info) call psb_sp_free(p%ac,info) if (allocated(p%desc_ac%matrix_data)) & @@ -2271,7 +2267,7 @@ contains subroutine mld_nullify_z_onelevprec(p) implicit none - type(mld_z_onelev_prec_type), intent(inout) :: p + type(mld_z_interlev_prec_type), intent(inout) :: p nullify(p%base_a) nullify(p%base_desc) @@ -2309,4 +2305,166 @@ contains end function pr_to_str + subroutine mld_sprec_free(p,info) + + use psb_base_mod + + implicit none + + ! Arguments + type(mld_sprec_type), intent(inout) :: p + integer, intent(out) :: info + + ! Local variables + integer :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'mld_dprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(p%precv)) then + do i=1,size(p%precv) + call mld_precfree(p%precv(i),info) + end do + deallocate(p%precv) + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine mld_sprec_free + + subroutine mld_dprec_free(p,info) + + use psb_base_mod + + implicit none + + ! Arguments + type(mld_dprec_type), intent(inout) :: p + integer, intent(out) :: info + + ! Local variables + integer :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'mld_dprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(p%precv)) then + do i=1,size(p%precv) + call mld_precfree(p%precv(i),info) + end do + deallocate(p%precv) + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine mld_dprec_free + + subroutine mld_cprec_free(p,info) + + use psb_base_mod + + implicit none + + ! Arguments + type(mld_cprec_type), intent(inout) :: p + integer, intent(out) :: info + + ! Local variables + integer :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'mld_dprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(p%precv)) then + do i=1,size(p%precv) + call mld_precfree(p%precv(i),info) + end do + deallocate(p%precv) + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine mld_cprec_free + + + subroutine mld_zprec_free(p,info) + + use psb_base_mod + + implicit none + + ! Arguments + type(mld_zprec_type), intent(inout) :: p + integer, intent(out) :: info + + ! Local variables + integer :: me,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'mld_dprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(p%precv)) then + do i=1,size(p%precv) + call mld_precfree(p%precv(i),info) + end do + deallocate(p%precv) + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.psb_act_abort_) then + call psb_error() + return + end if + return + + end subroutine mld_zprec_free + + end module mld_prec_type diff --git a/mlprec/mld_saggrmat_asb.f90 b/mlprec/mld_saggrmat_asb.f90 index e4f42249..58601219 100644 --- a/mlprec/mld_saggrmat_asb.f90 +++ b/mlprec/mld_saggrmat_asb.f90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_s_onelev_prec_type), input/output. +! p - type(mld_s_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -100,7 +100,7 @@ subroutine mld_saggrmat_asb(a,desc_a,p,info) ! Arguments type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p + type(mld_s_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_saggrmat_raw_asb.F90 b/mlprec/mld_saggrmat_raw_asb.F90 index 6cc2d942..b2aa0bfb 100644 --- a/mlprec/mld_saggrmat_raw_asb.F90 +++ b/mlprec/mld_saggrmat_raw_asb.F90 @@ -66,7 +66,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_s_onelev_prec_type), input/output. +! p - type(mld_s_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -88,7 +88,7 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info) ! Arguments type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p + type(mld_s_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_saggrmat_smth_asb.F90 b/mlprec/mld_saggrmat_smth_asb.F90 index f6c695ef..bccb8003 100644 --- a/mlprec/mld_saggrmat_smth_asb.F90 +++ b/mlprec/mld_saggrmat_smth_asb.F90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_s_onelev_prec_type), input/output. +! p - type(mld_s_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -105,7 +105,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info) ! Arguments type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_s_onelev_prec_type), intent(inout), target :: p + type(mld_s_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_sbaseprec_bld.f90 b/mlprec/mld_sbaseprec_bld.f90 index 3e47911b..3d23069a 100644 --- a/mlprec/mld_sbaseprec_bld.f90 +++ b/mlprec/mld_sbaseprec_bld.f90 @@ -38,7 +38,7 @@ !!$ ! File: mld_sbaseprec_bld.f90 ! -! Subroutine: mld_sbaseprc_bld +! Subroutine: mld_sbaseprec_bld ! Version: real ! ! This routine builds a 'base preconditioner' related to a matrix A. @@ -68,10 +68,10 @@ ! previously preconditioned, hence some information is reused ! in building the new preconditioner. ! -subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd) +subroutine mld_sbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod - use mld_inner_mod, mld_protect_name => mld_sbaseprc_bld + use mld_inner_mod, mld_protect_name => mld_sbaseprec_bld Implicit None @@ -211,5 +211,5 @@ subroutine mld_sbaseprc_bld(a,desc_a,p,info,upd) end if return -end subroutine mld_sbaseprc_bld +end subroutine mld_sbaseprec_bld diff --git a/mlprec/mld_smlprec_aply.f90 b/mlprec/mld_smlprec_aply.f90 index 13f17fd7..582dcbec 100644 --- a/mlprec/mld_smlprec_aply.f90 +++ b/mlprec/mld_smlprec_aply.f90 @@ -78,7 +78,7 @@ ! Arguments: ! alpha - real(psb_spk_), input. ! The scalar alpha. -! precv - type(mld_s_onelev_prec_type), dimension(:), input. +! precv - type(mld_s_interlev_prec_type), dimension(:), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. ! Note that nlev = size(precv) = number of levels. @@ -148,7 +148,7 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_s_onelev_prec_type), intent(in) :: precv(:) + type(mld_s_interlev_prec_type), intent(in) :: precv(:) real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) @@ -340,7 +340,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_s_onelev_prec_type), intent(in) :: precv(:) + type(mld_s_interlev_prec_type), intent(in) :: precv(:) real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) @@ -575,7 +575,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_s_onelev_prec_type), intent(in) :: precv(:) + type(mld_s_interlev_prec_type), intent(in) :: precv(:) real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) @@ -834,7 +834,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_s_onelev_prec_type), intent(in) :: precv(:) + type(mld_s_interlev_prec_type), intent(in) :: precv(:) real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) @@ -1131,7 +1131,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_s_onelev_prec_type), intent(in) :: precv(:) + type(mld_s_interlev_prec_type), intent(in) :: precv(:) real(psb_spk_),intent(in) :: alpha,beta real(psb_spk_),intent(in) :: x(:) real(psb_spk_),intent(inout) :: y(:) diff --git a/mlprec/mld_smlprec_bld.f90 b/mlprec/mld_smlprec_bld.f90 index b5f1feef..9ec5060a 100644 --- a/mlprec/mld_smlprec_bld.f90 +++ b/mlprec/mld_smlprec_bld.f90 @@ -70,7 +70,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info) ! Arguments type(psb_sspmat_type), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a - type(mld_s_onelev_prec_type), intent(inout),target :: p + type(mld_s_interlev_prec_type), intent(inout),target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_sprecbld.f90 b/mlprec/mld_sprecbld.f90 index 3f67c589..4baae6a5 100644 --- a/mlprec/mld_sprecbld.f90 +++ b/mlprec/mld_sprecbld.f90 @@ -67,19 +67,20 @@ subroutine mld_sprecbld(a,desc_a,p,info) use psb_base_mod use mld_inner_mod - use mld_prec_mod, protect => mld_sprecbld + use mld_prec_mod, mld_protect_name => mld_sprecbld Implicit None ! Arguments - type(psb_sspmat_type), target :: a - type(psb_desc_type), intent(in), target :: desc_a - type(mld_sprec_type),intent(inout) :: p - integer, intent(out) :: info + type(psb_sspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(mld_sprec_type),intent(inout), target :: p + integer, intent(out) :: info !!$ character, intent(in), optional :: upd ! Local Variables - Integer :: err,i,k,ictxt, me,np, err_act, iszv + type(mld_sprec_type) :: t_prec + Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz integer :: ipv(mld_ifpsz_), val integer :: int_err(5) character :: upd_ @@ -129,7 +130,8 @@ subroutine mld_sprecbld(a,desc_a,p,info) ! ! Check to ensure all procs have the same ! - iszv = size(p%precv) + newsz = -1 + iszv = size(p%precv) call psb_bcast(ictxt,iszv) if (iszv /= size(p%precv)) then info=4001 @@ -153,7 +155,6 @@ subroutine mld_sprecbld(a,desc_a,p,info) ! Finest level first; remember to fix base_a and base_desc ! call init_baseprc_av(p%precv(1)%prec,info) - if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_) p%precv(1)%base_a => a p%precv(1)%base_desc => desc_a @@ -187,7 +188,7 @@ subroutine mld_sprecbld(a,desc_a,p,info) &': Inconsistent arguments among processes, resetting.' p%precv(i)%iprcparm(:) = ipv(:) end if - + ! ! Sanity checks on the parameters ! @@ -199,36 +200,8 @@ subroutine mld_sprecbld(a,desc_a,p,info) & mld_distr_mat_,is_distr_ml_coarse_mat) else if (i == iszv) then - ! - ! At the coarsest level, check mld_coarse_solve_ - ! - val = p%precv(i)%iprcparm(mld_coarse_solve_) - select case (val) - case(mld_umf_, mld_slu_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - end if - case(mld_sludist_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1 - end if - - end select + + call check_coarse_lev(p%precv(i)) end if @@ -240,40 +213,110 @@ subroutine mld_sprecbld(a,desc_a,p,info) ! baseprec_bld is called inside mlprec_bld. ! call init_baseprc_av(p%precv(i)%prec,info) - if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,& + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& & p%precv(i-1)%base_desc, p%precv(i),info) if (info /= 0) then - call psb_errpush(4001,name,a_err='Init & build upper level preconditioner') + call psb_errpush(4001,name,a_err='Init upper level preconditioner') goto 9999 endif if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Return from ',i,' call to mlprcbld ',info - end do - ! - ! Check on sizes from level 2 onwards - ! - if (me==0) then - k = iszv+1 - do i=iszv,3,-1 + if (i>2) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then - k=i-1 + newsz=i-1 end if - end do - if (k<=iszv) then - write(debug_unit,*) me,trim(name),& + call psb_bcast(ictxt,newsz) + if (newsz > 0) exit + end if + end do + + if (newsz > 0) then + if (me == 0) then + write(debug_unit,*) trim(name),& &': Warning: aggregates from level ',& - & k, ' to ',iszv,' coincide.' - write(debug_unit,*) me,trim(name),& - &': Maximum recommended NLEV:',k + & newsz + write(debug_unit,*) trim(name),& + &': to level ',& + & iszv + write(debug_unit,*) trim(name),& + &': coincide.' + write(debug_unit,*) trim(name),& + &': Number of levels actually used :',newsz write(debug_unit,*) end if + allocate(t_prec%precv(newsz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='prec reallocation') + goto 9999 + endif + do i=1,newsz-1 + call mld_transfer(p%precv(i),t_prec%precv(i),info) + end do + call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) + do i=newsz+1, iszv + call mld_precfree(p%precv(i),info) + end do + call mld_transfer(t_prec,p,info) + ! Ignore errors from transfer + info = 0 + ! + ! Restart + iszv = newsz + ! Fix the pointers, but the level 1 should + ! be already OK + do i=2, iszv - 1 + p%precv(i)%base_a => p%precv(i)%ac + p%precv(i)%base_desc => p%precv(i)%desc_ac + p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc + p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc + end do + + + i = iszv + call check_coarse_lev(p%precv(i)) + call init_baseprc_av(p%precv(i)%prec,info) + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& + & p%precv(i-1)%base_desc, p%precv(i),info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='coarse rebuild') + goto 9999 + endif end if - - endif + end if + + do i=1, iszv + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Calling mlprcbld at level ',i + select case(p%precv(i)%prec%iprcparm(mld_sub_solve_)) + case(mld_ilu_n_,mld_milu_n_) + call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),& + & 'Level',0,is_legal_ml_lev) + case(mld_ilu_t_) + call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),& + & 'Eps',szero,is_legal_s_fact_thrs) + end select + call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),& + & 'Jacobi sweeps',1,is_legal_jac_sweeps) + + call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,& + & p%precv(i)%prec,info) + + if (info /= 0) then + call psb_errpush(4001,name,a_err='One level preconditioner build.') + goto 9999 + endif + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Return from ',i,' call to mlprcbld ',info + end do + call psb_erractionrestore(err_act) return @@ -307,5 +350,39 @@ contains end subroutine init_baseprc_av + subroutine check_coarse_lev(prec) + type(mld_s_interlev_prec_type) :: prec + + ! + ! At the coarsest level, check mld_coarse_solve_ + ! + val = prec%iprcparm(mld_coarse_solve_) + select case (val) + case(mld_umf_, mld_slu_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + end if + case(mld_sludist_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + prec%prec%iprcparm(mld_smoother_sweeps_) = 1 + end if + end select + end subroutine check_coarse_lev + end subroutine mld_sprecbld diff --git a/mlprec/mld_sprecfree.f90 b/mlprec/mld_sprecfree.f90 index f03948a7..c1619666 100644 --- a/mlprec/mld_sprecfree.f90 +++ b/mlprec/mld_sprecfree.f90 @@ -76,7 +76,7 @@ subroutine mld_sprecfree(p,info) if (allocated(p%precv)) then do i=1,size(p%precv) - call mld_onelev_precfree(p%precv(i),info) + call mld_precfree(p%precv(i),info) end do deallocate(p%precv) end if diff --git a/mlprec/mld_zaggrmat_asb.f90 b/mlprec/mld_zaggrmat_asb.f90 index dede101d..ae0e3507 100644 --- a/mlprec/mld_zaggrmat_asb.f90 +++ b/mlprec/mld_zaggrmat_asb.f90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_z_onelev_prec_type), input/output. +! p - type(mld_z_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -100,7 +100,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,p,info) ! Arguments type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_z_onelev_prec_type), intent(inout), target :: p + type(mld_z_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_zaggrmat_raw_asb.F90 b/mlprec/mld_zaggrmat_raw_asb.F90 index 2779cb8e..f9be5e1e 100644 --- a/mlprec/mld_zaggrmat_raw_asb.F90 +++ b/mlprec/mld_zaggrmat_raw_asb.F90 @@ -66,7 +66,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_z_onelev_prec_type), input/output. +! p - type(mld_z_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -88,7 +88,7 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info) ! Arguments type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_z_onelev_prec_type), intent(inout), target :: p + type(mld_z_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_zaggrmat_smth_asb.F90 b/mlprec/mld_zaggrmat_smth_asb.F90 index a7d356ee..cfbd05f8 100644 --- a/mlprec/mld_zaggrmat_smth_asb.F90 +++ b/mlprec/mld_zaggrmat_smth_asb.F90 @@ -83,7 +83,7 @@ ! the fine-level matrix. ! desc_a - type(psb_desc_type), input. ! The communication descriptor of the fine-level matrix. -! p - type(mld_z_onelev_prec_type), input/output. +! p - type(mld_z_interlev_prec_type), input/output. ! The one-level preconditioner data structure containing the local ! part of the base preconditioner to be built as well as the ! aggregate matrices. @@ -105,7 +105,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info) ! Arguments type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(mld_z_onelev_prec_type), intent(inout), target :: p + type(mld_z_interlev_prec_type), intent(inout), target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_zbaseprec_bld.f90 b/mlprec/mld_zbaseprec_bld.f90 index c325babe..6ee55dbc 100644 --- a/mlprec/mld_zbaseprec_bld.f90 +++ b/mlprec/mld_zbaseprec_bld.f90 @@ -38,7 +38,7 @@ !!$ ! File: mld_zbaseprec_bld.f90 ! -! Subroutine: mld_zbaseprc_bld +! Subroutine: mld_zbaseprec_bld ! Version: complex ! ! This routine builds a 'base preconditioner' related to a matrix A. @@ -68,10 +68,10 @@ ! previously preconditioned, hence some information is reused ! in building the new preconditioner. ! -subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) +subroutine mld_zbaseprec_bld(a,desc_a,p,info,upd) use psb_base_mod - use mld_inner_mod, mld_protect_name => mld_zbaseprc_bld + use mld_inner_mod, mld_protect_name => mld_zbaseprec_bld Implicit None @@ -89,7 +89,7 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) character(len=20) :: name, ch_err if (psb_get_errstatus() /= 0) return - name = 'mld_zbaseprc_bld' + name = 'mld_zbaseprec_bld' info=0 err=0 call psb_erractionsave(err_act) @@ -211,5 +211,5 @@ subroutine mld_zbaseprc_bld(a,desc_a,p,info,upd) end if return -end subroutine mld_zbaseprc_bld +end subroutine mld_zbaseprec_bld diff --git a/mlprec/mld_zmlprec_aply.f90 b/mlprec/mld_zmlprec_aply.f90 index 6e4f9e47..df428466 100644 --- a/mlprec/mld_zmlprec_aply.f90 +++ b/mlprec/mld_zmlprec_aply.f90 @@ -78,7 +78,7 @@ ! Arguments: ! alpha - complex(psb_dpk_), input. ! The scalar alpha. -! precv - type(mld_z_onelev_prec_type), dimension(:), input. +! precv - type(mld_z_interlev_prec_type), dimension(:), input. ! The array of one-level preconditioner data structures containing the ! local parts of the preconditioners to be applied at each level. ! Note that nlev = size(precv) = number of levels. @@ -148,7 +148,7 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info) ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_z_onelev_prec_type), intent(in) :: precv(:) + type(mld_z_interlev_prec_type), intent(in) :: precv(:) complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) @@ -341,7 +341,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_z_onelev_prec_type), intent(in) :: precv(:) + type(mld_z_interlev_prec_type), intent(in) :: precv(:) complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) @@ -577,7 +577,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_z_onelev_prec_type), intent(in) :: precv(:) + type(mld_z_interlev_prec_type), intent(in) :: precv(:) complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) @@ -837,7 +837,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_z_onelev_prec_type), intent(in) :: precv(:) + type(mld_z_interlev_prec_type), intent(in) :: precv(:) complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) @@ -1135,7 +1135,7 @@ contains ! Arguments type(psb_desc_type),intent(in) :: desc_data - type(mld_z_onelev_prec_type), intent(in) :: precv(:) + type(mld_z_interlev_prec_type), intent(in) :: precv(:) complex(psb_dpk_),intent(in) :: alpha,beta complex(psb_dpk_),intent(in) :: x(:) complex(psb_dpk_),intent(inout) :: y(:) diff --git a/mlprec/mld_zmlprec_bld.f90 b/mlprec/mld_zmlprec_bld.f90 index 4008a766..22cdfc63 100644 --- a/mlprec/mld_zmlprec_bld.f90 +++ b/mlprec/mld_zmlprec_bld.f90 @@ -69,7 +69,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info) ! Arguments type(psb_zspmat_type), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a - type(mld_z_onelev_prec_type), intent(inout),target :: p + type(mld_z_interlev_prec_type), intent(inout),target :: p integer, intent(out) :: info ! Local variables diff --git a/mlprec/mld_zprecbld.f90 b/mlprec/mld_zprecbld.f90 index a84cd42b..b5f8b256 100644 --- a/mlprec/mld_zprecbld.f90 +++ b/mlprec/mld_zprecbld.f90 @@ -73,13 +73,14 @@ subroutine mld_zprecbld(a,desc_a,p,info) ! Arguments type(psb_zspmat_type), target :: a type(psb_desc_type), intent(in), target :: desc_a - type(mld_zprec_type),intent(inout) :: p + type(mld_zprec_type),intent(inout), target :: p integer, intent(out) :: info !!$ character, intent(in), optional :: upd ! Local Variables - Integer :: err,i,k,ictxt, me,np, err_act, iszv + type(mld_zprec_type) :: t_prec + Integer :: err,i,k,ictxt, me,np, err_act, iszv, newsz integer :: ipv(mld_ifpsz_), val integer :: int_err(5) character :: upd_ @@ -129,7 +130,8 @@ subroutine mld_zprecbld(a,desc_a,p,info) ! ! Check to ensure all procs have the same ! - iszv = size(p%precv) + newsz = -1 + iszv = size(p%precv) call psb_bcast(ictxt,iszv) if (iszv /= size(p%precv)) then info=4001 @@ -153,7 +155,6 @@ subroutine mld_zprecbld(a,desc_a,p,info) ! Finest level first; remember to fix base_a and base_desc ! call init_baseprc_av(p%precv(1)%prec,info) - if (info == 0) call mld_baseprc_bld(a,desc_a,p%precv(1)%prec,info,upd_) p%precv(1)%base_a => a p%precv(1)%base_desc => desc_a @@ -187,7 +188,7 @@ subroutine mld_zprecbld(a,desc_a,p,info) &': Inconsistent arguments among processes, resetting.' p%precv(i)%iprcparm(:) = ipv(:) end if - + ! ! Sanity checks on the parameters ! @@ -199,36 +200,8 @@ subroutine mld_zprecbld(a,desc_a,p,info) & mld_distr_mat_,is_distr_ml_coarse_mat) else if (i == iszv) then - ! - ! At the coarsest level, check mld_coarse_solve_ - ! - val = p%precv(i)%iprcparm(mld_coarse_solve_) - select case (val) - case(mld_umf_, mld_slu_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_repl_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - end if - case(mld_sludist_) - if ((p%precv(i)%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& - & (p%precv(i)%prec%iprcparm(mld_sub_solve_) /= val)) then - if (me == 0) write(debug_unit,*)& - & 'Warning: inconsistent coarse level specification.' - if (me == 0) write(debug_unit,*)& - & ' Resetting according to the value specified for mld_coarse_solve_.' - p%precv(i)%iprcparm(mld_coarse_mat_) = mld_distr_mat_ - p%precv(i)%prec%iprcparm(mld_sub_solve_) = val - p%precv(i)%prec%iprcparm(mld_smoother_type_) = mld_bjac_ - p%precv(i)%prec%iprcparm(mld_smoother_sweeps_) = 1 - end if - - end select + + call check_coarse_lev(p%precv(i)) end if @@ -240,40 +213,110 @@ subroutine mld_zprecbld(a,desc_a,p,info) ! baseprec_bld is called inside mlprec_bld. ! call init_baseprc_av(p%precv(i)%prec,info) - if (info == 0) call mld_mlprec_bld(p%precv(i-1)%base_a,& + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& & p%precv(i-1)%base_desc, p%precv(i),info) if (info /= 0) then - call psb_errpush(4001,name,a_err='Init & build upper level preconditioner') + call psb_errpush(4001,name,a_err='Init upper level preconditioner') goto 9999 endif if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Return from ',i,' call to mlprcbld ',info - end do - ! - ! Check on sizes from level 2 onwards - ! - if (me==0) then - k = iszv+1 - do i=iszv,3,-1 + if (i>2) then if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then - k=i-1 + newsz=i-1 end if - end do - if (k<=iszv) then - write(debug_unit,*) me,trim(name),& + call psb_bcast(ictxt,newsz) + if (newsz > 0) exit + end if + end do + + if (newsz > 0) then + if (me == 0) then + write(debug_unit,*) trim(name),& &': Warning: aggregates from level ',& - & k, ' to ',iszv,' coincide.' - write(debug_unit,*) me,trim(name),& - &': Maximum recommended NLEV:',k + & newsz + write(debug_unit,*) trim(name),& + &': to level ',& + & iszv + write(debug_unit,*) trim(name),& + &': coincide.' + write(debug_unit,*) trim(name),& + &': Number of levels actually used :',newsz write(debug_unit,*) end if + allocate(t_prec%precv(newsz),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='prec reallocation') + goto 9999 + endif + do i=1,newsz-1 + call mld_transfer(p%precv(i),t_prec%precv(i),info) + end do + call mld_transfer(p%precv(iszv),t_prec%precv(newsz),info) + do i=newsz+1, iszv + call mld_precfree(p%precv(i),info) + end do + call mld_transfer(t_prec,p,info) + ! Ignore errors from transfer + info = 0 + ! + ! Restart + iszv = newsz + ! Fix the pointers, but the level 1 should + ! be already OK + do i=2, iszv - 1 + p%precv(i)%base_a => p%precv(i)%ac + p%precv(i)%base_desc => p%precv(i)%desc_ac + p%precv(i)%map_desc%p_desc_fw => p%precv(i-1)%base_desc + p%precv(i)%map_desc%p_desc_bk => p%precv(i)%base_desc + end do + + + i = iszv + call check_coarse_lev(p%precv(i)) + call init_baseprc_av(p%precv(i)%prec,info) + if (info == 0) call mld_aggr_bld(p%precv(i-1)%base_a,& + & p%precv(i-1)%base_desc, p%precv(i),info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='coarse rebuild') + goto 9999 + endif end if - - endif + end if + + do i=1, iszv + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Calling mlprcbld at level ',i + select case(p%precv(i)%prec%iprcparm(mld_sub_solve_)) + case(mld_ilu_n_,mld_milu_n_) + call mld_check_def(p%precv(i)%prec%iprcparm(mld_sub_fillin_),& + & 'Level',0,is_legal_ml_lev) + case(mld_ilu_t_) + call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),& + & 'Eps',dzero,is_legal_fact_thrs) + end select + call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),& + & 'Jacobi sweeps',1,is_legal_jac_sweeps) + + call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,& + & p%precv(i)%prec,info) + + if (info /= 0) then + call psb_errpush(4001,name,a_err='One level preconditioner build.') + goto 9999 + endif + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'Return from ',i,' call to mlprcbld ',info + end do + call psb_erractionrestore(err_act) return @@ -304,8 +347,42 @@ contains do k=1,size(p%av) call psb_nullify_sp(p%av(k)) end do - + end subroutine init_baseprc_av + subroutine check_coarse_lev(prec) + type(mld_z_interlev_prec_type) :: prec + + ! + ! At the coarsest level, check mld_coarse_solve_ + ! + val = prec%iprcparm(mld_coarse_solve_) + select case (val) + case(mld_umf_, mld_slu_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_repl_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_repl_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + end if + case(mld_sludist_) + if ((prec%iprcparm(mld_coarse_mat_) /= mld_distr_mat_).or.& + & (prec%prec%iprcparm(mld_sub_solve_) /= val)) then + if (me == 0) write(debug_unit,*)& + & 'Warning: inconsistent coarse level specification.' + if (me == 0) write(debug_unit,*)& + & ' Resetting according to the value specified for mld_coarse_solve_.' + prec%iprcparm(mld_coarse_mat_) = mld_distr_mat_ + prec%prec%iprcparm(mld_sub_solve_) = val + prec%prec%iprcparm(mld_smoother_type_) = mld_bjac_ + prec%prec%iprcparm(mld_smoother_sweeps_) = 1 + end if + end select + end subroutine check_coarse_lev + end subroutine mld_zprecbld diff --git a/mlprec/mld_zprecfree.f90 b/mlprec/mld_zprecfree.f90 index 61017acf..2d4e7add 100644 --- a/mlprec/mld_zprecfree.f90 +++ b/mlprec/mld_zprecfree.f90 @@ -76,7 +76,7 @@ subroutine mld_zprecfree(p,info) if (allocated(p%precv)) then do i=1,size(p%precv) - call mld_onelev_precfree(p%precv(i),info) + call mld_precfree(p%precv(i),info) end do deallocate(p%precv) end if