fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/impl/solver/mld_c_base_solver_apply.f90
 mlprec/impl/solver/mld_c_base_solver_apply_vect.f90
 mlprec/impl/solver/mld_d_base_solver_apply_vect.f90
 mlprec/impl/solver/mld_s_base_solver_apply.f90
 mlprec/impl/solver/mld_s_base_solver_apply_vect.f90
 mlprec/impl/solver/mld_z_base_solver_apply.f90
 mlprec/impl/solver/mld_z_base_solver_apply_vect.f90
 mlprec/mld_c_slu_solver.F90
 mlprec/mld_c_sludist_solver.F90
 mlprec/mld_c_umf_solver.F90
 mlprec/mld_d_slu_solver.F90
 mlprec/mld_d_sludist_solver.F90
 mlprec/mld_d_umf_solver.F90
 mlprec/mld_s_slu_solver.F90
 mlprec/mld_s_sludist_solver.F90
 mlprec/mld_s_umf_solver.F90
 mlprec/mld_z_slu_solver.F90
 mlprec/mld_z_sludist_solver.F90
 mlprec/mld_z_umf_solver.F90

Fixed UMF/SLU/SLUDIST and apply_vect.
stopcriterion
Salvatore Filippone 12 years ago
parent c9dc04a7a0
commit cdfa7497d8
19 changed files with 897 additions and 75 deletions
Show Stats Download Patch File Download Diff File

2
mlprec/impl/solver/mld_c_base_solver_apply.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_c_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='c_base_solver_apply'
call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_c_base_solver_apply_vect.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='c_base_solver_apply_vect'
call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_d_base_solver_apply_vect.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='d_base_solver_apply_vect'
call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_s_base_solver_apply.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_s_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='s_base_solver_apply'
call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_s_base_solver_apply_vect.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='s_base_solver_apply_vect'
call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_z_base_solver_apply.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_z_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='z_base_solver_apply'
call psb_erractionsave(err_act)

2
mlprec/impl/solver/mld_z_base_solver_apply_vect.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_apply'
character(len=20) :: name='z_base_solver_apply_vect'
call psb_erractionsave(err_act)

74
mlprec/mld_c_slu_solver.F90
Unescape Escape View File

