mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-18 20:02:31 +00:00
mld2p4-2:
mlprec/impl/Makefile mlprec/impl/level/mld_c_base_onelev_csetc.f90 mlprec/impl/level/mld_c_base_onelev_cseti.f90 mlprec/impl/level/mld_c_base_onelev_csetr.f90 mlprec/impl/level/mld_c_base_onelev_setc.f90 mlprec/impl/level/mld_d_base_onelev_csetc.f90 mlprec/impl/level/mld_d_base_onelev_cseti.f90 mlprec/impl/level/mld_d_base_onelev_csetr.f90 mlprec/impl/level/mld_d_base_onelev_setc.f90 mlprec/impl/level/mld_s_base_onelev_csetc.f90 mlprec/impl/level/mld_s_base_onelev_cseti.f90 mlprec/impl/level/mld_s_base_onelev_csetr.f90 mlprec/impl/level/mld_s_base_onelev_setc.f90 mlprec/impl/level/mld_z_base_onelev_csetc.f90 mlprec/impl/level/mld_z_base_onelev_cseti.f90 mlprec/impl/level/mld_z_base_onelev_csetr.f90 mlprec/impl/level/mld_z_base_onelev_setc.f90 mlprec/impl/mld_ccprecset.F90 mlprec/impl/mld_cprecset.F90 mlprec/impl/mld_dcprecset.F90 mlprec/impl/mld_scprecset.F90 mlprec/impl/mld_sprecset.F90 mlprec/impl/mld_zcprecset.F90 mlprec/impl/mld_zprecset.F90 mlprec/impl/smoother/Makefile mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 mlprec/impl/smoother/mld_c_as_smoother_setc.f90 mlprec/impl/smoother/mld_c_as_smoother_seti.f90 mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 mlprec/impl/smoother/mld_c_base_smoother_setc.f90 mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 mlprec/impl/smoother/mld_d_as_smoother_setc.f90 mlprec/impl/smoother/mld_d_as_smoother_seti.f90 mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 mlprec/impl/smoother/mld_d_base_smoother_setc.f90 mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 mlprec/impl/smoother/mld_s_as_smoother_setc.f90 mlprec/impl/smoother/mld_s_as_smoother_seti.f90 mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 mlprec/impl/smoother/mld_s_base_smoother_setc.f90 mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 mlprec/impl/smoother/mld_z_as_smoother_setc.f90 mlprec/impl/smoother/mld_z_as_smoother_seti.f90 mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 mlprec/impl/smoother/mld_z_base_smoother_setc.f90 mlprec/impl/solver/mld_c_base_solver_csetc.f90 mlprec/impl/solver/mld_c_base_solver_setc.f90 mlprec/impl/solver/mld_d_base_solver_csetc.f90 mlprec/impl/solver/mld_d_base_solver_setc.f90 mlprec/impl/solver/mld_s_base_solver_csetc.f90 mlprec/impl/solver/mld_s_base_solver_setc.f90 mlprec/impl/solver/mld_z_base_solver_csetc.f90 mlprec/impl/solver/mld_z_base_solver_setc.f90 mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90 mlprec/mld_c_base_solver_mod.f90 mlprec/mld_c_diag_solver.f90 mlprec/mld_c_id_solver.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_onelev_mod.f90 mlprec/mld_c_slu_solver.F90 mlprec/mld_c_sludist_solver.F90 mlprec/mld_c_umf_solver.F90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_base_solver_mod.f90 mlprec/mld_d_diag_solver.f90 mlprec/mld_d_id_solver.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_jac_smoother.f90 mlprec/mld_d_onelev_mod.f90 mlprec/mld_d_slu_solver.F90 mlprec/mld_d_sludist_solver.F90 mlprec/mld_d_umf_solver.F90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90 mlprec/mld_s_base_solver_mod.f90 mlprec/mld_s_diag_solver.f90 mlprec/mld_s_id_solver.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_onelev_mod.f90 mlprec/mld_s_slu_solver.F90 mlprec/mld_s_sludist_solver.F90 mlprec/mld_s_umf_solver.F90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_base_solver_mod.f90 mlprec/mld_z_diag_solver.f90 mlprec/mld_z_id_solver.f90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_jac_smoother.f90 mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_slu_solver.F90 mlprec/mld_z_sludist_solver.F90 mlprec/mld_z_umf_solver.F90 Reworked SET methods. Made stringval a method at the various level. Basic idea: to have derived classes override the base SET when needed. They should recognize any new argument, and possibly call the base method otherwise.
This commit is contained in:
Salvatore Filippone
+3
-19
@@ -26,47 +26,31 @@ DINNEROBJS= mld_dcoarse_bld.o mld_dmlprec_bld.o \
|
||||
mld_d_dec_map_bld.o mld_dmlprec_aply.o mld_daggrmat_asb.o \
|
||||
$(DMPFOBJS)
|
||||
|
||||
# mld_d_base_solver_impl.o mld_d_base_smoother_impl.o mld_d_onelev_impl.o\
|
||||
mld_d_as_smoother_impl.o mld_d_jac_smoother_impl.o \
|
||||
mld_d_diag_solver_impl.o mld_d_id_solver_impl.o mld_d_ilu_solver_impl.o
|
||||
|
||||
SINNEROBJS= mld_scoarse_bld.o mld_smlprec_bld.o \
|
||||
mld_silu0_fact.o mld_siluk_fact.o mld_silut_fact.o mld_saggrmap_bld.o \
|
||||
mld_s_dec_map_bld.o mld_smlprec_aply.o mld_saggrmat_asb.o \
|
||||
$(SMPFOBJS)
|
||||
|
||||
# mld_s_base_solver_impl.o mld_s_base_smoother_impl.o mld_s_onelev_impl.o\
|
||||
mld_s_as_smoother_impl.o mld_s_jac_smoother_impl.o \
|
||||
mld_s_diag_solver_impl.o mld_s_id_solver_impl.o mld_s_ilu_solver_impl.o
|
||||
|
||||
ZINNEROBJS= mld_zcoarse_bld.o mld_zmlprec_bld.o \
|
||||
mld_zilu0_fact.o mld_ziluk_fact.o mld_zilut_fact.o mld_zaggrmap_bld.o \
|
||||
mld_z_dec_map_bld.o mld_zmlprec_aply.o mld_zaggrmat_asb.o \
|
||||
$(ZMPFOBJS)
|
||||
|
||||
# mld_z_base_solver_impl.o mld_z_base_smoother_impl.o mld_z_onelev_impl.o\
|
||||
mld_z_as_smoother_impl.o mld_z_jac_smoother_impl.o \
|
||||
mld_z_diag_solver_impl.o mld_z_id_solver_impl.o mld_z_ilu_solver_impl.o
|
||||
|
||||
CINNEROBJS= mld_ccoarse_bld.o mld_cmlprec_bld.o \
|
||||
mld_cilu0_fact.o mld_ciluk_fact.o mld_cilut_fact.o mld_caggrmap_bld.o \
|
||||
mld_c_dec_map_bld.o mld_cmlprec_aply.o mld_caggrmat_asb.o \
|
||||
$(CMPFOBJS)
|
||||
|
||||
# mld_c_base_solver_impl.o mld_c_base_smoother_impl.o mld_c_onelev_impl.o\
|
||||
mld_c_as_smoother_impl.o mld_c_jac_smoother_impl.o \
|
||||
mld_c_diag_solver_impl.o mld_c_id_solver_impl.o mld_c_ilu_solver_impl.o
|
||||
|
||||
INNEROBJS= $(SINNEROBJS) $(DINNEROBJS) $(CINNEROBJS) $(ZINNEROBJS)
|
||||
|
||||
|
||||
DOUTEROBJS=mld_dprecbld.o mld_dprecset.o mld_dprecinit.o mld_dprecaply.o mld_dcprecset.o
|
||||
|
||||
SOUTEROBJS=mld_sprecbld.o mld_sprecset.o mld_sprecinit.o mld_sprecaply.o
|
||||
SOUTEROBJS=mld_sprecbld.o mld_sprecset.o mld_sprecinit.o mld_sprecaply.o mld_scprecset.o
|
||||
|
||||
ZOUTEROBJS=mld_zprecbld.o mld_zprecset.o mld_zprecinit.o mld_zprecaply.o
|
||||
ZOUTEROBJS=mld_zprecbld.o mld_zprecset.o mld_zprecinit.o mld_zprecaply.o mld_zcprecset.o
|
||||
|
||||
COUTEROBJS=mld_cprecbld.o mld_cprecset.o mld_cprecinit.o mld_cprecaply.o
|
||||
COUTEROBJS=mld_cprecbld.o mld_cprecset.o mld_cprecinit.o mld_cprecaply.o mld_ccprecset.o
|
||||
|
||||
|
||||
OUTEROBJS=$(SOUTEROBJS) $(DOUTEROBJS) $(COUTEROBJS) $(ZOUTEROBJS)
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('SMOOTHER_SWEEPS')
|
||||
lv%parms%sweeps = val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('AGGR_OMEGA_VAL')
|
||||
lv%parms%aggr_omega_val= val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_c_base_onelev_setc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('SMOOTHER_SWEEPS')
|
||||
lv%parms%sweeps = val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('AGGR_OMEGA_VAL')
|
||||
lv%parms%aggr_omega_val= val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('SMOOTHER_SWEEPS')
|
||||
lv%parms%sweeps = val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('AGGR_OMEGA_VAL')
|
||||
lv%parms%aggr_omega_val= val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_s_base_onelev_setc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('SMOOTHER_SWEEPS')
|
||||
lv%parms%sweeps = val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select case (what)
|
||||
select case (psb_toupper(what))
|
||||
|
||||
case ('AGGR_OMEGA_VAL')
|
||||
lv%parms%aggr_omega_val= val
|
||||
|
||||
@@ -56,7 +56,7 @@ subroutine mld_z_base_onelev_setc(lv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = lv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call lv%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -0,0 +1,763 @@
|
||||
!!$
|
||||
!!$
|
||||
!!$ MLD2P4 version 2.0
|
||||
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
|
||||
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
|
||||
!!$
|
||||
!!$ (C) Copyright 2008,2009,2010,2012
|
||||
!!$
|
||||
!!$ Salvatore Filippone University of Rome Tor Vergata
|
||||
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
|
||||
!!$ Pasqua D'Ambra ICAR-CNR, Naples
|
||||
!!$ Daniela di Serafino Second University of Naples
|
||||
!!$
|
||||
!!$ Redistribution and use in source and binary forms, with or without
|
||||
!!$ modification, are permitted provided that the following conditions
|
||||
!!$ are met:
|
||||
!!$ 1. Redistributions of source code must retain the above copyright
|
||||
!!$ notice, this list of conditions and the following disclaimer.
|
||||
!!$ 2. Redistributions in binary form must reproduce the above copyright
|
||||
!!$ notice, this list of conditions, and the following disclaimer in the
|
||||
!!$ documentation and/or other materials provided with the distribution.
|
||||
!!$ 3. The name of the MLD2P4 group or the names of its contributors may
|
||||
!!$ not be used to endorse or promote products derived from this
|
||||
!!$ software without specific written permission.
|
||||
!!$
|
||||
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
!!$ POSSIBILITY OF SUCH DAMAGE.
|
||||
!!$
|
||||
!!$
|
||||
! File: mld_cprecset.f90
|
||||
!
|
||||
! Subroutine: mld_cprecseti
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the integer parameters defining the preconditioner. More
|
||||
! precisely, the integer parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set character and real parameters, see mld_cprecsetc and mld_cprecsetr,
|
||||
! respectively.
|
||||
!
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_cprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! val - integer, input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_ccprecseti(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_ccprecseti
|
||||
use mld_c_jac_smoother
|
||||
use mld_c_as_smoother
|
||||
use mld_c_diag_solver
|
||||
use mld_c_ilu_solver
|
||||
use mld_c_id_solver
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
use mld_c_umf_solver
|
||||
#endif
|
||||
#if defined(HAVE_SLU_)
|
||||
use mld_c_slu_solver
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_
|
||||
character(len=*), parameter :: name='mld_precseti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
info = -1
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
return
|
||||
endif
|
||||
|
||||
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
|
||||
p%coarse_aggr_size = max(val,-1)
|
||||
return
|
||||
end if
|
||||
|
||||
!
|
||||
! Set preconditioner parameters at level ilev.
|
||||
!
|
||||
if (present(ilev)) then
|
||||
|
||||
if (ilev_ == 1) then
|
||||
!
|
||||
! Rules for fine level are slightly different.
|
||||
!
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SUB_RESTR','SUB_PROL', &
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
case default
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end select
|
||||
|
||||
else if (ilev_ > 1) then
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SUB_RESTR','SUB_PROL', &
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN',&
|
||||
& 'COARSE_MAT')
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
case('COARSE_SUBSOLVE')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('COARSE_SOLVE')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
|
||||
select case (val)
|
||||
case(mld_bjac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),val,info)
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
|
||||
#else
|
||||
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
|
||||
#endif
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
|
||||
case(mld_sludist_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_jac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
case('COARSE_SWEEPS')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
|
||||
|
||||
case('COARSE_FILLIN')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
|
||||
case default
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
else if (.not.present(ilev)) then
|
||||
!
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate
|
||||
! levels
|
||||
!
|
||||
select case(psb_toupper(what))
|
||||
case('SUB_SOLVE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
if (.not.allocated(p%precv(ilev_)%sm)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: uninitialized preconditioner component,',&
|
||||
& ' should call MLD_PRECINIT'
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
|
||||
end do
|
||||
|
||||
case('SUB_RESTR','SUB_PROL',&
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('SMOOTHER_SWEEPS')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('SMOOTHER_TYPE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
end do
|
||||
|
||||
case('ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
|
||||
& 'AGGR_EIG','AGGR_FILTER')
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('COARSE_MAT')
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('COARSE_MAT',val,info)
|
||||
end if
|
||||
|
||||
case('COARSE_SOLVE')
|
||||
if (nlev_ > 1) then
|
||||
|
||||
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
|
||||
select case (val)
|
||||
case(mld_bjac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
|
||||
#else
|
||||
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
|
||||
#endif
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
|
||||
case(mld_sludist_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_jac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
case('COARSE_SUBSOLVE')
|
||||
if (nlev_ > 1) then
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
endif
|
||||
|
||||
case('COARSE_SWEEPS')
|
||||
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
|
||||
end if
|
||||
|
||||
case('COARSE_FILLIN')
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
|
||||
end if
|
||||
case default
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
contains
|
||||
|
||||
subroutine onelev_set_smoother(level,val,info)
|
||||
type(mld_c_onelev_type), intent(inout) :: level
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
!
|
||||
! This here requires a bit more attention.
|
||||
!
|
||||
select case (val)
|
||||
case (mld_noprec_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
type is (mld_c_base_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_c_base_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_base_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info ==0) allocate(mld_c_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_jac_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_c_jac_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_c_jac_smoother_type :: &
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_diag_solver_type :: &
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_jac_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_diag_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_bjac_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_c_jac_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_c_jac_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_jac_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_as_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_c_as_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_c_as_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_as_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_c_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case default
|
||||
!
|
||||
! Do nothing and hope for the best :)
|
||||
!
|
||||
end select
|
||||
if (allocated(level%sm)) &
|
||||
& call level%sm%default()
|
||||
|
||||
end subroutine onelev_set_smoother
|
||||
|
||||
subroutine onelev_set_solver(level,val,info)
|
||||
type(mld_c_onelev_type), intent(inout) :: level
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
!
|
||||
! This here requires a bit more attention.
|
||||
!
|
||||
select case (val)
|
||||
case (mld_f_none_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_c_id_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_c_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_id_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
|
||||
|
||||
case (mld_diag_scale_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_c_diag_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_c_diag_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_diag_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
|
||||
|
||||
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_c_ilu_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_c_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_ilu_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
call level%sm%sv%set('SUB_SOLVE',val,info)
|
||||
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
case (mld_umf_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_c_umf_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_c_umf_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_umf_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
#endif
|
||||
#ifdef HAVE_SLU_
|
||||
case (mld_slu_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_c_slu_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_c_slu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_c_slu_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
#endif
|
||||
case default
|
||||
!
|
||||
! Do nothing and hope for the best :)
|
||||
!
|
||||
end select
|
||||
|
||||
end subroutine onelev_set_solver
|
||||
|
||||
|
||||
end subroutine mld_ccprecseti
|
||||
|
||||
!
|
||||
! Subroutine: mld_cprecsetc
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the character parameters defining the preconditioner. More
|
||||
! precisely, the character parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set integer and real parameters, see mld_cprecseti and mld_cprecsetr,
|
||||
! respectively.
|
||||
!
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_cprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! string - character(len=*), input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_ccprecsetc(p,what,string,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_ccprecsetc
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: string
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_,val
|
||||
character(len=*), parameter :: name='mld_precsetc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
val = mld_stringval(string)
|
||||
if (val >=0) then
|
||||
call p%set(what,val,info,ilev=ilev)
|
||||
else
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end if
|
||||
|
||||
end subroutine mld_ccprecsetc
|
||||
|
||||
|
||||
!
|
||||
! Subroutine: mld_cprecsetr
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the real parameters defining the preconditioner. More
|
||||
! precisely, the real parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set integer and character parameters, see mld_cprecseti and mld_cprecsetc,
|
||||
! respectively.
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_cprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! val - real(psb_dpk_), input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_ccprecsetr(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_ccprecsetr
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_,nlev_
|
||||
character(len=*), parameter :: name='mld_precsetr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',&
|
||||
& ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
!
|
||||
! Set preconditioner parameters at level ilev.
|
||||
!
|
||||
if (present(ilev)) then
|
||||
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
else if (.not.present(ilev)) then
|
||||
!
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate levels
|
||||
!
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('COARSE_ILUTHRS')
|
||||
ilev_=nlev_
|
||||
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
|
||||
|
||||
case default
|
||||
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
end subroutine mld_ccprecsetr
|
||||
|
||||
|
||||
@@ -892,130 +892,3 @@ subroutine mld_cprecsetr(p,what,val,info,ilev)
|
||||
|
||||
end subroutine mld_cprecsetr
|
||||
|
||||
|
||||
|
||||
subroutine mld_ccprecseti(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_ccprecseti
|
||||
use mld_c_jac_smoother
|
||||
use mld_c_as_smoother
|
||||
use mld_c_diag_solver
|
||||
use mld_c_ilu_solver
|
||||
use mld_c_id_solver
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
use mld_c_umf_solver
|
||||
#endif
|
||||
#if defined(HAVE_SLU_)
|
||||
use mld_c_slu_solver
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_
|
||||
character(len=*), parameter :: name='mld_precseti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
end subroutine mld_ccprecseti
|
||||
|
||||
|
||||
subroutine mld_ccprecsetc(p,what,string,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_ccprecsetc
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: string
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_,val
|
||||
character(len=*), parameter :: name='mld_precsetc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
end subroutine mld_ccprecsetc
|
||||
|
||||
subroutine mld_ccprecsetr(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_c_prec_mod, mld_protect_name => mld_ccprecsetr
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_cprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_,nlev_
|
||||
character(len=*), parameter :: name='mld_precsetr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',&
|
||||
& ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
|
||||
|
||||
end subroutine mld_ccprecsetr
|
||||
|
||||
|
||||
@@ -129,7 +129,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
|
||||
return
|
||||
endif
|
||||
|
||||
if (what == 'COARSE_AGGR_SIZE') then
|
||||
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
|
||||
p%coarse_aggr_size = max(val,-1)
|
||||
return
|
||||
end if
|
||||
@@ -143,7 +143,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
|
||||
!
|
||||
! Rules for fine level are slightly different.
|
||||
!
|
||||
select case(what)
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
@@ -161,7 +161,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
|
||||
|
||||
else if (ilev_ > 1) then
|
||||
|
||||
select case(what)
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
@@ -246,7 +246,7 @@ subroutine mld_dcprecseti(p,what,val,info,ilev)
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate
|
||||
! levels
|
||||
!
|
||||
select case(what)
|
||||
select case(psb_toupper(what))
|
||||
case('SUB_SOLVE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
if (.not.allocated(p%precv(ilev_)%sm)) then
|
||||
@@ -744,7 +744,7 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev)
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate levels
|
||||
!
|
||||
|
||||
select case(what)
|
||||
select case(psb_toupper(what))
|
||||
case('COARSE_ILUTHRS')
|
||||
ilev_=nlev_
|
||||
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
|
||||
|
||||
@@ -0,0 +1,763 @@
|
||||
!!$
|
||||
!!$
|
||||
!!$ MLD2P4 version 2.0
|
||||
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
|
||||
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
|
||||
!!$
|
||||
!!$ (C) Copyright 2008,2009,2010,2012
|
||||
!!$
|
||||
!!$ Salvatore Filippone University of Rome Tor Vergata
|
||||
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
|
||||
!!$ Pasqua D'Ambra ICAR-CNR, Naples
|
||||
!!$ Daniela di Serafino Second University of Naples
|
||||
!!$
|
||||
!!$ Redistribution and use in source and binary forms, with or without
|
||||
!!$ modification, are permitted provided that the following conditions
|
||||
!!$ are met:
|
||||
!!$ 1. Redistributions of source code must retain the above copyright
|
||||
!!$ notice, this list of conditions and the following disclaimer.
|
||||
!!$ 2. Redistributions in binary form must reproduce the above copyright
|
||||
!!$ notice, this list of conditions, and the following disclaimer in the
|
||||
!!$ documentation and/or other materials provided with the distribution.
|
||||
!!$ 3. The name of the MLD2P4 group or the names of its contributors may
|
||||
!!$ not be used to endorse or promote products derived from this
|
||||
!!$ software without specific written permission.
|
||||
!!$
|
||||
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
!!$ POSSIBILITY OF SUCH DAMAGE.
|
||||
!!$
|
||||
!!$
|
||||
! File: mld_sprecset.f90
|
||||
!
|
||||
! Subroutine: mld_sprecseti
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the integer parameters defining the preconditioner. More
|
||||
! precisely, the integer parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set character and real parameters, see mld_sprecsetc and mld_sprecsetr,
|
||||
! respectively.
|
||||
!
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_sprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! val - integer, input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_scprecseti(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_scprecseti
|
||||
use mld_s_jac_smoother
|
||||
use mld_s_as_smoother
|
||||
use mld_s_diag_solver
|
||||
use mld_s_ilu_solver
|
||||
use mld_s_id_solver
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
use mld_s_umf_solver
|
||||
#endif
|
||||
#if defined(HAVE_SLU_)
|
||||
use mld_s_slu_solver
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_
|
||||
character(len=*), parameter :: name='mld_precseti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
info = -1
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
return
|
||||
endif
|
||||
|
||||
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
|
||||
p%coarse_aggr_size = max(val,-1)
|
||||
return
|
||||
end if
|
||||
|
||||
!
|
||||
! Set preconditioner parameters at level ilev.
|
||||
!
|
||||
if (present(ilev)) then
|
||||
|
||||
if (ilev_ == 1) then
|
||||
!
|
||||
! Rules for fine level are slightly different.
|
||||
!
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SUB_RESTR','SUB_PROL', &
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
case default
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end select
|
||||
|
||||
else if (ilev_ > 1) then
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SUB_RESTR','SUB_PROL', &
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN',&
|
||||
& 'COARSE_MAT')
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
case('COARSE_SUBSOLVE')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('COARSE_SOLVE')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
|
||||
select case (val)
|
||||
case(mld_bjac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),val,info)
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
|
||||
#else
|
||||
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
|
||||
#endif
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
|
||||
case(mld_sludist_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_jac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
case('COARSE_SWEEPS')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
|
||||
|
||||
case('COARSE_FILLIN')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
|
||||
case default
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
else if (.not.present(ilev)) then
|
||||
!
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate
|
||||
! levels
|
||||
!
|
||||
select case(psb_toupper(what))
|
||||
case('SUB_SOLVE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
if (.not.allocated(p%precv(ilev_)%sm)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: uninitialized preconditioner component,',&
|
||||
& ' should call MLD_PRECINIT'
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
|
||||
end do
|
||||
|
||||
case('SUB_RESTR','SUB_PROL',&
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('SMOOTHER_SWEEPS')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('SMOOTHER_TYPE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
end do
|
||||
|
||||
case('ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
|
||||
& 'AGGR_EIG','AGGR_FILTER')
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('COARSE_MAT')
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('COARSE_MAT',val,info)
|
||||
end if
|
||||
|
||||
case('COARSE_SOLVE')
|
||||
if (nlev_ > 1) then
|
||||
|
||||
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
|
||||
select case (val)
|
||||
case(mld_bjac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
|
||||
#else
|
||||
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
|
||||
#endif
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
|
||||
case(mld_sludist_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_jac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
case('COARSE_SUBSOLVE')
|
||||
if (nlev_ > 1) then
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
endif
|
||||
|
||||
case('COARSE_SWEEPS')
|
||||
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
|
||||
end if
|
||||
|
||||
case('COARSE_FILLIN')
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
|
||||
end if
|
||||
case default
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
contains
|
||||
|
||||
subroutine onelev_set_smoother(level,val,info)
|
||||
type(mld_s_onelev_type), intent(inout) :: level
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
!
|
||||
! This here requires a bit more attention.
|
||||
!
|
||||
select case (val)
|
||||
case (mld_noprec_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
type is (mld_s_base_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_s_base_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_base_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info ==0) allocate(mld_s_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_jac_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_s_jac_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_s_jac_smoother_type :: &
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_diag_solver_type :: &
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_jac_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_diag_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_bjac_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_s_jac_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_s_jac_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_jac_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_as_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_s_as_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_s_as_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_as_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_s_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case default
|
||||
!
|
||||
! Do nothing and hope for the best :)
|
||||
!
|
||||
end select
|
||||
if (allocated(level%sm)) &
|
||||
& call level%sm%default()
|
||||
|
||||
end subroutine onelev_set_smoother
|
||||
|
||||
subroutine onelev_set_solver(level,val,info)
|
||||
type(mld_s_onelev_type), intent(inout) :: level
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
!
|
||||
! This here requires a bit more attention.
|
||||
!
|
||||
select case (val)
|
||||
case (mld_f_none_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_s_id_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_s_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_id_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
|
||||
|
||||
case (mld_diag_scale_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_s_diag_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_s_diag_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_diag_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
|
||||
|
||||
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_s_ilu_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_s_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_ilu_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
call level%sm%sv%set('SUB_SOLVE',val,info)
|
||||
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
case (mld_umf_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_s_umf_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_s_umf_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_umf_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
#endif
|
||||
#ifdef HAVE_SLU_
|
||||
case (mld_slu_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_s_slu_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_s_slu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_s_slu_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
#endif
|
||||
case default
|
||||
!
|
||||
! Do nothing and hope for the best :)
|
||||
!
|
||||
end select
|
||||
|
||||
end subroutine onelev_set_solver
|
||||
|
||||
|
||||
end subroutine mld_scprecseti
|
||||
|
||||
!
|
||||
! Subroutine: mld_sprecsetc
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the character parameters defining the preconditioner. More
|
||||
! precisely, the character parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set integer and real parameters, see mld_sprecseti and mld_sprecsetr,
|
||||
! respectively.
|
||||
!
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_sprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! string - character(len=*), input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_scprecsetc(p,what,string,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_scprecsetc
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: string
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_,val
|
||||
character(len=*), parameter :: name='mld_precsetc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
val = mld_stringval(string)
|
||||
if (val >=0) then
|
||||
call p%set(what,val,info,ilev=ilev)
|
||||
else
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end if
|
||||
|
||||
end subroutine mld_scprecsetc
|
||||
|
||||
|
||||
!
|
||||
! Subroutine: mld_sprecsetr
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the real parameters defining the preconditioner. More
|
||||
! precisely, the real parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set integer and character parameters, see mld_sprecseti and mld_sprecsetc,
|
||||
! respectively.
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_sprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! val - real(psb_dpk_), input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_scprecsetr(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_scprecsetr
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_,nlev_
|
||||
character(len=*), parameter :: name='mld_precsetr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',&
|
||||
& ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
!
|
||||
! Set preconditioner parameters at level ilev.
|
||||
!
|
||||
if (present(ilev)) then
|
||||
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
else if (.not.present(ilev)) then
|
||||
!
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate levels
|
||||
!
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('COARSE_ILUTHRS')
|
||||
ilev_=nlev_
|
||||
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
|
||||
|
||||
case default
|
||||
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
end subroutine mld_scprecsetr
|
||||
|
||||
|
||||
@@ -893,129 +893,3 @@ subroutine mld_sprecsetr(p,what,val,info,ilev)
|
||||
end subroutine mld_sprecsetr
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine mld_scprecseti(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_scprecseti
|
||||
use mld_s_jac_smoother
|
||||
use mld_s_as_smoother
|
||||
use mld_s_diag_solver
|
||||
use mld_s_ilu_solver
|
||||
use mld_s_id_solver
|
||||
#if defined(HAVE_UMF_) && 0
|
||||
use mld_s_umf_solver
|
||||
#endif
|
||||
#if defined(HAVE_SLU_)
|
||||
use mld_s_slu_solver
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_
|
||||
character(len=*), parameter :: name='mld_precseti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
end subroutine mld_scprecseti
|
||||
|
||||
|
||||
subroutine mld_scprecsetc(p,what,string,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_scprecsetc
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: string
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_,val
|
||||
character(len=*), parameter :: name='mld_precsetc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
end subroutine mld_scprecsetc
|
||||
|
||||
subroutine mld_scprecsetr(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_s_prec_mod, mld_protect_name => mld_scprecsetr
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_sprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_,nlev_
|
||||
character(len=*), parameter :: name='mld_precsetr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',&
|
||||
& ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
|
||||
|
||||
end subroutine mld_scprecsetr
|
||||
|
||||
@@ -0,0 +1,763 @@
|
||||
!!$
|
||||
!!$
|
||||
!!$ MLD2P4 version 2.0
|
||||
!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package
|
||||
!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0)
|
||||
!!$
|
||||
!!$ (C) Copyright 2008,2009,2010,2012
|
||||
!!$
|
||||
!!$ Salvatore Filippone University of Rome Tor Vergata
|
||||
!!$ Alfredo Buttari CNRS-IRIT, Toulouse
|
||||
!!$ Pasqua D'Ambra ICAR-CNR, Naples
|
||||
!!$ Daniela di Serafino Second University of Naples
|
||||
!!$
|
||||
!!$ Redistribution and use in source and binary forms, with or without
|
||||
!!$ modification, are permitted provided that the following conditions
|
||||
!!$ are met:
|
||||
!!$ 1. Redistributions of source code must retain the above copyright
|
||||
!!$ notice, this list of conditions and the following disclaimer.
|
||||
!!$ 2. Redistributions in binary form must reproduce the above copyright
|
||||
!!$ notice, this list of conditions, and the following disclaimer in the
|
||||
!!$ documentation and/or other materials provided with the distribution.
|
||||
!!$ 3. The name of the MLD2P4 group or the names of its contributors may
|
||||
!!$ not be used to endorse or promote products derived from this
|
||||
!!$ software without specific written permission.
|
||||
!!$
|
||||
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
|
||||
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
!!$ POSSIBILITY OF SUCH DAMAGE.
|
||||
!!$
|
||||
!!$
|
||||
! File: mld_zprecset.f90
|
||||
!
|
||||
! Subroutine: mld_zprecseti
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the integer parameters defining the preconditioner. More
|
||||
! precisely, the integer parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set character and real parameters, see mld_zprecsetc and mld_zprecsetr,
|
||||
! respectively.
|
||||
!
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_zprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! val - integer, input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_zcprecseti(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zcprecseti
|
||||
use mld_z_jac_smoother
|
||||
use mld_z_as_smoother
|
||||
use mld_z_diag_solver
|
||||
use mld_z_ilu_solver
|
||||
use mld_z_id_solver
|
||||
#if defined(HAVE_UMF_)
|
||||
use mld_z_umf_solver
|
||||
#endif
|
||||
#if defined(HAVE_SLU_)
|
||||
use mld_z_slu_solver
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_
|
||||
character(len=*), parameter :: name='mld_precseti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
info = -1
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
return
|
||||
endif
|
||||
|
||||
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
|
||||
p%coarse_aggr_size = max(val,-1)
|
||||
return
|
||||
end if
|
||||
|
||||
!
|
||||
! Set preconditioner parameters at level ilev.
|
||||
!
|
||||
if (present(ilev)) then
|
||||
|
||||
if (ilev_ == 1) then
|
||||
!
|
||||
! Rules for fine level are slightly different.
|
||||
!
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SUB_RESTR','SUB_PROL', &
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
case default
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end select
|
||||
|
||||
else if (ilev_ > 1) then
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('SMOOTHER_TYPE')
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
case('SUB_SOLVE')
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SUB_RESTR','SUB_PROL', &
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN',&
|
||||
& 'COARSE_MAT')
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
case('COARSE_SUBSOLVE')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
case('COARSE_SOLVE')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
|
||||
select case (val)
|
||||
case(mld_bjac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),val,info)
|
||||
#if defined(HAVE_UMF_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
|
||||
#else
|
||||
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
|
||||
#endif
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
|
||||
case(mld_sludist_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_jac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
case('COARSE_SWEEPS')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
|
||||
|
||||
case('COARSE_FILLIN')
|
||||
if (ilev_ /= nlev_) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: Inconsistent specification of WHAT vs. ILEV'
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
|
||||
case default
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
else if (.not.present(ilev)) then
|
||||
!
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate
|
||||
! levels
|
||||
!
|
||||
select case(psb_toupper(what))
|
||||
case('SUB_SOLVE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
if (.not.allocated(p%precv(ilev_)%sm)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: uninitialized preconditioner component,',&
|
||||
& ' should call MLD_PRECINIT'
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
call onelev_set_solver(p%precv(ilev_),val,info)
|
||||
|
||||
end do
|
||||
|
||||
case('SUB_RESTR','SUB_PROL',&
|
||||
& 'SUB_REN','SUB_OVR','SUB_FILLIN')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('SMOOTHER_SWEEPS')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('SMOOTHER_TYPE')
|
||||
do ilev_=1,max(1,nlev_-1)
|
||||
call onelev_set_smoother(p%precv(ilev_),val,info)
|
||||
end do
|
||||
|
||||
case('ML_TYPE','AGGR_ALG','AGGR_KIND',&
|
||||
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',&
|
||||
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
|
||||
& 'AGGR_EIG','AGGR_FILTER')
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
|
||||
case('COARSE_MAT')
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('COARSE_MAT',val,info)
|
||||
end if
|
||||
|
||||
case('COARSE_SOLVE')
|
||||
if (nlev_ > 1) then
|
||||
|
||||
call p%precv(nlev_)%set('COARSE_SOLVE',val,info)
|
||||
select case (val)
|
||||
case(mld_bjac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
#if defined(HAVE_UMF_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_umf_,info)
|
||||
#elif defined(HAVE_SLU_)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_slu_,info)
|
||||
#else
|
||||
call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info)
|
||||
#endif
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info)
|
||||
case(mld_sludist_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
case(mld_jac_)
|
||||
call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info)
|
||||
call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info)
|
||||
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
case('COARSE_SUBSOLVE')
|
||||
if (nlev_ > 1) then
|
||||
call onelev_set_solver(p%precv(nlev_),val,info)
|
||||
endif
|
||||
|
||||
case('COARSE_SWEEPS')
|
||||
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info)
|
||||
end if
|
||||
|
||||
case('COARSE_FILLIN')
|
||||
if (nlev_ > 1) then
|
||||
call p%precv(nlev_)%set('SUB_FILLIN',val,info)
|
||||
end if
|
||||
case default
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
contains
|
||||
|
||||
subroutine onelev_set_smoother(level,val,info)
|
||||
type(mld_z_onelev_type), intent(inout) :: level
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
!
|
||||
! This here requires a bit more attention.
|
||||
!
|
||||
select case (val)
|
||||
case (mld_noprec_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
type is (mld_z_base_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_z_base_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_base_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info ==0) allocate(mld_z_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_jac_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_z_jac_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_z_jac_smoother_type :: &
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_diag_solver_type :: &
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_jac_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_diag_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_bjac_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_z_jac_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_z_jac_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_jac_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case (mld_as_)
|
||||
if (allocated(level%sm)) then
|
||||
select type (sm => level%sm)
|
||||
class is (mld_z_as_smoother_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%free(info)
|
||||
if (info == 0) deallocate(level%sm)
|
||||
if (info == 0) allocate(mld_z_as_smoother_type ::&
|
||||
& level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_as_smoother_type :: level%sm, stat=info)
|
||||
if (info == 0) allocate(mld_z_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
endif
|
||||
|
||||
case default
|
||||
!
|
||||
! Do nothing and hope for the best :)
|
||||
!
|
||||
end select
|
||||
if (allocated(level%sm)) &
|
||||
& call level%sm%default()
|
||||
|
||||
end subroutine onelev_set_smoother
|
||||
|
||||
subroutine onelev_set_solver(level,val,info)
|
||||
type(mld_z_onelev_type), intent(inout) :: level
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
info = psb_success_
|
||||
|
||||
!
|
||||
! This here requires a bit more attention.
|
||||
!
|
||||
select case (val)
|
||||
case (mld_f_none_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_z_id_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_z_id_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_id_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
|
||||
|
||||
case (mld_diag_scale_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_z_diag_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_z_diag_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_diag_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
|
||||
|
||||
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_z_ilu_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_z_ilu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_ilu_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
call level%sm%sv%set('SUB_SOLVE',val,info)
|
||||
|
||||
#ifdef HAVE_UMF_
|
||||
case (mld_umf_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_z_umf_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_z_umf_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_umf_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
#endif
|
||||
#ifdef HAVE_SLU_
|
||||
case (mld_slu_)
|
||||
if (allocated(level%sm%sv)) then
|
||||
select type (sv => level%sm%sv)
|
||||
class is (mld_z_slu_solver_type)
|
||||
! do nothing
|
||||
class default
|
||||
call level%sm%sv%free(info)
|
||||
if (info == 0) deallocate(level%sm%sv)
|
||||
if (info == 0) allocate(mld_z_slu_solver_type ::&
|
||||
& level%sm%sv, stat=info)
|
||||
end select
|
||||
else
|
||||
allocate(mld_z_slu_solver_type :: level%sm%sv, stat=info)
|
||||
endif
|
||||
if (allocated(level%sm)) then
|
||||
if (allocated(level%sm%sv)) &
|
||||
& call level%sm%sv%default()
|
||||
end if
|
||||
#endif
|
||||
case default
|
||||
!
|
||||
! Do nothing and hope for the best :)
|
||||
!
|
||||
end select
|
||||
|
||||
end subroutine onelev_set_solver
|
||||
|
||||
|
||||
end subroutine mld_zcprecseti
|
||||
|
||||
!
|
||||
! Subroutine: mld_zprecsetc
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the character parameters defining the preconditioner. More
|
||||
! precisely, the character parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set integer and real parameters, see mld_zprecseti and mld_zprecsetr,
|
||||
! respectively.
|
||||
!
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_zprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! string - character(len=*), input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_zcprecsetc(p,what,string,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zcprecsetc
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: string
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_,val
|
||||
character(len=*), parameter :: name='mld_precsetc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
val = mld_stringval(string)
|
||||
if (val >=0) then
|
||||
call p%set(what,val,info,ilev=ilev)
|
||||
else
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end if
|
||||
|
||||
end subroutine mld_zcprecsetc
|
||||
|
||||
|
||||
!
|
||||
! Subroutine: mld_zprecsetr
|
||||
! Version: real
|
||||
!
|
||||
! This routine sets the real parameters defining the preconditioner. More
|
||||
! precisely, the real parameter identified by 'what' is assigned the value
|
||||
! contained in 'val'.
|
||||
! For the multilevel preconditioners, the levels are numbered in increasing
|
||||
! order starting from the finest one, i.e. level 1 is the finest level.
|
||||
!
|
||||
! To set integer and character parameters, see mld_zprecseti and mld_zprecsetc,
|
||||
! respectively.
|
||||
!
|
||||
! Arguments:
|
||||
! p - type(mld_zprec_type), input/output.
|
||||
! The preconditioner data structure.
|
||||
! what - integer, input.
|
||||
! The number identifying the parameter to be set.
|
||||
! A mnemonic constant has been associated to each of these
|
||||
! numbers, as reported in the MLD2P4 User's and Reference Guide.
|
||||
! val - real(psb_dpk_), input.
|
||||
! The value of the parameter to be set. The list of allowed
|
||||
! values is reported in the MLD2P4 User's and Reference Guide.
|
||||
! info - integer, output.
|
||||
! Error code.
|
||||
! ilev - integer, optional, input.
|
||||
! For the multilevel preconditioner, the level at which the
|
||||
! preconditioner parameter has to be set.
|
||||
! If nlev is not present, the parameter identified by 'what'
|
||||
! is set at all the appropriate levels.
|
||||
!
|
||||
! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to
|
||||
! MLD2P4 developers. Indeed, by using ilev it is possible to set different values
|
||||
! of the same parameter at different levels 1,...,nlev-1, even in cases where
|
||||
! the parameter must have the same value at all the levels but the coarsest one.
|
||||
! For this reason, the interface mld_precset to this routine has been built in
|
||||
! such a way that ilev is not visible to the user (see mld_prec_mod.f90).
|
||||
!
|
||||
subroutine mld_zcprecsetr(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zcprecsetr
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_,nlev_
|
||||
character(len=*), parameter :: name='mld_precsetr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',&
|
||||
& ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
!
|
||||
! Set preconditioner parameters at level ilev.
|
||||
!
|
||||
if (present(ilev)) then
|
||||
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
|
||||
else if (.not.present(ilev)) then
|
||||
!
|
||||
! ilev not specified: set preconditioner parameters at all the appropriate levels
|
||||
!
|
||||
|
||||
select case(psb_toupper(what))
|
||||
case('COARSE_ILUTHRS')
|
||||
ilev_=nlev_
|
||||
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info)
|
||||
|
||||
case default
|
||||
|
||||
do ilev_=1,nlev_
|
||||
call p%precv(ilev_)%set(what,val,info)
|
||||
end do
|
||||
end select
|
||||
|
||||
endif
|
||||
|
||||
end subroutine mld_zcprecsetr
|
||||
|
||||
|
||||
@@ -892,130 +892,3 @@ subroutine mld_zprecsetr(p,what,val,info,ilev)
|
||||
end subroutine mld_zprecsetr
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
subroutine mld_zcprecseti(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zcprecseti
|
||||
use mld_z_jac_smoother
|
||||
use mld_z_as_smoother
|
||||
use mld_z_diag_solver
|
||||
use mld_z_ilu_solver
|
||||
use mld_z_id_solver
|
||||
#if defined(HAVE_UMF_)
|
||||
use mld_z_umf_solver
|
||||
#endif
|
||||
#if defined(HAVE_SLU_)
|
||||
use mld_z_slu_solver
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_
|
||||
character(len=*), parameter :: name='mld_precseti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
end subroutine mld_zcprecseti
|
||||
|
||||
|
||||
subroutine mld_zcprecsetc(p,what,string,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zcprecsetc
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
character(len=*), intent(in) :: string
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_, nlev_,val
|
||||
character(len=*), parameter :: name='mld_precsetc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
end subroutine mld_zcprecsetc
|
||||
|
||||
subroutine mld_zcprecsetr(p,what,val,info,ilev)
|
||||
|
||||
use psb_base_mod
|
||||
use mld_z_prec_mod, mld_protect_name => mld_zcprecsetr
|
||||
|
||||
implicit none
|
||||
|
||||
! Arguments
|
||||
class(mld_zprec_type), intent(inout) :: p
|
||||
character(len=*), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: ilev
|
||||
|
||||
! Local variables
|
||||
integer(psb_ipk_) :: ilev_,nlev_
|
||||
character(len=*), parameter :: name='mld_precsetr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (present(ilev)) then
|
||||
ilev_ = ilev
|
||||
else
|
||||
ilev_ = 1
|
||||
end if
|
||||
|
||||
if (.not.allocated(p%precv)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
&': Error: uninitialized preconditioner,',&
|
||||
&' should call MLD_PRECINIT'
|
||||
info = 3111
|
||||
return
|
||||
endif
|
||||
nlev_ = size(p%precv)
|
||||
|
||||
if ((ilev_<1).or.(ilev_ > nlev_)) then
|
||||
write(psb_err_unit,*) name,&
|
||||
& ': Error: invalid ILEV/NLEV combination',&
|
||||
& ilev_, nlev_
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
|
||||
|
||||
end subroutine mld_zcprecsetr
|
||||
|
||||
@@ -15,10 +15,8 @@ mld_c_as_smoother_dmp.o \
|
||||
mld_c_as_smoother_free.o \
|
||||
mld_c_as_smoother_setc.o \
|
||||
mld_c_as_smoother_seti.o \
|
||||
mld_c_as_smoother_setr.o \
|
||||
mld_c_as_smoother_csetc.o \
|
||||
mld_c_as_smoother_cseti.o \
|
||||
mld_c_as_smoother_csetr.o \
|
||||
mld_c_base_smoother_apply.o \
|
||||
mld_c_base_smoother_apply_vect.o \
|
||||
mld_c_base_smoother_bld.o \
|
||||
@@ -43,10 +41,8 @@ mld_d_as_smoother_dmp.o \
|
||||
mld_d_as_smoother_free.o \
|
||||
mld_d_as_smoother_setc.o \
|
||||
mld_d_as_smoother_seti.o \
|
||||
mld_d_as_smoother_setr.o \
|
||||
mld_d_as_smoother_csetc.o \
|
||||
mld_d_as_smoother_cseti.o \
|
||||
mld_d_as_smoother_csetr.o \
|
||||
mld_d_base_smoother_apply.o \
|
||||
mld_d_base_smoother_apply_vect.o \
|
||||
mld_d_base_smoother_bld.o \
|
||||
@@ -71,10 +67,8 @@ mld_s_as_smoother_dmp.o \
|
||||
mld_s_as_smoother_free.o \
|
||||
mld_s_as_smoother_setc.o \
|
||||
mld_s_as_smoother_seti.o \
|
||||
mld_s_as_smoother_setr.o \
|
||||
mld_s_as_smoother_csetc.o \
|
||||
mld_s_as_smoother_cseti.o \
|
||||
mld_s_as_smoother_csetr.o \
|
||||
mld_s_base_smoother_apply.o \
|
||||
mld_s_base_smoother_apply_vect.o \
|
||||
mld_s_base_smoother_bld.o \
|
||||
@@ -99,10 +93,8 @@ mld_z_as_smoother_dmp.o \
|
||||
mld_z_as_smoother_free.o \
|
||||
mld_z_as_smoother_setc.o \
|
||||
mld_z_as_smoother_seti.o \
|
||||
mld_z_as_smoother_setr.o \
|
||||
mld_z_as_smoother_csetc.o \
|
||||
mld_z_as_smoother_cseti.o \
|
||||
mld_z_as_smoother_csetr.o \
|
||||
mld_z_base_smoother_apply.o \
|
||||
mld_z_base_smoother_apply_vect.o \
|
||||
mld_z_base_smoother_bld.o \
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_c_as_smoother_csetc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_c_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -44,9 +44,9 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info)
|
||||
|
||||
! Arguments
|
||||
class(mld_c_as_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_as_smoother_cseti'
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case('SMOOTHER_SWEEPS')
|
||||
!!$ sm%sweeps = val
|
||||
case('SUB_OVR')
|
||||
sm%novr = val
|
||||
case('SUB_RESTR')
|
||||
@@ -63,9 +61,7 @@ subroutine mld_c_as_smoother_cseti(sm,what,val,info)
|
||||
case('SUB_PROL')
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_c_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_c_as_smoother_setc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_c_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_c_as_smoother_seti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case(mld_smoother_sweeps_)
|
||||
!!$ sm%sweeps = val
|
||||
case(mld_sub_ovr_)
|
||||
sm%novr = val
|
||||
case(mld_sub_restr_)
|
||||
@@ -63,9 +61,7 @@ subroutine mld_c_as_smoother_seti(sm,what,val,info)
|
||||
case(mld_sub_prol_)
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_c_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_c_base_smoother_csetc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_c_base_smoother_setc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_d_as_smoother_csetc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_d_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -44,9 +44,9 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info)
|
||||
|
||||
! Arguments
|
||||
class(mld_d_as_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_as_smoother_cseti'
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case('SMOOTHER_SWEEPS')
|
||||
!!$ sm%sweeps = val
|
||||
case('SUB_OVR')
|
||||
sm%novr = val
|
||||
case('SUB_RESTR')
|
||||
@@ -63,9 +61,7 @@ subroutine mld_d_as_smoother_cseti(sm,what,val,info)
|
||||
case('SUB_PROL')
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_d_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_d_as_smoother_setc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_d_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_d_as_smoother_seti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case(mld_smoother_sweeps_)
|
||||
!!$ sm%sweeps = val
|
||||
case(mld_sub_ovr_)
|
||||
sm%novr = val
|
||||
case(mld_sub_restr_)
|
||||
@@ -63,9 +61,7 @@ subroutine mld_d_as_smoother_seti(sm,what,val,info)
|
||||
case(mld_sub_prol_)
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_d_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_d_base_smoother_csetc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_d_base_smoother_setc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_s_as_smoother_csetc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_s_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -44,9 +44,9 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info)
|
||||
|
||||
! Arguments
|
||||
class(mld_s_as_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_as_smoother_cseti'
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case('SMOOTHER_SWEEPS')
|
||||
!!$ sm%sweeps = val
|
||||
case('SUB_OVR')
|
||||
sm%novr = val
|
||||
case('SUB_RESTR')
|
||||
@@ -63,9 +61,7 @@ subroutine mld_s_as_smoother_cseti(sm,what,val,info)
|
||||
case('SUB_PROL')
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_s_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_s_as_smoother_setc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_s_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_s_as_smoother_seti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case(mld_smoother_sweeps_)
|
||||
!!$ sm%sweeps = val
|
||||
case(mld_sub_ovr_)
|
||||
sm%novr = val
|
||||
case(mld_sub_restr_)
|
||||
@@ -63,9 +61,7 @@ subroutine mld_s_as_smoother_seti(sm,what,val,info)
|
||||
case(mld_sub_prol_)
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_s_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_s_base_smoother_csetc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_s_base_smoother_setc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_z_as_smoother_csetc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_z_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -44,9 +44,9 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info)
|
||||
|
||||
! Arguments
|
||||
class(mld_z_as_smoother_type), intent(inout) :: sm
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character(len=*), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_as_smoother_cseti'
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case('SMOOTHER_SWEEPS')
|
||||
!!$ sm%sweeps = val
|
||||
case('SUB_OVR')
|
||||
sm%novr = val
|
||||
case('SUB_RESTR')
|
||||
@@ -63,9 +61,7 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info)
|
||||
case('SUB_PROL')
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_z_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -53,13 +53,11 @@ subroutine mld_z_as_smoother_setc(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_z_base_smoother_type%set(what,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
@@ -54,8 +54,6 @@ subroutine mld_z_as_smoother_seti(sm,what,val,info)
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
!!$ case(mld_smoother_sweeps_)
|
||||
!!$ sm%sweeps = val
|
||||
case(mld_sub_ovr_)
|
||||
sm%novr = val
|
||||
case(mld_sub_restr_)
|
||||
@@ -63,9 +61,7 @@ subroutine mld_z_as_smoother_seti(sm,what,val,info)
|
||||
case(mld_sub_prol_)
|
||||
sm%prol = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
call sm%mld_z_base_smoother_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_z_base_smoother_csetc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -54,7 +54,7 @@ subroutine mld_z_base_smoother_setc(sm,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sm%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_c_base_solver_csetc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_c_base_solver_setc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_d_base_solver_csetc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_d_base_solver_setc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_s_base_solver_csetc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_s_base_solver_setc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_z_base_solver_csetc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -53,7 +53,7 @@ subroutine mld_z_base_solver_setc(sv,what,val,info)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
|
||||
@@ -63,10 +63,8 @@ module mld_c_as_smoother
|
||||
procedure, pass(sm) :: free => mld_c_as_smoother_free
|
||||
procedure, pass(sm) :: seti => mld_c_as_smoother_seti
|
||||
procedure, pass(sm) :: setc => mld_c_as_smoother_setc
|
||||
procedure, pass(sm) :: setr => mld_c_as_smoother_setr
|
||||
procedure, pass(sm) :: cseti => mld_c_as_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => mld_c_as_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => mld_c_as_smoother_csetr
|
||||
procedure, pass(sm) :: descr => c_as_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => c_as_smoother_sizeof
|
||||
procedure, pass(sm) :: default => c_as_smoother_default
|
||||
|
||||
@@ -110,6 +110,7 @@ module mld_c_base_smoother_mod
|
||||
procedure, pass(sm) :: descr => mld_c_base_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => c_base_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => c_base_smoother_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_c_base_smoother_type
|
||||
|
||||
|
||||
|
||||
@@ -102,6 +102,7 @@ module mld_c_base_solver_mod
|
||||
procedure, pass(sv) :: descr => mld_c_base_solver_descr
|
||||
procedure, pass(sv) :: sizeof => c_base_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_base_solver_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_c_base_solver_type
|
||||
|
||||
private :: c_base_solver_sizeof, c_base_solver_default,&
|
||||
|
||||
@@ -55,19 +55,14 @@ module mld_c_diag_solver
|
||||
procedure, pass(sv) :: apply_v => mld_c_diag_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_c_diag_solver_apply
|
||||
procedure, pass(sv) :: free => c_diag_solver_free
|
||||
procedure, pass(sv) :: seti => c_diag_solver_seti
|
||||
procedure, pass(sv) :: setc => c_diag_solver_setc
|
||||
procedure, pass(sv) :: setr => c_diag_solver_setr
|
||||
procedure, pass(sv) :: descr => c_diag_solver_descr
|
||||
procedure, pass(sv) :: sizeof => c_diag_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => c_diag_solver_get_nzeros
|
||||
end type mld_c_diag_solver_type
|
||||
|
||||
|
||||
private :: c_diag_solver_free, c_diag_solver_seti, &
|
||||
& c_diag_solver_setc, c_diag_solver_setr,&
|
||||
& c_diag_solver_descr, c_diag_solver_sizeof,&
|
||||
& c_diag_solver_get_nzeros
|
||||
private :: c_diag_solver_free, c_diag_solver_descr, &
|
||||
& c_diag_solver_sizeof, c_diag_solver_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -121,61 +116,6 @@ module mld_c_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine c_diag_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_diag_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_diag_solver_seti
|
||||
|
||||
subroutine c_diag_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_diag_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine c_diag_solver_setc
|
||||
|
||||
subroutine c_diag_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_diag_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_diag_solver_setr
|
||||
|
||||
subroutine c_diag_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -53,16 +53,12 @@ module mld_c_id_solver
|
||||
procedure, pass(sv) :: apply_v => mld_c_id_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_c_id_solver_apply
|
||||
procedure, pass(sv) :: free => c_id_solver_free
|
||||
procedure, pass(sv) :: seti => c_id_solver_seti
|
||||
procedure, pass(sv) :: setc => c_id_solver_setc
|
||||
procedure, pass(sv) :: setr => c_id_solver_setr
|
||||
procedure, pass(sv) :: descr => c_id_solver_descr
|
||||
end type mld_c_id_solver_type
|
||||
|
||||
|
||||
private :: c_id_solver_bld, &
|
||||
& c_id_solver_free, c_id_solver_seti, &
|
||||
& c_id_solver_setc, c_id_solver_setr,&
|
||||
& c_id_solver_free, &
|
||||
& c_id_solver_descr
|
||||
|
||||
interface
|
||||
@@ -124,60 +120,6 @@ contains
|
||||
return
|
||||
end subroutine c_id_solver_bld
|
||||
|
||||
|
||||
subroutine c_id_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_id_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_id_solver_seti
|
||||
|
||||
subroutine c_id_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_id_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine c_id_solver_setc
|
||||
|
||||
subroutine c_id_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_id_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine c_id_solver_setr
|
||||
|
||||
subroutine c_id_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -231,8 +231,7 @@ contains
|
||||
case(mld_sub_fillin_)
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_c_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -263,7 +262,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -305,9 +304,7 @@ contains
|
||||
case(mld_sub_iluthrs_)
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_c_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -343,8 +340,7 @@ contains
|
||||
case('SUB_FILLIN')
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_c_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -375,7 +371,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -417,9 +413,7 @@ contains
|
||||
case('SUB_ILUTHRS')
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_c_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -58,19 +58,14 @@ module mld_c_jac_smoother
|
||||
procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect
|
||||
procedure, pass(sm) :: apply_a => mld_c_jac_smoother_apply
|
||||
procedure, pass(sm) :: free => c_jac_smoother_free
|
||||
procedure, pass(sm) :: seti => c_jac_smoother_seti
|
||||
procedure, pass(sm) :: setc => c_jac_smoother_setc
|
||||
procedure, pass(sm) :: setr => c_jac_smoother_setr
|
||||
procedure, pass(sm) :: descr => c_jac_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => c_jac_smoother_get_nzeros
|
||||
end type mld_c_jac_smoother_type
|
||||
|
||||
|
||||
private :: c_jac_smoother_free, c_jac_smoother_seti, &
|
||||
& c_jac_smoother_setc, c_jac_smoother_setr,&
|
||||
& c_jac_smoother_descr, c_jac_smoother_sizeof, &
|
||||
& c_jac_smoother_get_nzeros
|
||||
private :: c_jac_smoother_free, c_jac_smoother_descr, &
|
||||
& c_jac_smoother_sizeof, c_jac_smoother_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -122,116 +117,6 @@ module mld_c_jac_smoother
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_jac_smoother_seti(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_smoother_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
! !$ case(mld_smoother_sweeps_)
|
||||
! !$ sm%sweeps = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_jac_smoother_seti
|
||||
|
||||
subroutine c_jac_smoother_setc(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='c_jac_smoother_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_jac_smoother_setc
|
||||
|
||||
subroutine c_jac_smoother_setr(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_jac_smoother_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_jac_smoother_setr
|
||||
|
||||
subroutine c_jac_smoother_free(sm,info)
|
||||
|
||||
|
||||
@@ -142,6 +142,7 @@ module mld_c_onelev_mod
|
||||
generic, public :: set => seti, setr, setc, cseti, csetr, csetc
|
||||
procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_c_onelev_type
|
||||
|
||||
type mld_c_onelev_node
|
||||
|
||||
+1
-112
@@ -59,18 +59,13 @@ module mld_c_slu_solver
|
||||
procedure, pass(sv) :: build => c_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => c_slu_solver_apply
|
||||
procedure, pass(sv) :: free => c_slu_solver_free
|
||||
procedure, pass(sv) :: seti => c_slu_solver_seti
|
||||
procedure, pass(sv) :: setc => c_slu_solver_setc
|
||||
procedure, pass(sv) :: setr => c_slu_solver_setr
|
||||
procedure, pass(sv) :: descr => c_slu_solver_descr
|
||||
procedure, pass(sv) :: sizeof => c_slu_solver_sizeof
|
||||
end type mld_c_slu_solver_type
|
||||
|
||||
|
||||
private :: c_slu_solver_bld, c_slu_solver_apply, &
|
||||
& c_slu_solver_free, c_slu_solver_seti, &
|
||||
& c_slu_solver_setc, c_slu_solver_setr,&
|
||||
& c_slu_solver_descr, c_slu_solver_sizeof
|
||||
& c_slu_solver_free, c_slu_solver_descr, c_slu_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -273,112 +268,6 @@ contains
|
||||
return
|
||||
end subroutine c_slu_solver_bld
|
||||
|
||||
|
||||
subroutine c_slu_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='c_slu_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_slu_solver_seti
|
||||
|
||||
subroutine c_slu_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='c_slu_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_slu_solver_setc
|
||||
|
||||
subroutine c_slu_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='c_slu_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_slu_solver_setr
|
||||
|
||||
subroutine c_slu_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -62,18 +62,13 @@ module mld_c_sludist_solver
|
||||
procedure, pass(sv) :: build => c_sludist_solver_bld
|
||||
procedure, pass(sv) :: apply_a => c_sludist_solver_apply
|
||||
procedure, pass(sv) :: free => c_sludist_solver_free
|
||||
procedure, pass(sv) :: seti => c_sludist_solver_seti
|
||||
procedure, pass(sv) :: setc => c_sludist_solver_setc
|
||||
procedure, pass(sv) :: setr => c_sludist_solver_setr
|
||||
procedure, pass(sv) :: descr => c_sludist_solver_descr
|
||||
procedure, pass(sv) :: sizeof => c_sludist_solver_sizeof
|
||||
end type mld_c_sludist_solver_type
|
||||
|
||||
|
||||
private :: c_sludist_solver_bld, c_sludist_solver_apply, &
|
||||
& c_sludist_solver_free, c_sludist_solver_seti, &
|
||||
& c_sludist_solver_setc, c_sludist_solver_setr,&
|
||||
& c_sludist_solver_descr, c_sludist_solver_sizeof
|
||||
& c_sludist_solver_free, c_sludist_solver_descr, c_sludist_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -280,112 +275,6 @@ contains
|
||||
return
|
||||
end subroutine c_sludist_solver_bld
|
||||
|
||||
|
||||
subroutine c_sludist_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='c_sludist_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_sludist_solver_seti
|
||||
|
||||
subroutine c_sludist_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='c_sludist_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_sludist_solver_setc
|
||||
|
||||
subroutine c_sludist_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='c_sludist_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_sludist_solver_setr
|
||||
|
||||
subroutine c_sludist_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
+1
-112
@@ -59,18 +59,13 @@ module mld_c_umf_solver
|
||||
procedure, pass(sv) :: build => c_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => c_umf_solver_apply
|
||||
procedure, pass(sv) :: free => c_umf_solver_free
|
||||
procedure, pass(sv) :: seti => c_umf_solver_seti
|
||||
procedure, pass(sv) :: setc => c_umf_solver_setc
|
||||
procedure, pass(sv) :: setr => c_umf_solver_setr
|
||||
procedure, pass(sv) :: descr => c_umf_solver_descr
|
||||
procedure, pass(sv) :: sizeof => c_umf_solver_sizeof
|
||||
end type mld_c_umf_solver_type
|
||||
|
||||
|
||||
private :: c_umf_solver_bld, c_umf_solver_apply, &
|
||||
& c_umf_solver_free, c_umf_solver_seti, &
|
||||
& c_umf_solver_setc, c_umf_solver_setr,&
|
||||
& c_umf_solver_descr, c_umf_solver_sizeof
|
||||
& c_umf_solver_free, c_umf_solver_descr, c_umf_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -274,112 +269,6 @@ contains
|
||||
return
|
||||
end subroutine c_umf_solver_bld
|
||||
|
||||
|
||||
subroutine c_umf_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='c_umf_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_umf_solver_seti
|
||||
|
||||
subroutine c_umf_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='c_umf_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_umf_solver_setc
|
||||
|
||||
subroutine c_umf_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_c_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='c_umf_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine c_umf_solver_setr
|
||||
|
||||
subroutine c_umf_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -63,10 +63,8 @@ module mld_d_as_smoother
|
||||
procedure, pass(sm) :: free => mld_d_as_smoother_free
|
||||
procedure, pass(sm) :: seti => mld_d_as_smoother_seti
|
||||
procedure, pass(sm) :: setc => mld_d_as_smoother_setc
|
||||
procedure, pass(sm) :: setr => mld_d_as_smoother_setr
|
||||
procedure, pass(sm) :: cseti => mld_d_as_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => mld_d_as_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => mld_d_as_smoother_csetr
|
||||
procedure, pass(sm) :: descr => d_as_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => d_as_smoother_sizeof
|
||||
procedure, pass(sm) :: default => d_as_smoother_default
|
||||
|
||||
@@ -110,6 +110,7 @@ module mld_d_base_smoother_mod
|
||||
procedure, pass(sm) :: descr => mld_d_base_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => d_base_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => d_base_smoother_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_d_base_smoother_type
|
||||
|
||||
|
||||
|
||||
@@ -102,6 +102,7 @@ module mld_d_base_solver_mod
|
||||
procedure, pass(sv) :: descr => mld_d_base_solver_descr
|
||||
procedure, pass(sv) :: sizeof => d_base_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_d_base_solver_type
|
||||
|
||||
private :: d_base_solver_sizeof, d_base_solver_default,&
|
||||
|
||||
@@ -55,19 +55,14 @@ module mld_d_diag_solver
|
||||
procedure, pass(sv) :: apply_v => mld_d_diag_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_d_diag_solver_apply
|
||||
procedure, pass(sv) :: free => d_diag_solver_free
|
||||
procedure, pass(sv) :: seti => d_diag_solver_seti
|
||||
procedure, pass(sv) :: setc => d_diag_solver_setc
|
||||
procedure, pass(sv) :: setr => d_diag_solver_setr
|
||||
procedure, pass(sv) :: descr => d_diag_solver_descr
|
||||
procedure, pass(sv) :: sizeof => d_diag_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => d_diag_solver_get_nzeros
|
||||
end type mld_d_diag_solver_type
|
||||
|
||||
|
||||
private :: d_diag_solver_free, d_diag_solver_seti, &
|
||||
& d_diag_solver_setc, d_diag_solver_setr,&
|
||||
& d_diag_solver_descr, d_diag_solver_sizeof,&
|
||||
& d_diag_solver_get_nzeros
|
||||
private :: d_diag_solver_free, d_diag_solver_descr, &
|
||||
& d_diag_solver_sizeof, d_diag_solver_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -121,61 +116,6 @@ module mld_d_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine d_diag_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_diag_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_diag_solver_seti
|
||||
|
||||
subroutine d_diag_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_diag_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine d_diag_solver_setc
|
||||
|
||||
subroutine d_diag_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_diag_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_diag_solver_setr
|
||||
|
||||
subroutine d_diag_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -53,16 +53,12 @@ module mld_d_id_solver
|
||||
procedure, pass(sv) :: apply_v => mld_d_id_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_d_id_solver_apply
|
||||
procedure, pass(sv) :: free => d_id_solver_free
|
||||
procedure, pass(sv) :: seti => d_id_solver_seti
|
||||
procedure, pass(sv) :: setc => d_id_solver_setc
|
||||
procedure, pass(sv) :: setr => d_id_solver_setr
|
||||
procedure, pass(sv) :: descr => d_id_solver_descr
|
||||
end type mld_d_id_solver_type
|
||||
|
||||
|
||||
private :: d_id_solver_bld, &
|
||||
& d_id_solver_free, d_id_solver_seti, &
|
||||
& d_id_solver_setc, d_id_solver_setr,&
|
||||
& d_id_solver_free, &
|
||||
& d_id_solver_descr
|
||||
|
||||
interface
|
||||
@@ -124,60 +120,6 @@ contains
|
||||
return
|
||||
end subroutine d_id_solver_bld
|
||||
|
||||
|
||||
subroutine d_id_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_id_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_id_solver_seti
|
||||
|
||||
subroutine d_id_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_id_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine d_id_solver_setc
|
||||
|
||||
subroutine d_id_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_id_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_id_solver_setr
|
||||
|
||||
subroutine d_id_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -231,8 +231,7 @@ contains
|
||||
case(mld_sub_fillin_)
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_d_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -263,7 +262,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -305,9 +304,7 @@ contains
|
||||
case(mld_sub_iluthrs_)
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_d_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -343,8 +340,7 @@ contains
|
||||
case('SUB_FILLIN')
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_d_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -375,7 +371,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -417,9 +413,7 @@ contains
|
||||
case('SUB_ILUTHRS')
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_d_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -58,19 +58,14 @@ module mld_d_jac_smoother
|
||||
procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect
|
||||
procedure, pass(sm) :: apply_a => mld_d_jac_smoother_apply
|
||||
procedure, pass(sm) :: free => d_jac_smoother_free
|
||||
procedure, pass(sm) :: seti => d_jac_smoother_seti
|
||||
procedure, pass(sm) :: setc => d_jac_smoother_setc
|
||||
procedure, pass(sm) :: setr => d_jac_smoother_setr
|
||||
procedure, pass(sm) :: descr => d_jac_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => d_jac_smoother_get_nzeros
|
||||
end type mld_d_jac_smoother_type
|
||||
|
||||
|
||||
private :: d_jac_smoother_free, d_jac_smoother_seti, &
|
||||
& d_jac_smoother_setc, d_jac_smoother_setr,&
|
||||
& d_jac_smoother_descr, d_jac_smoother_sizeof, &
|
||||
& d_jac_smoother_get_nzeros
|
||||
private :: d_jac_smoother_free, d_jac_smoother_descr, &
|
||||
& d_jac_smoother_sizeof, d_jac_smoother_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -122,116 +117,6 @@ module mld_d_jac_smoother
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_jac_smoother_seti(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_smoother_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
! !$ case(mld_smoother_sweeps_)
|
||||
! !$ sm%sweeps = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_jac_smoother_seti
|
||||
|
||||
subroutine d_jac_smoother_setc(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='d_jac_smoother_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_jac_smoother_setc
|
||||
|
||||
subroutine d_jac_smoother_setr(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_jac_smoother_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_jac_smoother_setr
|
||||
|
||||
subroutine d_jac_smoother_free(sm,info)
|
||||
|
||||
|
||||
@@ -142,6 +142,7 @@ module mld_d_onelev_mod
|
||||
generic, public :: set => seti, setr, setc, cseti, csetr, csetc
|
||||
procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_d_onelev_type
|
||||
|
||||
type mld_d_onelev_node
|
||||
|
||||
+1
-111
@@ -61,18 +61,13 @@ module mld_d_slu_solver
|
||||
procedure, pass(sv) :: build => d_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_slu_solver_apply
|
||||
procedure, pass(sv) :: free => d_slu_solver_free
|
||||
procedure, pass(sv) :: seti => d_slu_solver_seti
|
||||
procedure, pass(sv) :: setc => d_slu_solver_setc
|
||||
procedure, pass(sv) :: setr => d_slu_solver_setr
|
||||
procedure, pass(sv) :: descr => d_slu_solver_descr
|
||||
procedure, pass(sv) :: sizeof => d_slu_solver_sizeof
|
||||
end type mld_d_slu_solver_type
|
||||
|
||||
|
||||
private :: d_slu_solver_bld, d_slu_solver_apply, &
|
||||
& d_slu_solver_free, d_slu_solver_seti, &
|
||||
& d_slu_solver_setc, d_slu_solver_setr,&
|
||||
& d_slu_solver_descr, d_slu_solver_sizeof
|
||||
& d_slu_solver_free, d_slu_solver_descr, d_slu_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -273,111 +268,6 @@ contains
|
||||
return
|
||||
end subroutine d_slu_solver_bld
|
||||
|
||||
|
||||
subroutine d_slu_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_slu_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_slu_solver_seti
|
||||
|
||||
subroutine d_slu_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='d_slu_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_slu_solver_setc
|
||||
|
||||
subroutine d_slu_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_slu_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_slu_solver_setr
|
||||
|
||||
subroutine d_slu_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -62,18 +62,13 @@ module mld_d_sludist_solver
|
||||
procedure, pass(sv) :: build => d_sludist_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_sludist_solver_apply
|
||||
procedure, pass(sv) :: free => d_sludist_solver_free
|
||||
procedure, pass(sv) :: seti => d_sludist_solver_seti
|
||||
procedure, pass(sv) :: setc => d_sludist_solver_setc
|
||||
procedure, pass(sv) :: setr => d_sludist_solver_setr
|
||||
procedure, pass(sv) :: descr => d_sludist_solver_descr
|
||||
procedure, pass(sv) :: sizeof => d_sludist_solver_sizeof
|
||||
end type mld_d_sludist_solver_type
|
||||
|
||||
|
||||
private :: d_sludist_solver_bld, d_sludist_solver_apply, &
|
||||
& d_sludist_solver_free, d_sludist_solver_seti, &
|
||||
& d_sludist_solver_setc, d_sludist_solver_setr,&
|
||||
& d_sludist_solver_descr, d_sludist_solver_sizeof
|
||||
& d_sludist_solver_free, d_sludist_solver_descr, d_sludist_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -278,111 +273,6 @@ contains
|
||||
return
|
||||
end subroutine d_sludist_solver_bld
|
||||
|
||||
|
||||
subroutine d_sludist_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_sludist_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_sludist_solver_seti
|
||||
|
||||
subroutine d_sludist_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='d_sludist_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_sludist_solver_setc
|
||||
|
||||
subroutine d_sludist_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_sludist_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_sludist_solver_setr
|
||||
|
||||
subroutine d_sludist_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
+1
-111
@@ -61,18 +61,13 @@ module mld_d_umf_solver
|
||||
procedure, pass(sv) :: build => d_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => d_umf_solver_apply
|
||||
procedure, pass(sv) :: free => d_umf_solver_free
|
||||
procedure, pass(sv) :: seti => d_umf_solver_seti
|
||||
procedure, pass(sv) :: setc => d_umf_solver_setc
|
||||
procedure, pass(sv) :: setr => d_umf_solver_setr
|
||||
procedure, pass(sv) :: descr => d_umf_solver_descr
|
||||
procedure, pass(sv) :: sizeof => d_umf_solver_sizeof
|
||||
end type mld_d_umf_solver_type
|
||||
|
||||
|
||||
private :: d_umf_solver_bld, d_umf_solver_apply, &
|
||||
& d_umf_solver_free, d_umf_solver_seti, &
|
||||
& d_umf_solver_setc, d_umf_solver_setr,&
|
||||
& d_umf_solver_descr, d_umf_solver_sizeof
|
||||
& d_umf_solver_free, d_umf_solver_descr, d_umf_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -274,111 +269,6 @@ contains
|
||||
return
|
||||
end subroutine d_umf_solver_bld
|
||||
|
||||
|
||||
subroutine d_umf_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_umf_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_umf_solver_seti
|
||||
|
||||
subroutine d_umf_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='d_umf_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_umf_solver_setc
|
||||
|
||||
subroutine d_umf_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_d_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='d_umf_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine d_umf_solver_setr
|
||||
|
||||
subroutine d_umf_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -63,10 +63,8 @@ module mld_s_as_smoother
|
||||
procedure, pass(sm) :: free => mld_s_as_smoother_free
|
||||
procedure, pass(sm) :: seti => mld_s_as_smoother_seti
|
||||
procedure, pass(sm) :: setc => mld_s_as_smoother_setc
|
||||
procedure, pass(sm) :: setr => mld_s_as_smoother_setr
|
||||
procedure, pass(sm) :: cseti => mld_s_as_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => mld_s_as_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => mld_s_as_smoother_csetr
|
||||
procedure, pass(sm) :: descr => s_as_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => s_as_smoother_sizeof
|
||||
procedure, pass(sm) :: default => s_as_smoother_default
|
||||
|
||||
@@ -110,6 +110,7 @@ module mld_s_base_smoother_mod
|
||||
procedure, pass(sm) :: descr => mld_s_base_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => s_base_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => s_base_smoother_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_s_base_smoother_type
|
||||
|
||||
|
||||
|
||||
@@ -102,6 +102,7 @@ module mld_s_base_solver_mod
|
||||
procedure, pass(sv) :: descr => mld_s_base_solver_descr
|
||||
procedure, pass(sv) :: sizeof => s_base_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => s_base_solver_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_s_base_solver_type
|
||||
|
||||
private :: s_base_solver_sizeof, s_base_solver_default,&
|
||||
|
||||
@@ -55,19 +55,14 @@ module mld_s_diag_solver
|
||||
procedure, pass(sv) :: apply_v => mld_s_diag_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_s_diag_solver_apply
|
||||
procedure, pass(sv) :: free => s_diag_solver_free
|
||||
procedure, pass(sv) :: seti => s_diag_solver_seti
|
||||
procedure, pass(sv) :: setc => s_diag_solver_setc
|
||||
procedure, pass(sv) :: setr => s_diag_solver_setr
|
||||
procedure, pass(sv) :: descr => s_diag_solver_descr
|
||||
procedure, pass(sv) :: sizeof => s_diag_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => s_diag_solver_get_nzeros
|
||||
end type mld_s_diag_solver_type
|
||||
|
||||
|
||||
private :: s_diag_solver_free, s_diag_solver_seti, &
|
||||
& s_diag_solver_setc, s_diag_solver_setr,&
|
||||
& s_diag_solver_descr, s_diag_solver_sizeof,&
|
||||
& s_diag_solver_get_nzeros
|
||||
private :: s_diag_solver_free, s_diag_solver_descr, &
|
||||
& s_diag_solver_sizeof, s_diag_solver_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -121,61 +116,6 @@ module mld_s_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine s_diag_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_diag_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_diag_solver_seti
|
||||
|
||||
subroutine s_diag_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='s_diag_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine s_diag_solver_setc
|
||||
|
||||
subroutine s_diag_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_diag_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_diag_solver_setr
|
||||
|
||||
subroutine s_diag_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -53,16 +53,12 @@ module mld_s_id_solver
|
||||
procedure, pass(sv) :: apply_v => mld_s_id_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_s_id_solver_apply
|
||||
procedure, pass(sv) :: free => s_id_solver_free
|
||||
procedure, pass(sv) :: seti => s_id_solver_seti
|
||||
procedure, pass(sv) :: setc => s_id_solver_setc
|
||||
procedure, pass(sv) :: setr => s_id_solver_setr
|
||||
procedure, pass(sv) :: descr => s_id_solver_descr
|
||||
end type mld_s_id_solver_type
|
||||
|
||||
|
||||
private :: s_id_solver_bld, &
|
||||
& s_id_solver_free, s_id_solver_seti, &
|
||||
& s_id_solver_setc, s_id_solver_setr,&
|
||||
& s_id_solver_free, &
|
||||
& s_id_solver_descr
|
||||
|
||||
interface
|
||||
@@ -124,60 +120,6 @@ contains
|
||||
return
|
||||
end subroutine s_id_solver_bld
|
||||
|
||||
|
||||
subroutine s_id_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_id_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_id_solver_seti
|
||||
|
||||
subroutine s_id_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='s_id_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine s_id_solver_setc
|
||||
|
||||
subroutine s_id_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_id_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_id_solver_setr
|
||||
|
||||
subroutine s_id_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -231,8 +231,7 @@ contains
|
||||
case(mld_sub_fillin_)
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_s_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -263,7 +262,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -305,9 +304,7 @@ contains
|
||||
case(mld_sub_iluthrs_)
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_s_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -343,8 +340,7 @@ contains
|
||||
case('SUB_FILLIN')
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_s_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -375,7 +371,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -417,9 +413,7 @@ contains
|
||||
case('SUB_ILUTHRS')
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_s_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -58,19 +58,14 @@ module mld_s_jac_smoother
|
||||
procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect
|
||||
procedure, pass(sm) :: apply_a => mld_s_jac_smoother_apply
|
||||
procedure, pass(sm) :: free => s_jac_smoother_free
|
||||
procedure, pass(sm) :: seti => s_jac_smoother_seti
|
||||
procedure, pass(sm) :: setc => s_jac_smoother_setc
|
||||
procedure, pass(sm) :: setr => s_jac_smoother_setr
|
||||
procedure, pass(sm) :: descr => s_jac_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => s_jac_smoother_get_nzeros
|
||||
end type mld_s_jac_smoother_type
|
||||
|
||||
|
||||
private :: s_jac_smoother_free, s_jac_smoother_seti, &
|
||||
& s_jac_smoother_setc, s_jac_smoother_setr,&
|
||||
& s_jac_smoother_descr, s_jac_smoother_sizeof, &
|
||||
& s_jac_smoother_get_nzeros
|
||||
private :: s_jac_smoother_free, s_jac_smoother_descr, &
|
||||
& s_jac_smoother_sizeof, s_jac_smoother_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -122,116 +117,6 @@ module mld_s_jac_smoother
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_jac_smoother_seti(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_smoother_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
! !$ case(mld_smoother_sweeps_)
|
||||
! !$ sm%sweeps = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_jac_smoother_seti
|
||||
|
||||
subroutine s_jac_smoother_setc(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='s_jac_smoother_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_jac_smoother_setc
|
||||
|
||||
subroutine s_jac_smoother_setr(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='s_jac_smoother_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_jac_smoother_setr
|
||||
|
||||
subroutine s_jac_smoother_free(sm,info)
|
||||
|
||||
|
||||
@@ -142,6 +142,7 @@ module mld_s_onelev_mod
|
||||
generic, public :: set => seti, setr, setc, cseti, csetr, csetc
|
||||
procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_s_onelev_type
|
||||
|
||||
type mld_s_onelev_node
|
||||
|
||||
+1
-111
@@ -63,18 +63,13 @@ module mld_s_slu_solver
|
||||
procedure, pass(sv) :: build => s_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => s_slu_solver_apply
|
||||
procedure, pass(sv) :: free => s_slu_solver_free
|
||||
procedure, pass(sv) :: seti => s_slu_solver_seti
|
||||
procedure, pass(sv) :: setc => s_slu_solver_setc
|
||||
procedure, pass(sv) :: setr => s_slu_solver_setr
|
||||
procedure, pass(sv) :: descr => s_slu_solver_descr
|
||||
procedure, pass(sv) :: sizeof => s_slu_solver_sizeof
|
||||
end type mld_s_slu_solver_type
|
||||
|
||||
|
||||
private :: s_slu_solver_bld, s_slu_solver_apply, &
|
||||
& s_slu_solver_free, s_slu_solver_seti, &
|
||||
& s_slu_solver_setc, s_slu_solver_setr,&
|
||||
& s_slu_solver_descr, s_slu_solver_sizeof
|
||||
& s_slu_solver_free, s_slu_solver_descr, s_slu_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -275,111 +270,6 @@ contains
|
||||
return
|
||||
end subroutine s_slu_solver_bld
|
||||
|
||||
|
||||
subroutine s_slu_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='s_slu_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_slu_solver_seti
|
||||
|
||||
subroutine s_slu_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='s_slu_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_slu_solver_setc
|
||||
|
||||
subroutine s_slu_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='s_slu_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_slu_solver_setr
|
||||
|
||||
subroutine s_slu_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -62,18 +62,13 @@ module mld_s_sludist_solver
|
||||
procedure, pass(sv) :: build => s_sludist_solver_bld
|
||||
procedure, pass(sv) :: apply_a => s_sludist_solver_apply
|
||||
procedure, pass(sv) :: free => s_sludist_solver_free
|
||||
procedure, pass(sv) :: seti => s_sludist_solver_seti
|
||||
procedure, pass(sv) :: setc => s_sludist_solver_setc
|
||||
procedure, pass(sv) :: setr => s_sludist_solver_setr
|
||||
procedure, pass(sv) :: descr => s_sludist_solver_descr
|
||||
procedure, pass(sv) :: sizeof => s_sludist_solver_sizeof
|
||||
end type mld_s_sludist_solver_type
|
||||
|
||||
|
||||
private :: s_sludist_solver_bld, s_sludist_solver_apply, &
|
||||
& s_sludist_solver_free, s_sludist_solver_seti, &
|
||||
& s_sludist_solver_setc, s_sludist_solver_setr,&
|
||||
& s_sludist_solver_descr, s_sludist_solver_sizeof
|
||||
& s_sludist_solver_free, s_sludist_solver_descr, s_sludist_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -278,111 +273,6 @@ contains
|
||||
return
|
||||
end subroutine s_sludist_solver_bld
|
||||
|
||||
|
||||
subroutine s_sludist_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='s_sludist_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_sludist_solver_seti
|
||||
|
||||
subroutine s_sludist_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='s_sludist_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_sludist_solver_setc
|
||||
|
||||
subroutine s_sludist_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='s_sludist_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_sludist_solver_setr
|
||||
|
||||
subroutine s_sludist_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
+1
-111
@@ -63,18 +63,13 @@ module mld_s_umf_solver
|
||||
procedure, pass(sv) :: build => s_umf_solver_bld
|
||||
procedure, pass(sv) :: apply_a => s_umf_solver_apply
|
||||
procedure, pass(sv) :: free => s_umf_solver_free
|
||||
procedure, pass(sv) :: seti => s_umf_solver_seti
|
||||
procedure, pass(sv) :: setc => s_umf_solver_setc
|
||||
procedure, pass(sv) :: setr => s_umf_solver_setr
|
||||
procedure, pass(sv) :: descr => s_umf_solver_descr
|
||||
procedure, pass(sv) :: sizeof => s_umf_solver_sizeof
|
||||
end type mld_s_umf_solver_type
|
||||
|
||||
|
||||
private :: s_umf_solver_bld, s_umf_solver_apply, &
|
||||
& s_umf_solver_free, s_umf_solver_seti, &
|
||||
& s_umf_solver_setc, s_umf_solver_setr,&
|
||||
& s_umf_solver_descr, s_umf_solver_sizeof
|
||||
& s_umf_solver_free, s_umf_solver_descr, s_umf_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -276,111 +271,6 @@ contains
|
||||
return
|
||||
end subroutine s_umf_solver_bld
|
||||
|
||||
|
||||
subroutine s_umf_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='s_umf_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_umf_solver_seti
|
||||
|
||||
subroutine s_umf_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='s_umf_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_umf_solver_setc
|
||||
|
||||
subroutine s_umf_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_s_umf_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_spk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='s_umf_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine s_umf_solver_setr
|
||||
|
||||
subroutine s_umf_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -63,10 +63,8 @@ module mld_z_as_smoother
|
||||
procedure, pass(sm) :: free => mld_z_as_smoother_free
|
||||
procedure, pass(sm) :: seti => mld_z_as_smoother_seti
|
||||
procedure, pass(sm) :: setc => mld_z_as_smoother_setc
|
||||
procedure, pass(sm) :: setr => mld_z_as_smoother_setr
|
||||
procedure, pass(sm) :: cseti => mld_z_as_smoother_cseti
|
||||
procedure, pass(sm) :: csetc => mld_z_as_smoother_csetc
|
||||
procedure, pass(sm) :: csetr => mld_z_as_smoother_csetr
|
||||
procedure, pass(sm) :: descr => z_as_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => z_as_smoother_sizeof
|
||||
procedure, pass(sm) :: default => z_as_smoother_default
|
||||
|
||||
@@ -110,6 +110,7 @@ module mld_z_base_smoother_mod
|
||||
procedure, pass(sm) :: descr => mld_z_base_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => z_base_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => z_base_smoother_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_z_base_smoother_type
|
||||
|
||||
|
||||
|
||||
@@ -102,6 +102,7 @@ module mld_z_base_solver_mod
|
||||
procedure, pass(sv) :: descr => mld_z_base_solver_descr
|
||||
procedure, pass(sv) :: sizeof => z_base_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => z_base_solver_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_z_base_solver_type
|
||||
|
||||
private :: z_base_solver_sizeof, z_base_solver_default,&
|
||||
|
||||
@@ -55,19 +55,14 @@ module mld_z_diag_solver
|
||||
procedure, pass(sv) :: apply_v => mld_z_diag_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_z_diag_solver_apply
|
||||
procedure, pass(sv) :: free => z_diag_solver_free
|
||||
procedure, pass(sv) :: seti => z_diag_solver_seti
|
||||
procedure, pass(sv) :: setc => z_diag_solver_setc
|
||||
procedure, pass(sv) :: setr => z_diag_solver_setr
|
||||
procedure, pass(sv) :: descr => z_diag_solver_descr
|
||||
procedure, pass(sv) :: sizeof => z_diag_solver_sizeof
|
||||
procedure, pass(sv) :: get_nzeros => z_diag_solver_get_nzeros
|
||||
end type mld_z_diag_solver_type
|
||||
|
||||
|
||||
private :: z_diag_solver_free, z_diag_solver_seti, &
|
||||
& z_diag_solver_setc, z_diag_solver_setr,&
|
||||
& z_diag_solver_descr, z_diag_solver_sizeof,&
|
||||
& z_diag_solver_get_nzeros
|
||||
private :: z_diag_solver_free, z_diag_solver_descr, &
|
||||
& z_diag_solver_sizeof, z_diag_solver_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -121,61 +116,6 @@ module mld_z_diag_solver
|
||||
|
||||
contains
|
||||
|
||||
|
||||
subroutine z_diag_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_diag_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
return
|
||||
|
||||
end subroutine z_diag_solver_seti
|
||||
|
||||
subroutine z_diag_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='z_diag_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine z_diag_solver_setc
|
||||
|
||||
subroutine z_diag_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_diag_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_diag_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine z_diag_solver_setr
|
||||
|
||||
subroutine z_diag_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -53,16 +53,12 @@ module mld_z_id_solver
|
||||
procedure, pass(sv) :: apply_v => mld_z_id_solver_apply_vect
|
||||
procedure, pass(sv) :: apply_a => mld_z_id_solver_apply
|
||||
procedure, pass(sv) :: free => z_id_solver_free
|
||||
procedure, pass(sv) :: seti => z_id_solver_seti
|
||||
procedure, pass(sv) :: setc => z_id_solver_setc
|
||||
procedure, pass(sv) :: setr => z_id_solver_setr
|
||||
procedure, pass(sv) :: descr => z_id_solver_descr
|
||||
end type mld_z_id_solver_type
|
||||
|
||||
|
||||
private :: z_id_solver_bld, &
|
||||
& z_id_solver_free, z_id_solver_seti, &
|
||||
& z_id_solver_setc, z_id_solver_setr,&
|
||||
& z_id_solver_free, &
|
||||
& z_id_solver_descr
|
||||
|
||||
interface
|
||||
@@ -124,60 +120,6 @@ contains
|
||||
return
|
||||
end subroutine z_id_solver_bld
|
||||
|
||||
|
||||
subroutine z_id_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_id_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine z_id_solver_seti
|
||||
|
||||
subroutine z_id_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='z_id_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
end subroutine z_id_solver_setc
|
||||
|
||||
subroutine z_id_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_id_solver_type), intent(inout) :: sv
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_id_solver_setr'
|
||||
|
||||
info = psb_success_
|
||||
|
||||
return
|
||||
|
||||
end subroutine z_id_solver_setr
|
||||
|
||||
subroutine z_id_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -231,8 +231,7 @@ contains
|
||||
case(mld_sub_fillin_)
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_z_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -263,7 +262,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -305,9 +304,7 @@ contains
|
||||
case(mld_sub_iluthrs_)
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_z_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -343,8 +340,7 @@ contains
|
||||
case('SUB_FILLIN')
|
||||
sv%fill_in = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
call sv%mld_z_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
@@ -375,7 +371,7 @@ contains
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
ival = sv%stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
@@ -417,9 +413,7 @@ contains
|
||||
case('SUB_ILUTHRS')
|
||||
sv%thresh = val
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
call sv%mld_z_base_solver_type%set(what,val,info)
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
@@ -58,19 +58,14 @@ module mld_z_jac_smoother
|
||||
procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect
|
||||
procedure, pass(sm) :: apply_a => mld_z_jac_smoother_apply
|
||||
procedure, pass(sm) :: free => z_jac_smoother_free
|
||||
procedure, pass(sm) :: seti => z_jac_smoother_seti
|
||||
procedure, pass(sm) :: setc => z_jac_smoother_setc
|
||||
procedure, pass(sm) :: setr => z_jac_smoother_setr
|
||||
procedure, pass(sm) :: descr => z_jac_smoother_descr
|
||||
procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof
|
||||
procedure, pass(sm) :: get_nzeros => z_jac_smoother_get_nzeros
|
||||
end type mld_z_jac_smoother_type
|
||||
|
||||
|
||||
private :: z_jac_smoother_free, z_jac_smoother_seti, &
|
||||
& z_jac_smoother_setc, z_jac_smoother_setr,&
|
||||
& z_jac_smoother_descr, z_jac_smoother_sizeof, &
|
||||
& z_jac_smoother_get_nzeros
|
||||
private :: z_jac_smoother_free, z_jac_smoother_descr, &
|
||||
& z_jac_smoother_sizeof, z_jac_smoother_get_nzeros
|
||||
|
||||
|
||||
interface
|
||||
@@ -122,116 +117,6 @@ module mld_z_jac_smoother
|
||||
|
||||
contains
|
||||
|
||||
subroutine z_jac_smoother_seti(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
integer(psb_ipk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_jac_smoother_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
! !$ case(mld_smoother_sweeps_)
|
||||
! !$ sm%sweeps = val
|
||||
case default
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_jac_smoother_seti
|
||||
|
||||
subroutine z_jac_smoother_setc(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act, ival
|
||||
character(len=20) :: name='z_jac_smoother_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >= 0) then
|
||||
call sm%set(what,ival,info)
|
||||
else
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_jac_smoother_setc
|
||||
|
||||
subroutine z_jac_smoother_setr(sm,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_jac_smoother_type), intent(inout) :: sm
|
||||
integer(psb_ipk_), intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='z_jac_smoother_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%set(what,val,info)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_jac_smoother_setr
|
||||
|
||||
subroutine z_jac_smoother_free(sm,info)
|
||||
|
||||
|
||||
@@ -142,6 +142,7 @@ module mld_z_onelev_mod
|
||||
generic, public :: set => seti, setr, setc, cseti, csetr, csetc
|
||||
procedure, pass(lv) :: sizeof => z_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
end type mld_z_onelev_type
|
||||
|
||||
type mld_z_onelev_node
|
||||
|
||||
+1
-111
@@ -63,18 +63,13 @@ module mld_z_slu_solver
|
||||
procedure, pass(sv) :: build => z_slu_solver_bld
|
||||
procedure, pass(sv) :: apply_a => z_slu_solver_apply
|
||||
procedure, pass(sv) :: free => z_slu_solver_free
|
||||
procedure, pass(sv) :: seti => z_slu_solver_seti
|
||||
procedure, pass(sv) :: setc => z_slu_solver_setc
|
||||
procedure, pass(sv) :: setr => z_slu_solver_setr
|
||||
procedure, pass(sv) :: descr => z_slu_solver_descr
|
||||
procedure, pass(sv) :: sizeof => z_slu_solver_sizeof
|
||||
end type mld_z_slu_solver_type
|
||||
|
||||
|
||||
private :: z_slu_solver_bld, z_slu_solver_apply, &
|
||||
& z_slu_solver_free, z_slu_solver_seti, &
|
||||
& z_slu_solver_setc, z_slu_solver_setr,&
|
||||
& z_slu_solver_descr, z_slu_solver_sizeof
|
||||
& z_slu_solver_free, z_slu_solver_descr, z_slu_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -277,111 +272,6 @@ contains
|
||||
return
|
||||
end subroutine z_slu_solver_bld
|
||||
|
||||
|
||||
subroutine z_slu_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='z_slu_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_slu_solver_seti
|
||||
|
||||
subroutine z_slu_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='z_slu_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_slu_solver_setc
|
||||
|
||||
subroutine z_slu_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_slu_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='z_slu_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_slu_solver_setr
|
||||
|
||||
subroutine z_slu_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -61,18 +61,13 @@ module mld_z_sludist_solver
|
||||
procedure, pass(sv) :: build => z_sludist_solver_bld
|
||||
procedure, pass(sv) :: apply_a => z_sludist_solver_apply
|
||||
procedure, pass(sv) :: free => z_sludist_solver_free
|
||||
procedure, pass(sv) :: seti => z_sludist_solver_seti
|
||||
procedure, pass(sv) :: setc => z_sludist_solver_setc
|
||||
procedure, pass(sv) :: setr => z_sludist_solver_setr
|
||||
procedure, pass(sv) :: descr => z_sludist_solver_descr
|
||||
procedure, pass(sv) :: sizeof => z_sludist_solver_sizeof
|
||||
end type mld_z_sludist_solver_type
|
||||
|
||||
|
||||
private :: z_sludist_solver_bld, z_sludist_solver_apply, &
|
||||
& z_sludist_solver_free, z_sludist_solver_seti, &
|
||||
& z_sludist_solver_setc, z_sludist_solver_setr,&
|
||||
& z_sludist_solver_descr, z_sludist_solver_sizeof
|
||||
& z_sludist_solver_free, z_sludist_solver_descr, z_sludist_solver_sizeof
|
||||
|
||||
|
||||
interface
|
||||
@@ -279,111 +274,6 @@ contains
|
||||
return
|
||||
end subroutine z_sludist_solver_bld
|
||||
|
||||
|
||||
subroutine z_sludist_solver_seti(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
integer, intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='z_sludist_solver_seti'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_sludist_solver_seti
|
||||
|
||||
subroutine z_sludist_solver_setc(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
character(len=*), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act, ival
|
||||
character(len=20) :: name='z_sludist_solver_setc'
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ival = mld_stringval(val)
|
||||
if (ival >=0) then
|
||||
call sv%set(what,ival,info)
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_sludist_solver_setc
|
||||
|
||||
subroutine z_sludist_solver_setr(sv,what,val,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
! Arguments
|
||||
class(mld_z_sludist_solver_type), intent(inout) :: sv
|
||||
integer, intent(in) :: what
|
||||
real(psb_dpk_), intent(in) :: val
|
||||
integer, intent(out) :: info
|
||||
Integer :: err_act
|
||||
character(len=20) :: name='z_sludist_solver_setr'
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
select case(what)
|
||||
case default
|
||||
!!$ write(0,*) name,': Error: invalid WHAT'
|
||||
!!$ info = -2
|
||||
!!$ goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine z_sludist_solver_setr
|
||||
|
||||
subroutine z_sludist_solver_free(sv,info)
|
||||
|
||||
Implicit None
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user