fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-20 12:52:16 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fix CSETC for MUMPS

Browse Source
This commit is contained in:
Salvatore Filippone
2020-04-29 12:28:36 +02:00
parent 825037761f
commit c49301de12
4 changed files with 164 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_c_mumps_solver.F90
+41
View File
@@ -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
+41
View File
@@ -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
+41
View File
@@ -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
+41
View File
@@ -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