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

Start of new interface handling for MUMPS.

Browse Source
This commit is contained in:
Salvatore Filippone
2018-10-12 09:18:01 +01:00
parent 5474accddd
commit 3d6d453fe4
9 changed files with 271 additions and 72 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/solver/mld_c_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call cmumps(sv%id)
!WARNING: CALLING cMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call cmumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/impl/solver/mld_d_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call dmumps(sv%id)
!WARNING: CALLING dMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call dmumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/impl/solver/mld_s_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call smumps(sv%id)
!WARNING: CALLING sMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call smumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/impl/solver/mld_z_mumps_solver_bld.F90
+25 -12
View File
@@ -72,9 +72,11 @@
debug_level = psb_get_debug_level()
ictxt = desc_a%get_context()
if (sv%ipar(1) < 0 ) then
call psb_info(ictxt, me, np)
call psb_info(ictxt, me, np)
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
call psb_get_mpicomm(ictxt1, icomm)
allocate(sv%local_ictxt,stat=info)
sv%local_ictxt = ictxt1
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
call psb_info(ictxt1, me, np)
npr = np
@@ -103,11 +105,22 @@
sv%id%comm = icomm
sv%id%job = -1
sv%id%par=1
sv%id%job = -1
sv%id%par = 1
call zmumps(sv%id)
!WARNING: CALLING zMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
if (allocated(sv%icntl)) then
do i=1,mld_mumps_icntl_size
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
end do
end if
if (allocated(sv%rcntl)) then
do i=1,mld_mumps_rcntl_size
if (allocated(sv%rcntl(i)%item)) sv%id%cntl(i) = sv%rcntl(i)%item
end do
end if
sv%id%icntl(3)=sv%ipar(2)
nglob = desc_a%get_global_rows()
if (sv%ipar(1) < 0) then
nglobrec=desc_a%get_local_rows()
@@ -127,10 +140,10 @@
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
end if
sv%id%irn_loc=> acoo%ia
sv%id%jcn_loc=> acoo%ja
sv%id%a_loc=> acoo%val
sv%id%icntl(18)=3
sv%id%irn_loc => acoo%ia
sv%id%jcn_loc => acoo%ja
sv%id%a_loc => acoo%val
sv%id%icntl(18) = 3
if(acoo%is_upper() .or. acoo%is_lower()) then
sv%id%sym = 2
else
@@ -138,13 +151,13 @@
end if
sv%id%n = nglob
! there should be a better way for this
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
call psb_barrier(ictxt)
sv%id%nz_loc = acoo%get_nzeros()
sv%id%nz = acoo%get_nzeros()
sv%id%job = 4
!call psb_barrier(ictxt)
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
call zmumps(sv%id)
call psb_barrier(ictxt)
!call psb_barrier(ictxt)
info = sv%id%infog(1)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
mlprec/mld_base_prec_type.F90
+3
View File
@@ -295,6 +295,9 @@ module mld_base_prec_type
integer(psb_ipk_), parameter :: mld_as_sequential_ = 40
!parameter regulating the error printing of MUMPS
integer(psb_ipk_), parameter :: mld_mumps_print_err_ = 41
! Size of the control vectors
integer, parameter :: mld_mumps_icntl_size=40
integer, parameter :: mld_mumps_rcntl_size=15
!
! Fields for sparse matrices ensembles stored in av()
mlprec/mld_c_mumps_solver.F90
+42 -6
View File
@@ -61,14 +61,25 @@ module mld_c_mumps_solver
end type mld_c_mumps_solver_type
#else
type :: mld_c_mumps_icntl_item
integer(psb_ipk_), allocatable :: item
end type mld_c_mumps_icntl_item
type :: mld_c_mumps_rcntl_item
real(psb_spk_), allocatable :: item
end type mld_c_mumps_rcntl_item
type, extends(mld_c_base_solver_type) :: mld_c_mumps_solver_type
#if defined(HAVE_MUMPS_)
type(cmumps_struc), allocatable :: id
#else
integer, allocatable :: id
#endif
integer(psb_ipk_),dimension(2) :: ipar
logical :: built=.false.
type(mld_c_mumps_icntl_item), allocatable :: icntl(:)
type(mld_c_mumps_rcntl_item), allocatable :: rcntl(:)
integer(psb_ipk_), dimension(2) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => c_mumps_solver_bld
procedure, pass(sv) :: apply_a => c_mumps_solver_apply
@@ -160,7 +171,7 @@ module mld_c_mumps_solver
contains
subroutine c_mumps_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
@@ -178,7 +189,11 @@ contains
info = sv%id%infog(1)
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id)
deallocate(sv%id, sv%icntl, sv%rcntl)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt)
end if
sv%built=.false.
end if
call psb_erractionrestore(err_act)
@@ -279,7 +294,7 @@ contains
sv%ipar(2)=val
case('MUMPS_IPAR_ENTRY')
if(present(idx)) then
sv%ipar(idx)=val
sv%icntl(idx)%item = val
end if
#endif
case default
@@ -315,6 +330,12 @@ contains
call psb_erractionsave(err_act)
select case(psb_toupper(what))
#if defined(HAVE_MUMPS_)
case('MUMPS_RPAR_ENTRY')
if(present(idx)) then
sv%rcntl(idx)%item = val
end if
#endif
case default
call sv%mld_c_base_solver_type%set(what,val,info,idx=idx)
end select
@@ -355,7 +376,22 @@ contains
end if
sv%built=.false.
end if
if (.not.allocated(sv%icntl)) then
allocate(sv%icntl(mld_mumps_icntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_cmumps_default')
goto 9999
end if
end if
if (.not.allocated(sv%rcntl)) then
allocate(sv%rcntl(mld_mumps_rcntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_cmumps_default')
goto 9999
end if
end if
! INSTANTIATION OF sv%id needed to set parmater but mpi communicator needed
! sv%id%job = -1
! sv%id%par=1
mlprec/mld_d_mumps_solver.F90
+42 -6
View File
@@ -61,14 +61,25 @@ module mld_d_mumps_solver
end type mld_d_mumps_solver_type
#else
type :: mld_d_mumps_icntl_item
integer(psb_ipk_), allocatable :: item
end type mld_d_mumps_icntl_item
type :: mld_d_mumps_rcntl_item
real(psb_dpk_), allocatable :: item
end type mld_d_mumps_rcntl_item
type, extends(mld_d_base_solver_type) :: mld_d_mumps_solver_type
#if defined(HAVE_MUMPS_)
type(dmumps_struc), allocatable :: id
#else
integer, allocatable :: id
#endif
integer(psb_ipk_),dimension(2) :: ipar
logical :: built=.false.
type(mld_d_mumps_icntl_item), allocatable :: icntl(:)
type(mld_d_mumps_rcntl_item), allocatable :: rcntl(:)
integer(psb_ipk_), dimension(2) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => d_mumps_solver_bld
procedure, pass(sv) :: apply_a => d_mumps_solver_apply
@@ -160,7 +171,7 @@ module mld_d_mumps_solver
contains
subroutine d_mumps_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
@@ -178,7 +189,11 @@ contains
info = sv%id%infog(1)
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id)
deallocate(sv%id, sv%icntl, sv%rcntl)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt)
end if
sv%built=.false.
end if
call psb_erractionrestore(err_act)
@@ -279,7 +294,7 @@ contains
sv%ipar(2)=val
case('MUMPS_IPAR_ENTRY')
if(present(idx)) then
sv%ipar(idx)=val
sv%icntl(idx)%item = val
end if
#endif
case default
@@ -315,6 +330,12 @@ contains
call psb_erractionsave(err_act)
select case(psb_toupper(what))
#if defined(HAVE_MUMPS_)
case('MUMPS_RPAR_ENTRY')
if(present(idx)) then
sv%rcntl(idx)%item = val
end if
#endif
case default
call sv%mld_d_base_solver_type%set(what,val,info,idx=idx)
end select
@@ -355,7 +376,22 @@ contains
end if
sv%built=.false.
end if
if (.not.allocated(sv%icntl)) then
allocate(sv%icntl(mld_mumps_icntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_dmumps_default')
goto 9999
end if
end if
if (.not.allocated(sv%rcntl)) then
allocate(sv%rcntl(mld_mumps_rcntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_dmumps_default')
goto 9999
end if
end if
! INSTANTIATION OF sv%id needed to set parmater but mpi communicator needed
! sv%id%job = -1
! sv%id%par=1
mlprec/mld_s_mumps_solver.F90
+42 -6
View File
@@ -61,14 +61,25 @@ module mld_s_mumps_solver
end type mld_s_mumps_solver_type
#else
type :: mld_s_mumps_icntl_item
integer(psb_ipk_), allocatable :: item
end type mld_s_mumps_icntl_item
type :: mld_s_mumps_rcntl_item
real(psb_spk_), allocatable :: item
end type mld_s_mumps_rcntl_item
type, extends(mld_s_base_solver_type) :: mld_s_mumps_solver_type
#if defined(HAVE_MUMPS_)
type(smumps_struc), allocatable :: id
#else
integer, allocatable :: id
#endif
integer(psb_ipk_),dimension(2) :: ipar
logical :: built=.false.
type(mld_s_mumps_icntl_item), allocatable :: icntl(:)
type(mld_s_mumps_rcntl_item), allocatable :: rcntl(:)
integer(psb_ipk_), dimension(2) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => s_mumps_solver_bld
procedure, pass(sv) :: apply_a => s_mumps_solver_apply
@@ -160,7 +171,7 @@ module mld_s_mumps_solver
contains
subroutine s_mumps_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
@@ -178,7 +189,11 @@ contains
info = sv%id%infog(1)
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id)
deallocate(sv%id, sv%icntl, sv%rcntl)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt)
end if
sv%built=.false.
end if
call psb_erractionrestore(err_act)
@@ -279,7 +294,7 @@ contains
sv%ipar(2)=val
case('MUMPS_IPAR_ENTRY')
if(present(idx)) then
sv%ipar(idx)=val
sv%icntl(idx)%item = val
end if
#endif
case default
@@ -315,6 +330,12 @@ contains
call psb_erractionsave(err_act)
select case(psb_toupper(what))
#if defined(HAVE_MUMPS_)
case('MUMPS_RPAR_ENTRY')
if(present(idx)) then
sv%rcntl(idx)%item = val
end if
#endif
case default
call sv%mld_s_base_solver_type%set(what,val,info,idx=idx)
end select
@@ -355,7 +376,22 @@ contains
end if
sv%built=.false.
end if
if (.not.allocated(sv%icntl)) then
allocate(sv%icntl(mld_mumps_icntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_smumps_default')
goto 9999
end if
end if
if (.not.allocated(sv%rcntl)) then
allocate(sv%rcntl(mld_mumps_rcntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_smumps_default')
goto 9999
end if
end if
! INSTANTIATION OF sv%id needed to set parmater but mpi communicator needed
! sv%id%job = -1
! sv%id%par=1
mlprec/mld_z_mumps_solver.F90
+42 -6
View File
@@ -61,14 +61,25 @@ module mld_z_mumps_solver
end type mld_z_mumps_solver_type
#else
type :: mld_z_mumps_icntl_item
integer(psb_ipk_), allocatable :: item
end type mld_z_mumps_icntl_item
type :: mld_z_mumps_rcntl_item
real(psb_dpk_), allocatable :: item
end type mld_z_mumps_rcntl_item
type, extends(mld_z_base_solver_type) :: mld_z_mumps_solver_type
#if defined(HAVE_MUMPS_)
type(zmumps_struc), allocatable :: id
#else
integer, allocatable :: id
#endif
integer(psb_ipk_),dimension(2) :: ipar
logical :: built=.false.
type(mld_z_mumps_icntl_item), allocatable :: icntl(:)
type(mld_z_mumps_rcntl_item), allocatable :: rcntl(:)
integer(psb_ipk_), dimension(2) :: ipar
integer(psb_ipk_), allocatable :: local_ictxt
logical :: built = .false.
contains
procedure, pass(sv) :: build => z_mumps_solver_bld
procedure, pass(sv) :: apply_a => z_mumps_solver_apply
@@ -160,7 +171,7 @@ module mld_z_mumps_solver
contains
subroutine z_mumps_solver_free(sv,info)
use psb_base_mod, only : psb_exit
Implicit None
! Arguments
@@ -178,7 +189,11 @@ contains
info = sv%id%infog(1)
if (info /= psb_success_) goto 9999
end if
deallocate(sv%id)
deallocate(sv%id, sv%icntl, sv%rcntl)
if (allocated(sv%local_ictxt)) then
call psb_exit(sv%local_ictxt,close=.false.)
deallocate(sv%local_ictxt)
end if
sv%built=.false.
end if
call psb_erractionrestore(err_act)
@@ -279,7 +294,7 @@ contains
sv%ipar(2)=val
case('MUMPS_IPAR_ENTRY')
if(present(idx)) then
sv%ipar(idx)=val
sv%icntl(idx)%item = val
end if
#endif
case default
@@ -315,6 +330,12 @@ contains
call psb_erractionsave(err_act)
select case(psb_toupper(what))
#if defined(HAVE_MUMPS_)
case('MUMPS_RPAR_ENTRY')
if(present(idx)) then
sv%rcntl(idx)%item = val
end if
#endif
case default
call sv%mld_z_base_solver_type%set(what,val,info,idx=idx)
end select
@@ -355,7 +376,22 @@ contains
end if
sv%built=.false.
end if
if (.not.allocated(sv%icntl)) then
allocate(sv%icntl(mld_mumps_icntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_zmumps_default')
goto 9999
end if
end if
if (.not.allocated(sv%rcntl)) then
allocate(sv%rcntl(mld_mumps_rcntl_size),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name,a_err='mld_zmumps_default')
goto 9999
end if
end if
! INSTANTIATION OF sv%id needed to set parmater but mpi communicator needed
! sv%id%job = -1
! sv%id%par=1