Fix CSETC for MUMPS

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

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

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

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