diff --git a/mlprec/mld_c_mumps_solver.F90 b/mlprec/mld_c_mumps_solver.F90 index d8189072..0f5c339e 100644 --- a/mlprec/mld_c_mumps_solver.F90 +++ b/mlprec/mld_c_mumps_solver.F90 @@ -91,6 +91,7 @@ module mld_c_mumps_solver procedure, pass(sv) :: free => c_mumps_solver_free procedure, pass(sv) :: descr => c_mumps_solver_descr procedure, pass(sv) :: sizeof => c_mumps_solver_sizeof + procedure, pass(sv) :: csetc => c_mumps_solver_csetc procedure, pass(sv) :: cseti => c_mumps_solver_cseti procedure, pass(sv) :: csetr => c_mumps_solver_csetr procedure, pass(sv) :: default => c_mumps_solver_default @@ -107,6 +108,7 @@ module mld_c_mumps_solver & c_mumps_solver_free, c_mumps_solver_descr, & & c_mumps_solver_sizeof, c_mumps_solver_apply_vect,& & c_mumps_solver_cseti, c_mumps_solver_csetr, & + & c_mumps_solver_csetc, & & c_mumps_solver_default, c_mumps_solver_get_fmt, & & c_mumps_solver_get_id, c_mumps_solver_is_global #if defined(HAVE_FINAL) @@ -277,6 +279,45 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine c_mumps_solver_csetc(sv,what,val,info,idx) + + Implicit None + + ! Arguments + class(mld_c_mumps_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_mumps_solver_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + select case(psb_toupper(trim(what))) +#if defined(HAVE_MUMPS_) + case('MUMPS_LOC_GLOB') + sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) +#endif + case default + call sv%mld_c_base_solver_type%set(what,val,info,idx=idx) + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine c_mumps_solver_csetc + + subroutine c_mumps_solver_cseti(sv,what,val,info,idx) Implicit None diff --git a/mlprec/mld_d_mumps_solver.F90 b/mlprec/mld_d_mumps_solver.F90 index 1b7d4357..8c081a85 100644 --- a/mlprec/mld_d_mumps_solver.F90 +++ b/mlprec/mld_d_mumps_solver.F90 @@ -91,6 +91,7 @@ module mld_d_mumps_solver procedure, pass(sv) :: free => d_mumps_solver_free procedure, pass(sv) :: descr => d_mumps_solver_descr procedure, pass(sv) :: sizeof => d_mumps_solver_sizeof + procedure, pass(sv) :: csetc => d_mumps_solver_csetc procedure, pass(sv) :: cseti => d_mumps_solver_cseti procedure, pass(sv) :: csetr => d_mumps_solver_csetr procedure, pass(sv) :: default => d_mumps_solver_default @@ -107,6 +108,7 @@ module mld_d_mumps_solver & d_mumps_solver_free, d_mumps_solver_descr, & & d_mumps_solver_sizeof, d_mumps_solver_apply_vect,& & d_mumps_solver_cseti, d_mumps_solver_csetr, & + & d_mumps_solver_csetc, & & d_mumps_solver_default, d_mumps_solver_get_fmt, & & d_mumps_solver_get_id, d_mumps_solver_is_global #if defined(HAVE_FINAL) @@ -277,6 +279,45 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine d_mumps_solver_csetc(sv,what,val,info,idx) + + Implicit None + + ! Arguments + class(mld_d_mumps_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_mumps_solver_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + select case(psb_toupper(trim(what))) +#if defined(HAVE_MUMPS_) + case('MUMPS_LOC_GLOB') + sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) +#endif + case default + call sv%mld_d_base_solver_type%set(what,val,info,idx=idx) + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine d_mumps_solver_csetc + + subroutine d_mumps_solver_cseti(sv,what,val,info,idx) Implicit None diff --git a/mlprec/mld_s_mumps_solver.F90 b/mlprec/mld_s_mumps_solver.F90 index 5875ec9e..38fbc353 100644 --- a/mlprec/mld_s_mumps_solver.F90 +++ b/mlprec/mld_s_mumps_solver.F90 @@ -91,6 +91,7 @@ module mld_s_mumps_solver procedure, pass(sv) :: free => s_mumps_solver_free procedure, pass(sv) :: descr => s_mumps_solver_descr procedure, pass(sv) :: sizeof => s_mumps_solver_sizeof + procedure, pass(sv) :: csetc => s_mumps_solver_csetc procedure, pass(sv) :: cseti => s_mumps_solver_cseti procedure, pass(sv) :: csetr => s_mumps_solver_csetr procedure, pass(sv) :: default => s_mumps_solver_default @@ -107,6 +108,7 @@ module mld_s_mumps_solver & s_mumps_solver_free, s_mumps_solver_descr, & & s_mumps_solver_sizeof, s_mumps_solver_apply_vect,& & s_mumps_solver_cseti, s_mumps_solver_csetr, & + & s_mumps_solver_csetc, & & s_mumps_solver_default, s_mumps_solver_get_fmt, & & s_mumps_solver_get_id, s_mumps_solver_is_global #if defined(HAVE_FINAL) @@ -277,6 +279,45 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine s_mumps_solver_csetc(sv,what,val,info,idx) + + Implicit None + + ! Arguments + class(mld_s_mumps_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_mumps_solver_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + select case(psb_toupper(trim(what))) +#if defined(HAVE_MUMPS_) + case('MUMPS_LOC_GLOB') + sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) +#endif + case default + call sv%mld_s_base_solver_type%set(what,val,info,idx=idx) + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine s_mumps_solver_csetc + + subroutine s_mumps_solver_cseti(sv,what,val,info,idx) Implicit None diff --git a/mlprec/mld_z_mumps_solver.F90 b/mlprec/mld_z_mumps_solver.F90 index 68cda68e..d5ce2fd5 100644 --- a/mlprec/mld_z_mumps_solver.F90 +++ b/mlprec/mld_z_mumps_solver.F90 @@ -91,6 +91,7 @@ module mld_z_mumps_solver procedure, pass(sv) :: free => z_mumps_solver_free procedure, pass(sv) :: descr => z_mumps_solver_descr procedure, pass(sv) :: sizeof => z_mumps_solver_sizeof + procedure, pass(sv) :: csetc => z_mumps_solver_csetc procedure, pass(sv) :: cseti => z_mumps_solver_cseti procedure, pass(sv) :: csetr => z_mumps_solver_csetr procedure, pass(sv) :: default => z_mumps_solver_default @@ -107,6 +108,7 @@ module mld_z_mumps_solver & z_mumps_solver_free, z_mumps_solver_descr, & & z_mumps_solver_sizeof, z_mumps_solver_apply_vect,& & z_mumps_solver_cseti, z_mumps_solver_csetr, & + & z_mumps_solver_csetc, & & z_mumps_solver_default, z_mumps_solver_get_fmt, & & z_mumps_solver_get_id, z_mumps_solver_is_global #if defined(HAVE_FINAL) @@ -277,6 +279,45 @@ contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine z_mumps_solver_csetc(sv,what,val,info,idx) + + Implicit None + + ! Arguments + class(mld_z_mumps_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_mumps_solver_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + select case(psb_toupper(trim(what))) +#if defined(HAVE_MUMPS_) + case('MUMPS_LOC_GLOB') + sv%ipar(1) = sv%stringval(psb_toupper(trim(val))) +#endif + case default + call sv%mld_z_base_solver_type%set(what,val,info,idx=idx) + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + end subroutine z_mumps_solver_csetc + + subroutine z_mumps_solver_cseti(sv,what,val,info,idx) Implicit None