|
|
|
@ -88,6 +88,8 @@ module mld_c_mumps_solver
|
|
|
|
|
procedure, pass(sv) :: build => c_mumps_solver_bld
|
|
|
|
|
procedure, pass(sv) :: apply_a => c_mumps_solver_apply
|
|
|
|
|
procedure, pass(sv) :: apply_v => c_mumps_solver_apply_vect
|
|
|
|
|
procedure, pass(sv) :: clone_settings => c_mumps_solver_clone_settings
|
|
|
|
|
procedure, pass(sv) :: clear_data => c_mumps_solver_clear_data
|
|
|
|
|
procedure, pass(sv) :: free => c_mumps_solver_free
|
|
|
|
|
procedure, pass(sv) :: descr => c_mumps_solver_descr
|
|
|
|
|
procedure, pass(sv) :: sizeof => c_mumps_solver_sizeof
|
|
|
|
@ -108,8 +110,9 @@ 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_csetc, c_mumps_solver_clear_data, &
|
|
|
|
|
& c_mumps_solver_default, c_mumps_solver_get_fmt, &
|
|
|
|
|
& c_mumps_solver_clone_settings, &
|
|
|
|
|
& c_mumps_solver_get_id, c_mumps_solver_is_global
|
|
|
|
|
#if defined(HAVE_FINAL)
|
|
|
|
|
private :: c_mumps_solver_finalize
|
|
|
|
@ -176,7 +179,59 @@ module mld_c_mumps_solver
|
|
|
|
|
|
|
|
|
|
contains
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_free(sv,info)
|
|
|
|
|
subroutine c_mumps_solver_clone_settings(sv,svout,info)
|
|
|
|
|
|
|
|
|
|
use psb_base_mod
|
|
|
|
|
Implicit None
|
|
|
|
|
! Arguments
|
|
|
|
|
class(mld_c_mumps_solver_type), intent(inout) :: sv
|
|
|
|
|
class(mld_c_base_solver_type), intent(inout) :: svout
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
integer(psb_ipk_) :: k,err_act
|
|
|
|
|
character(len=20) :: name='c_mumps_solver_clone_settings'
|
|
|
|
|
|
|
|
|
|
info = 0
|
|
|
|
|
|
|
|
|
|
#if defined(HAVE_MUMPS_)
|
|
|
|
|
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
|
|
|
|
|
|
select type(svout)
|
|
|
|
|
class is(mld_c_mumps_solver_type)
|
|
|
|
|
svout%ipar(:) = sv%ipar(:)
|
|
|
|
|
svout%built = .false.
|
|
|
|
|
if (allocated(svout%icntl)) deallocate(svout%icntl,stat=info)
|
|
|
|
|
if (info == 0) allocate(svout%icntl(mld_mumps_icntl_size),stat=info)
|
|
|
|
|
if (info == 0) then
|
|
|
|
|
do k=1,mld_mumps_icntl_size
|
|
|
|
|
call psb_safe_ab_cpy(sv%icntl(k)%item,svout%icntl(k)%item,info)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
if (allocated(svout%rcntl)) deallocate(svout%rcntl,stat=info)
|
|
|
|
|
if (info == 0) allocate(svout%rcntl(mld_mumps_rcntl_size),stat=info)
|
|
|
|
|
if (info == 0) then
|
|
|
|
|
do k=1,mld_mumps_rcntl_size
|
|
|
|
|
call psb_safe_ab_cpy(sv%rcntl(k)%item,svout%rcntl(k)%item,info)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
class default
|
|
|
|
|
info = psb_err_internal_error_
|
|
|
|
|
call psb_errpush(info,name)
|
|
|
|
|
goto 9999
|
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
|
call psb_erractionrestore(err_act)
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
9999 call psb_error_handler(err_act)
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
#endif
|
|
|
|
|
end subroutine c_mumps_solver_clone_settings
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_clear_data(sv,info)
|
|
|
|
|
use psb_base_mod, only : psb_exit
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
@ -184,10 +239,11 @@ contains
|
|
|
|
|
class(mld_c_mumps_solver_type), intent(inout) :: sv
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
Integer(psb_ipk_) :: err_act
|
|
|
|
|
character(len=20) :: name='c_mumps_solver_free'
|
|
|
|
|
character(len=20) :: name='c_mumps_solver_clear_data'
|
|
|
|
|
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
|
info = 0
|
|
|
|
|
#if defined(HAVE_MUMPS_)
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
|
if (allocated(sv%id)) then
|
|
|
|
|
if (sv%built) then
|
|
|
|
|
sv%id%job = -2
|
|
|
|
@ -195,19 +251,46 @@ contains
|
|
|
|
|
info = sv%id%infog(1)
|
|
|
|
|
if (info /= psb_success_) goto 9999
|
|
|
|
|
end if
|
|
|
|
|
deallocate(sv%id, sv%icntl, sv%rcntl)
|
|
|
|
|
deallocate(sv%id, stat=info)
|
|
|
|
|
if (allocated(sv%local_ictxt)) then
|
|
|
|
|
call psb_exit(sv%local_ictxt,close=.false.)
|
|
|
|
|
deallocate(sv%local_ictxt,stat=info)
|
|
|
|
|
end if
|
|
|
|
|
if (allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
|
|
|
|
|
if (allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
|
|
|
|
|
|
|
|
|
|
sv%built=.false.
|
|
|
|
|
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
|
|
|
|
|
#endif
|
|
|
|
|
end subroutine c_mumps_solver_clear_data
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_free(sv,info)
|
|
|
|
|
use psb_base_mod, only : psb_exit
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
|
! Arguments
|
|
|
|
|
class(mld_c_mumps_solver_type), intent(inout) :: sv
|
|
|
|
|
integer(psb_ipk_), intent(out) :: info
|
|
|
|
|
Integer(psb_ipk_) :: err_act
|
|
|
|
|
character(len=20) :: name='c_mumps_solver_free'
|
|
|
|
|
|
|
|
|
|
info = 0
|
|
|
|
|
#if defined(HAVE_MUMPS_)
|
|
|
|
|
call psb_erractionsave(err_act)
|
|
|
|
|
call sv%clear_data(info)
|
|
|
|
|
if ((info == 0).and.allocated(sv%icntl)) deallocate(sv%icntl,stat=info)
|
|
|
|
|
if ((info == 0).and.allocated(sv%rcntl)) deallocate(sv%rcntl,stat=info)
|
|
|
|
|
|
|
|
|
|
call psb_erractionrestore(err_act)
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
9999 continue
|
|
|
|
|
call psb_erractionrestore(err_act)
|
|
|
|
|
if (err_act == psb_act_abort_) then
|
|
|
|
@ -219,7 +302,7 @@ contains
|
|
|
|
|
end subroutine c_mumps_solver_free
|
|
|
|
|
|
|
|
|
|
#if defined(HAVE_FINAL)
|
|
|
|
|
subroutine c_mumps_solver_finalize(sv)
|
|
|
|
|
subroutine c_mumps_solver_finalize(sv)
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
@ -233,10 +316,10 @@ contains
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
end subroutine c_mumps_solver_finalize
|
|
|
|
|
end subroutine c_mumps_solver_finalize
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
|
|
|
|
|
subroutine c_mumps_solver_descr(sv,info,iout,coarse)
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
@ -272,14 +355,14 @@ contains
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
return
|
|
|
|
|
end subroutine c_mumps_solver_descr
|
|
|
|
|
end subroutine c_mumps_solver_descr
|
|
|
|
|
|
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
!! WARNING: OTHER PARAMETERS OF MUMPS COULD BE ADDED. !!
|
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_csetc(sv,what,val,info,idx)
|
|
|
|
|
subroutine c_mumps_solver_csetc(sv,what,val,info,idx)
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
@ -315,10 +398,10 @@ contains
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
return
|
|
|
|
|
end subroutine c_mumps_solver_csetc
|
|
|
|
|
end subroutine c_mumps_solver_csetc
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_cseti(sv,what,val,info,idx)
|
|
|
|
|
subroutine c_mumps_solver_cseti(sv,what,val,info,idx)
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
@ -362,9 +445,9 @@ contains
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
return
|
|
|
|
|
end subroutine c_mumps_solver_cseti
|
|
|
|
|
end subroutine c_mumps_solver_cseti
|
|
|
|
|
|
|
|
|
|
subroutine c_mumps_solver_csetr(sv,what,val,info,idx)
|
|
|
|
|
subroutine c_mumps_solver_csetr(sv,what,val,info,idx)
|
|
|
|
|
|
|
|
|
|
Implicit None
|
|
|
|
|
|
|
|
|
@ -402,10 +485,10 @@ contains
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
return
|
|
|
|
|
end subroutine c_mumps_solver_csetr
|
|
|
|
|
end subroutine c_mumps_solver_csetr
|
|
|
|
|
|
|
|
|
|
!!NOTE: BY DEFAULT BLR is activated with a dropping parameter to 1d-4 !!
|
|
|
|
|
subroutine c_mumps_solver_default(sv)
|
|
|
|
|
!!NOTE: BY DEFAULT BLR is activated with a dropping parameter to 1d-4 !!
|
|
|
|
|
subroutine c_mumps_solver_default(sv)
|
|
|
|
|
|
|
|
|
|
Implicit none
|
|
|
|
|
|
|
|
|
@ -466,9 +549,9 @@ contains
|
|
|
|
|
end if
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
end subroutine c_mumps_solver_default
|
|
|
|
|
end subroutine c_mumps_solver_default
|
|
|
|
|
|
|
|
|
|
function c_mumps_solver_sizeof(sv) result(val)
|
|
|
|
|
function c_mumps_solver_sizeof(sv) result(val)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
! Arguments
|
|
|
|
@ -484,30 +567,30 @@ contains
|
|
|
|
|
! val = val + sv%symbsize
|
|
|
|
|
! val = val + sv%numsize
|
|
|
|
|
return
|
|
|
|
|
end function c_mumps_solver_sizeof
|
|
|
|
|
end function c_mumps_solver_sizeof
|
|
|
|
|
|
|
|
|
|
function c_mumps_solver_get_fmt() result(val)
|
|
|
|
|
function c_mumps_solver_get_fmt() result(val)
|
|
|
|
|
implicit none
|
|
|
|
|
character(len=32) :: val
|
|
|
|
|
|
|
|
|
|
val = "MUMPS solver"
|
|
|
|
|
end function c_mumps_solver_get_fmt
|
|
|
|
|
end function c_mumps_solver_get_fmt
|
|
|
|
|
|
|
|
|
|
function c_mumps_solver_get_id() result(val)
|
|
|
|
|
function c_mumps_solver_get_id() result(val)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_ipk_) :: val
|
|
|
|
|
|
|
|
|
|
val = mld_mumps_
|
|
|
|
|
end function c_mumps_solver_get_id
|
|
|
|
|
end function c_mumps_solver_get_id
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
function c_mumps_solver_is_global(sv) result(val)
|
|
|
|
|
function c_mumps_solver_is_global(sv) result(val)
|
|
|
|
|
implicit none
|
|
|
|
|
class(mld_c_mumps_solver_type), intent(in) :: sv
|
|
|
|
|
logical :: val
|
|
|
|
|
|
|
|
|
|
val = (sv%ipar(1) == mld_global_solver_ )
|
|
|
|
|
end function c_mumps_solver_is_global
|
|
|
|
|
end function c_mumps_solver_is_global
|
|
|
|
|
|
|
|
|
|
end module mld_c_mumps_solver
|
|
|
|
|
|
|
|
|
|