@ -49,23 +49,36 @@ module mld_c_slu_solver
use mld_c_base_solver_mod
#if defined(LONG_INTEGERS)
type, extends(mld_c_base_solver_type) :: mld_c_slu_solver_type
end type mld_c_slu_solver_type
#else
#else
type, extends(mld_c_base_solver_type) :: mld_c_slu_solver_type
type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => c_slu_solver_bld
procedure, pass(sv) :: apply_a => c_slu_solver_apply
procedure, pass(sv) :: apply_v => c_slu_solver_apply_vect
procedure, pass(sv) :: free => c_slu_solver_free
procedure, pass(sv) :: descr => c_slu_solver_descr
procedure, pass(sv) :: sizeof => c_slu_solver_sizeof
#if defined(HAVE_FINAL)
final :: c_slu_solver_finalize
#endif
end type mld_c_slu_solver_type
private :: c_slu_solver_bld, c_slu_solver_apply, &
& c_slu_solver_free, c_slu_solver_descr, c_slu_solver_sizeof
& c_slu_solver_free, c_slu_solver_descr, &
& c_slu_solver_sizeof, c_slu_solver_apply_vect
#if defined(HAVE_FINAL)
private :: c_slu_solver_finalize
#endif
interface
@ -75,7 +88,6 @@ module mld_c_slu_solver
use iso_c_binding
integer(c_int), value :: n,nnz
integer(c_int) :: info
!integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowptr(*),colind(*)
complex(c_float_complex) :: values(*)
type(c_ptr) :: lufactors
@ -186,6 +198,44 @@ contains
return
end subroutine c_slu_solver_apply
subroutine c_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_slu_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='c_slu_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_slu_solver_apply_vect
subroutine c_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
@ -299,6 +349,24 @@ contains
return
end subroutine c_slu_solver_free
#if defined(HAVE_FINAL)
subroutine c_slu_solver_finalize(sv)
Implicit None
! Arguments
type(mld_c_slu_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='c_slu_solver_finalize'
call sv%free(info)
return
end subroutine c_slu_solver_finalize
#endif
subroutine c_slu_solver_descr(sv,info,iout,coarse)
Implicit None

73
mlprec/mld_c_sludist_solver.F90
Unescape Escape View File

@ -48,27 +48,34 @@ module mld_c_sludist_solver
use iso_c_binding
use mld_c_base_solver_mod
#if defined(LONG_INTEGERS)
#if defined(LONG_INTEGERS)
type, extends(mld_c_base_solver_type) :: mld_c_sludist_solver_type
end type mld_c_sludist_solver_type
#else
end type mld_c_sludist_solver_type
#else
type, extends(mld_c_base_solver_type) :: mld_c_sludist_solver_type
type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => c_sludist_solver_bld
procedure, pass(sv) :: apply_a => c_sludist_solver_apply
procedure, pass(sv) :: apply_v => c_sludist_solver_apply_vect
procedure, pass(sv) :: free => c_sludist_solver_free
procedure, pass(sv) :: descr => c_sludist_solver_descr
procedure, pass(sv) :: sizeof => c_sludist_solver_sizeof
#if defined(HAVE_FINAL)
final :: c_sludist_solver_finalize
#endif
end type mld_c_sludist_solver_type
private :: c_sludist_solver_bld, c_sludist_solver_apply, &
& c_sludist_solver_free, c_sludist_solver_descr, c_sludist_solver_sizeof
& c_sludist_solver_free, c_sludist_solver_descr, &
& c_sludist_solver_sizeof, c_sludist_solver_apply_vect
#if defined(HAVE_FINAL)
private :: c_sludist_solver_finalize
#endif
interface
@ -190,6 +197,44 @@ contains
end subroutine c_sludist_solver_apply
subroutine c_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_sludist_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='c_sludist_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_sludist_solver_apply_vect
subroutine c_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -306,6 +351,24 @@ contains
return
end subroutine c_sludist_solver_free
#if defined(HAVE_FINAL)
subroutine c_sludist_solver_finalize(sv)
Implicit None
! Arguments
type(mld_c_sludist_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='c_sludist_solver_finalize'
call sv%free(info)
return
end subroutine c_sludist_solver_finalize
#endif
subroutine c_sludist_solver_descr(sv,info,iout,coarse)
Implicit None

90
mlprec/mld_c_umf_solver.F90
Unescape Escape View File

@ -50,22 +50,34 @@ module mld_c_umf_solver
#if defined(LONG_INTEGERS)
type, extends(mld_c_base_solver_type) :: mld_c_umf_solver_type
end type mld_c_umf_solver_type
#else
#else
type, extends(mld_c_base_solver_type) :: mld_c_umf_solver_type
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => c_umf_solver_bld
procedure, pass(sv) :: apply_a => c_umf_solver_apply
procedure, pass(sv) :: apply_v => c_umf_solver_apply_vect
procedure, pass(sv) :: free => c_umf_solver_free
procedure, pass(sv) :: descr => c_umf_solver_descr
procedure, pass(sv) :: sizeof => c_umf_solver_sizeof
#if defined(HAVE_FINAL)
final :: c_umf_solver_finalize
#endif
end type mld_c_umf_solver_type
private :: c_umf_solver_bld, c_umf_solver_apply, &
& c_umf_solver_free, c_umf_solver_descr, c_umf_solver_sizeof
& c_umf_solver_free, c_umf_solver_descr, &
& c_umf_solver_sizeof, c_umf_solver_apply_vect
#if defined(HAVE_FINAL)
private :: c_umf_solver_finalize
#endif
interface
@ -154,9 +166,17 @@ contains
case('N')
info = mld_cumf_solve(0,n_row,ww,x,n_row,sv%numeric)
case('T')
info = mld_cumf_solve(1,n_row,ww,x,n_row,sv%numeric)
!
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
! even for complex data.
!
if (psb_c_is_complex_) then
info = mld_cumf_solve(2,n_row,ww,x,n_row,sv%numeric)
else
info = mld_cumf_solve(1,n_row,ww,x,n_row,sv%numeric)
end if
case('C')
info = mld_cumf_solve(2,n_row,ww,x,n_row,sv%numeric)
info = mld_cumf_solve(1,n_row,ww,x,n_row,sv%numeric)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
@ -187,6 +207,44 @@ contains
end subroutine c_umf_solver_apply
subroutine c_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_umf_solver_type), intent(inout) :: sv
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='c_umf_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_umf_solver_apply_vect
subroutine c_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -248,9 +306,9 @@ contains
call atmp%free()
else
! ?
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
@ -302,6 +360,24 @@ contains
return
end subroutine c_umf_solver_free
#if defined(HAVE_FINAL)
subroutine c_umf_solver_finalize(sv)
Implicit None
! Arguments
type(mld_c_umf_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='c_umf_solver_finalize'
call sv%free(info)
return
end subroutine c_umf_solver_finalize
#endif
subroutine c_umf_solver_descr(sv,info,iout,coarse)
Implicit None

78
mlprec/mld_d_slu_solver.F90
Unescape Escape View File

@ -47,27 +47,38 @@ module mld_d_slu_solver
use iso_c_binding
use mld_d_base_solver_mod
#if defined(LONG_INTEGERS)
type, extends(mld_d_base_solver_type) :: mld_d_slu_solver_type
end type mld_d_slu_solver_type
#else
#else
type, extends(mld_d_base_solver_type) :: mld_d_slu_solver_type
type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => d_slu_solver_bld
procedure, pass(sv) :: apply_a => d_slu_solver_apply
procedure, pass(sv) :: apply_v => d_slu_solver_apply_vect
procedure, pass(sv) :: free => d_slu_solver_free
procedure, pass(sv) :: descr => d_slu_solver_descr
procedure, pass(sv) :: sizeof => d_slu_solver_sizeof
#if defined(HAVE_FINAL)
final :: d_slu_solver_finalize
#endif
end type mld_d_slu_solver_type
private :: d_slu_solver_bld, d_slu_solver_apply, &
& d_slu_solver_free, d_slu_solver_descr, d_slu_solver_sizeof
& d_slu_solver_free, d_slu_solver_descr, &
& d_slu_solver_sizeof, d_slu_solver_apply_vect
#if defined(HAVE_FINAL)
private :: d_slu_solver_finalize
#endif
interface
@ -77,7 +88,6 @@ module mld_d_slu_solver
use iso_c_binding
integer(c_int), value :: n,nnz
integer(c_int) :: info
!integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowptr(*),colind(*)
real(c_double) :: values(*)
type(c_ptr) :: lufactors
@ -155,8 +165,10 @@ contains
select case(trans_)
case('N')
info = mld_dslu_solve(0,n_row,ww,x,n_row,sv%lufactors)
case('T','C')
case('T')
info = mld_dslu_solve(1,n_row,ww,x,n_row,sv%lufactors)
case('C')
info = mld_dslu_solve(2,n_row,ww,x,n_row,sv%lufactors)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
@ -186,6 +198,44 @@ contains
return
end subroutine d_slu_solver_apply
subroutine d_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_slu_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='d_slu_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_slu_solver_apply_vect
subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
@ -299,6 +349,24 @@ contains
return
end subroutine d_slu_solver_free
#if defined(HAVE_FINAL)
subroutine d_slu_solver_finalize(sv)
Implicit None
! Arguments
type(mld_d_slu_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='d_slu_solver_finalize'
call sv%free(info)
return
end subroutine d_slu_solver_finalize
#endif
subroutine d_slu_solver_descr(sv,info,iout,coarse)
Implicit None

77
mlprec/mld_d_sludist_solver.F90
Unescape Escape View File

@ -51,24 +51,31 @@ module mld_d_sludist_solver
#if defined(LONG_INTEGERS)
type, extends(mld_d_base_solver_type) :: mld_d_sludist_solver_type
end type mld_d_sludist_solver_type
end type mld_d_sludist_solver_type
#else
type, extends(mld_d_base_solver_type) :: mld_d_sludist_solver_type
type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => d_sludist_solver_bld
procedure, pass(sv) :: apply_a => d_sludist_solver_apply
procedure, pass(sv) :: apply_v => d_sludist_solver_apply_vect
procedure, pass(sv) :: free => d_sludist_solver_free
procedure, pass(sv) :: descr => d_sludist_solver_descr
procedure, pass(sv) :: sizeof => d_sludist_solver_sizeof
#if defined(HAVE_FINAL)
final :: d_sludist_solver_finalize
#endif
end type mld_d_sludist_solver_type
private :: d_sludist_solver_bld, d_sludist_solver_apply, &
& d_sludist_solver_free, d_sludist_solver_descr, d_sludist_solver_sizeof
& d_sludist_solver_free, d_sludist_solver_descr, &
& d_sludist_solver_sizeof, d_sludist_solver_apply_vect
#if defined(HAVE_FINAL)
private :: d_sludist_solver_finalize
#endif
interface
@ -80,7 +87,7 @@ module mld_d_sludist_solver
integer(c_int) :: info
!integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowptr(*),colind(*)
real(c_double) :: values(*)
real(c_double) :: values(*)
type(c_ptr) :: lufactors
end function mld_dsludist_fact
end interface
@ -91,7 +98,7 @@ module mld_d_sludist_solver
use iso_c_binding
integer(c_int) :: info
integer(c_int), value :: itrans,n,ldb
real(c_double) :: x(*), b(ldb,*)
real(c_double) :: x(*), b(ldb,*)
type(c_ptr), value :: lufactors
end function mld_dsludist_solve
end interface
@ -156,8 +163,10 @@ contains
select case(trans_)
case('N')
info = mld_dsludist_solve(0,n_row,ww,x,n_row,sv%lufactors)
case('T','C')
case('T')
info = mld_dsludist_solve(1,n_row,ww,x,n_row,sv%lufactors)
case('C')
info = mld_dsludist_solve(2,n_row,ww,x,n_row,sv%lufactors)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
@ -188,6 +197,44 @@ contains
end subroutine d_sludist_solver_apply
subroutine d_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_sludist_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='d_sludist_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_sludist_solver_apply_vect
subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -304,6 +351,24 @@ contains
return
end subroutine d_sludist_solver_free
#if defined(HAVE_FINAL)
subroutine d_sludist_solver_finalize(sv)
Implicit None
! Arguments
type(mld_d_sludist_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='d_sludist_solver_finalize'
call sv%free(info)
return
end subroutine d_sludist_solver_finalize
#endif
subroutine d_sludist_solver_descr(sv,info,iout,coarse)
Implicit None

94
mlprec/mld_d_umf_solver.F90
Unescape Escape View File

@ -49,25 +49,35 @@ module mld_d_umf_solver
use mld_d_base_solver_mod
#if defined(LONG_INTEGERS)
type, extends(mld_d_base_solver_type) :: mld_d_umf_solver_type
end type mld_d_umf_solver_type
#else
type, extends(mld_d_base_solver_type) :: mld_d_umf_solver_type
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => d_umf_solver_bld
procedure, pass(sv) :: apply_a => d_umf_solver_apply
procedure, pass(sv) :: apply_v => d_umf_solver_apply_vect
procedure, pass(sv) :: free => d_umf_solver_free
procedure, pass(sv) :: descr => d_umf_solver_descr
procedure, pass(sv) :: sizeof => d_umf_solver_sizeof
#if defined(HAVE_FINAL)
final :: d_umf_solver_finalize
#endif
end type mld_d_umf_solver_type
private :: d_umf_solver_bld, d_umf_solver_apply, &
& d_umf_solver_free, d_umf_solver_descr, d_umf_solver_sizeof
& d_umf_solver_free, d_umf_solver_descr, &
& d_umf_solver_sizeof, d_umf_solver_apply_vect
#if defined(HAVE_FINAL)
private :: d_umf_solver_finalize
#endif
interface
@ -79,7 +89,7 @@ module mld_d_umf_solver
integer(c_int) :: info
integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowind(*),colptr(*)
real(c_double) :: values(*)
real(c_double) :: values(*)
type(c_ptr) :: symptr, numptr
end function mld_dumf_fact
end interface
@ -90,7 +100,7 @@ module mld_d_umf_solver
use iso_c_binding
integer(c_int) :: info
integer(c_int), value :: itrans,n,ldb
real(c_double) :: x(*), b(ldb,*)
real(c_double) :: x(*), b(ldb,*)
type(c_ptr), value :: numptr
end function mld_dumf_solve
end interface
@ -155,7 +165,17 @@ contains
select case(trans_)
case('N')
info = mld_dumf_solve(0,n_row,ww,x,n_row,sv%numeric)
case('T','C')
case('T')
!
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
! even for complex data.
!
if (psb_d_is_complex_) then
info = mld_dumf_solve(2,n_row,ww,x,n_row,sv%numeric)
else
info = mld_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
end if
case('C')
info = mld_dumf_solve(1,n_row,ww,x,n_row,sv%numeric)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
@ -187,6 +207,44 @@ contains
end subroutine d_umf_solver_apply
subroutine d_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_umf_solver_type), intent(inout) :: sv
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='d_umf_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_umf_solver_apply_vect
subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -248,9 +306,9 @@ contains
call atmp%free()
else
! ?
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
@ -302,6 +360,24 @@ contains
return
end subroutine d_umf_solver_free
#if defined(HAVE_FINAL)
subroutine d_umf_solver_finalize(sv)
Implicit None
! Arguments
type(mld_d_umf_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='d_umf_solver_finalize'
call sv%free(info)
return
end subroutine d_umf_solver_finalize
#endif
subroutine d_umf_solver_descr(sv,info,iout,coarse)
Implicit None
@ -348,7 +424,7 @@ contains
integer(psb_long_int_k_) :: val
integer :: i
val = 2*psb_sizeof_int + psb_sizeof_dp
val = 2*psb_sizeof_long_int
val = val + sv%symbsize
val = val + sv%numsize
return

78
mlprec/mld_s_slu_solver.F90
Unescape Escape View File

@ -49,27 +49,36 @@ module mld_s_slu_solver
use mld_s_base_solver_mod
#if defined(LONG_INTEGERS)
type, extends(mld_s_base_solver_type) :: mld_s_slu_solver_type
end type mld_s_slu_solver_type
#else
#else
type, extends(mld_s_base_solver_type) :: mld_s_slu_solver_type
type(c_ptr) :: lufactors=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => s_slu_solver_bld
procedure, pass(sv) :: apply_a => s_slu_solver_apply
procedure, pass(sv) :: apply_v => s_slu_solver_apply_vect
procedure, pass(sv) :: free => s_slu_solver_free
procedure, pass(sv) :: descr => s_slu_solver_descr
procedure, pass(sv) :: sizeof => s_slu_solver_sizeof
#if defined(HAVE_FINAL)
final :: s_slu_solver_finalize
#endif
end type mld_s_slu_solver_type
private :: s_slu_solver_bld, s_slu_solver_apply, &
& s_slu_solver_free, s_slu_solver_descr, s_slu_solver_sizeof
& s_slu_solver_free, s_slu_solver_descr, &
& s_slu_solver_sizeof, s_slu_solver_apply_vect
#if defined(HAVE_FINAL)
private :: s_slu_solver_finalize
#endif
interface
@ -79,7 +88,6 @@ module mld_s_slu_solver
use iso_c_binding
integer(c_int), value :: n,nnz
integer(c_int) :: info
!integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowptr(*),colind(*)
real(c_float) :: values(*)
type(c_ptr) :: lufactors
@ -157,8 +165,10 @@ contains
select case(trans_)
case('N')
info = mld_sslu_solve(0,n_row,ww,x,n_row,sv%lufactors)
case('T','C')
case('T')
info = mld_sslu_solve(1,n_row,ww,x,n_row,sv%lufactors)
case('C')
info = mld_sslu_solve(2,n_row,ww,x,n_row,sv%lufactors)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
@ -188,6 +198,44 @@ contains
return
end subroutine s_slu_solver_apply
subroutine s_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_slu_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='s_slu_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_slu_solver_apply_vect
subroutine s_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
@ -301,6 +349,24 @@ contains
return
end subroutine s_slu_solver_free
#if defined(HAVE_FINAL)
subroutine s_slu_solver_finalize(sv)
Implicit None
! Arguments
type(mld_s_slu_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='s_slu_solver_finalize'
call sv%free(info)
return
end subroutine s_slu_solver_finalize
#endif
subroutine s_slu_solver_descr(sv,info,iout,coarse)
Implicit None

79
mlprec/mld_s_sludist_solver.F90
Unescape Escape View File

@ -46,14 +46,13 @@
module mld_s_sludist_solver
use iso_c_binding
use mld_s_prec_type
use mld_s_base_solver_mod
#if defined(LONG_INTEGERS)
type, extends(mld_s_base_solver_type) :: mld_s_sludist_solver_type
end type mld_s_sludist_solver_type
#else
type, extends(mld_s_base_solver_type) :: mld_s_sludist_solver_type
type(c_ptr) :: lufactors=c_null_ptr
@ -61,14 +60,22 @@ module mld_s_sludist_solver
contains
procedure, pass(sv) :: build => s_sludist_solver_bld
procedure, pass(sv) :: apply_a => s_sludist_solver_apply
procedure, pass(sv) :: apply_v => s_sludist_solver_apply_vect
procedure, pass(sv) :: free => s_sludist_solver_free
procedure, pass(sv) :: descr => s_sludist_solver_descr
procedure, pass(sv) :: sizeof => s_sludist_solver_sizeof
#if defined(HAVE_FINAL)
final :: s_sludist_solver_finalize
#endif
end type mld_s_sludist_solver_type
private :: s_sludist_solver_bld, s_sludist_solver_apply, &
& s_sludist_solver_free, s_sludist_solver_descr, s_sludist_solver_sizeof
& s_sludist_solver_free, s_sludist_solver_descr, &
& s_sludist_solver_sizeof, s_sludist_solver_apply_vect
#if defined(HAVE_FINAL)
private :: s_sludist_solver_finalize
#endif
interface
@ -80,7 +87,7 @@ module mld_s_sludist_solver
integer(c_int) :: info
!integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowptr(*),colind(*)
real(c_float) :: values(*)
real(c_float) :: values(*)
type(c_ptr) :: lufactors
end function mld_ssludist_fact
end interface
@ -91,7 +98,7 @@ module mld_s_sludist_solver
use iso_c_binding
integer(c_int) :: info
integer(c_int), value :: itrans,n,ldb
real(c_float) :: x(*), b(ldb,*)
real(c_float) :: x(*), b(ldb,*)
type(c_ptr), value :: lufactors
end function mld_ssludist_solve
end interface
@ -156,8 +163,10 @@ contains
select case(trans_)
case('N')
info = mld_ssludist_solve(0,n_row,ww,x,n_row,sv%lufactors)
case('T','C')
case('T')
info = mld_ssludist_solve(1,n_row,ww,x,n_row,sv%lufactors)
case('C')
info = mld_ssludist_solve(2,n_row,ww,x,n_row,sv%lufactors)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
@ -188,6 +197,44 @@ contains
end subroutine s_sludist_solver_apply
subroutine s_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_sludist_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='s_sludist_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_sludist_solver_apply_vect
subroutine s_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -304,6 +351,24 @@ contains
return
end subroutine s_sludist_solver_free
#if defined(HAVE_FINAL)
subroutine s_sludist_solver_finalize(sv)
Implicit None
! Arguments
type(mld_s_sludist_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='s_sludist_solver_finalize'
call sv%free(info)
return
end subroutine s_sludist_solver_finalize
#endif
subroutine s_sludist_solver_descr(sv,info,iout,coarse)
Implicit None

96
mlprec/mld_s_umf_solver.F90
Unescape Escape View File

@ -49,27 +49,35 @@ module mld_s_umf_solver
use mld_s_base_solver_mod
#if defined(LONG_INTEGERS)
type, extends(mld_s_base_solver_type) :: mld_s_umf_solver_type
end type mld_s_umf_solver_type
#else
#else
type, extends(mld_s_base_solver_type) :: mld_s_umf_solver_type
type(c_ptr) :: symbolic=c_null_ptr, numeric=c_null_ptr
integer(c_long_long) :: symbsize=0, numsize=0
contains
procedure, pass(sv) :: build => s_umf_solver_bld
procedure, pass(sv) :: apply_a => s_umf_solver_apply
procedure, pass(sv) :: apply_v => s_umf_solver_apply_vect
procedure, pass(sv) :: free => s_umf_solver_free
procedure, pass(sv) :: descr => s_umf_solver_descr
procedure, pass(sv) :: sizeof => s_umf_solver_sizeof
#if defined(HAVE_FINAL)
final :: s_umf_solver_finalize
#endif
end type mld_s_umf_solver_type
private :: s_umf_solver_bld, s_umf_solver_apply, &
& s_umf_solver_free, s_umf_solver_descr, s_umf_solver_sizeof
& s_umf_solver_free, s_umf_solver_descr, &
& s_umf_solver_sizeof, s_umf_solver_apply_vect
#if defined(HAVE_FINAL)
private :: s_umf_solver_finalize
#endif
interface
@ -81,7 +89,7 @@ module mld_s_umf_solver
integer(c_int) :: info
integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowind(*),colptr(*)
real(c_float) :: values(*)
real(c_float) :: values(*)
type(c_ptr) :: symptr, numptr
end function mld_sumf_fact
end interface
@ -92,7 +100,7 @@ module mld_s_umf_solver
use iso_c_binding
integer(c_int) :: info
integer(c_int), value :: itrans,n,ldb
real(c_float) :: x(*), b(ldb,*)
real(c_float) :: x(*), b(ldb,*)
type(c_ptr), value :: numptr
end function mld_sumf_solve
end interface
@ -157,7 +165,17 @@ contains
select case(trans_)
case('N')
info = mld_sumf_solve(0,n_row,ww,x,n_row,sv%numeric)
case('T','C')
case('T')
!
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
! even for complex data.
!
if (psb_s_is_complex_) then
info = mld_sumf_solve(2,n_row,ww,x,n_row,sv%numeric)
else
info = mld_sumf_solve(1,n_row,ww,x,n_row,sv%numeric)
end if
case('C')
info = mld_sumf_solve(1,n_row,ww,x,n_row,sv%numeric)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
@ -189,6 +207,44 @@ contains
end subroutine s_umf_solver_apply
subroutine s_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_umf_solver_type), intent(inout) :: sv
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='s_umf_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_umf_solver_apply_vect
subroutine s_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -250,9 +306,9 @@ contains
call atmp%free()
else
! ?
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
@ -304,6 +360,24 @@ contains
return
end subroutine s_umf_solver_free
#if defined(HAVE_FINAL)
subroutine s_umf_solver_finalize(sv)
Implicit None
! Arguments
type(mld_s_umf_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='s_umf_solver_finalize'
call sv%free(info)
return
end subroutine s_umf_solver_finalize
#endif
subroutine s_umf_solver_descr(sv,info,iout,coarse)
Implicit None
@ -350,7 +424,7 @@ contains
integer(psb_long_int_k_) :: val
integer :: i
val = 2*psb_sizeof_int + psb_sizeof_dp
val = 2*psb_sizeof_long_int
val = val + sv%symbsize
val = val + sv%numsize
return

68
mlprec/mld_z_slu_solver.F90
Unescape Escape View File

@ -62,14 +62,23 @@ module mld_z_slu_solver
contains
procedure, pass(sv) :: build => z_slu_solver_bld
procedure, pass(sv) :: apply_a => z_slu_solver_apply
procedure, pass(sv) :: apply_v => z_slu_solver_apply_vect
procedure, pass(sv) :: free => z_slu_solver_free
procedure, pass(sv) :: descr => z_slu_solver_descr
procedure, pass(sv) :: sizeof => z_slu_solver_sizeof
#if defined(HAVE_FINAL)
final :: z_slu_solver_finalize
#endif
end type mld_z_slu_solver_type
private :: z_slu_solver_bld, z_slu_solver_apply, &
& z_slu_solver_free, z_slu_solver_descr, z_slu_solver_sizeof
& z_slu_solver_free, z_slu_solver_descr, &
& z_slu_solver_sizeof, z_slu_solver_apply_vect
#if defined(HAVE_FINAL)
private :: z_slu_solver_finalize
#endif
interface
@ -79,7 +88,6 @@ module mld_z_slu_solver
use iso_c_binding
integer(c_int), value :: n,nnz
integer(c_int) :: info
!integer(c_long_long) :: ssize, nsize
integer(c_int) :: rowptr(*),colind(*)
complex(c_double_complex) :: values(*)
type(c_ptr) :: lufactors
@ -190,6 +198,44 @@ contains
return
end subroutine z_slu_solver_apply
subroutine z_slu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_slu_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='z_slu_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_slu_solver_apply_vect
subroutine z_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
@ -303,6 +349,24 @@ contains
return
end subroutine z_slu_solver_free
#if defined(HAVE_FINAL)
subroutine z_slu_solver_finalize(sv)
Implicit None
! Arguments
type(mld_z_slu_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='z_slu_solver_finalize'
call sv%free(info)
return
end subroutine z_slu_solver_finalize
#endif
subroutine z_slu_solver_descr(sv,info,iout,coarse)
Implicit None

66
mlprec/mld_z_sludist_solver.F90
Unescape Escape View File

@ -60,14 +60,22 @@ module mld_z_sludist_solver
contains
procedure, pass(sv) :: build => z_sludist_solver_bld
procedure, pass(sv) :: apply_a => z_sludist_solver_apply
procedure, pass(sv) :: apply_v => z_sludist_solver_apply_vect
procedure, pass(sv) :: free => z_sludist_solver_free
procedure, pass(sv) :: descr => z_sludist_solver_descr
procedure, pass(sv) :: sizeof => z_sludist_solver_sizeof
#if defined(HAVE_FINAL)
final :: z_sludist_solver_finalize
#endif
end type mld_z_sludist_solver_type
private :: z_sludist_solver_bld, z_sludist_solver_apply, &
& z_sludist_solver_free, z_sludist_solver_descr, z_sludist_solver_sizeof
& z_sludist_solver_free, z_sludist_solver_descr, &
& z_sludist_solver_sizeof, z_sludist_solver_apply_vect
#if defined(HAVE_FINAL)
private :: z_sludist_solver_finalize
#endif
interface
@ -189,6 +197,44 @@ contains
end subroutine z_sludist_solver_apply
subroutine z_sludist_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_sludist_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='z_sludist_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_sludist_solver_apply_vect
subroutine z_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -305,6 +351,24 @@ contains
return
end subroutine z_sludist_solver_free
#if defined(HAVE_FINAL)
subroutine z_sludist_solver_finalize(sv)
Implicit None
! Arguments
type(mld_z_sludist_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='z_sludist_solver_finalize'
call sv%free(info)
return
end subroutine z_sludist_solver_finalize
#endif
subroutine z_sludist_solver_descr(sv,info,iout,coarse)
Implicit None

85
mlprec/mld_z_umf_solver.F90
Unescape Escape View File

@ -61,14 +61,23 @@ module mld_z_umf_solver
contains
procedure, pass(sv) :: build => z_umf_solver_bld
procedure, pass(sv) :: apply_a => z_umf_solver_apply
procedure, pass(sv) :: apply_v => z_umf_solver_apply_vect
procedure, pass(sv) :: free => z_umf_solver_free
procedure, pass(sv) :: descr => z_umf_solver_descr
procedure, pass(sv) :: sizeof => z_umf_solver_sizeof
#if defined(HAVE_FINAL)
final :: z_umf_solver_finalize
#endif
end type mld_z_umf_solver_type
private :: z_umf_solver_bld, z_umf_solver_apply, &
& z_umf_solver_free, z_umf_solver_descr, z_umf_solver_sizeof
& z_umf_solver_free, z_umf_solver_descr, &
& z_umf_solver_sizeof, z_umf_solver_apply_vect
#if defined(HAVE_FINAL)
private :: z_umf_solver_finalize
#endif
interface
@ -157,9 +166,17 @@ contains
case('N')
info = mld_zumf_solve(0,n_row,ww,x,n_row,sv%numeric)
case('T')
info = mld_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
!
! Note: with UMF, 1 meand Ctranspose, 2 means transpose
! even for complex data.
!
if (psb_z_is_complex_) then
info = mld_zumf_solve(2,n_row,ww,x,n_row,sv%numeric)
else
info = mld_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
end if
case('C')
info = mld_zumf_solve(2,n_row,ww,x,n_row,sv%numeric)
info = mld_zumf_solve(1,n_row,ww,x,n_row,sv%numeric)
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve')
goto 9999
@ -190,6 +207,44 @@ contains
end subroutine z_umf_solver_apply
subroutine z_umf_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod
implicit none
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_umf_solver_type), intent(inout) :: sv
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer :: err_act
character(len=20) :: name='z_umf_solver_apply_vect'
call psb_erractionsave(err_act)
info = psb_success_
call x%v%sync()
call y%v%sync()
call sv%apply(alpha,x%v%v,beta,y%v%v,desc_data,trans,work,info)
call y%v%set_host()
if (info /= 0) goto 9999
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_umf_solver_apply_vect
subroutine z_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
use psb_base_mod
@ -251,9 +306,9 @@ contains
call atmp%free()
else
! ?
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
info=psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
@ -305,6 +360,24 @@ contains
return
end subroutine z_umf_solver_free
#if defined(HAVE_FINAL)
subroutine z_umf_solver_finalize(sv)
Implicit None
! Arguments
type(mld_z_umf_solver_type), intent(inout) :: sv
integer :: info
Integer :: err_act
character(len=20) :: name='z_umf_solver_finalize'
call sv%free(info)
return
end subroutine z_umf_solver_finalize
#endif
subroutine z_umf_solver_descr(sv,info,iout,coarse)
Implicit None

Write Preview
Loading…
Cancel
Save