fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added new optional arguments to TRIL and TRIU. Document same.

Browse Source
This commit is contained in:
Salvatore Filippone
2017-08-09 10:43:38 +01:00
parent a0a0e96a96
commit 7218ae86d6
19 changed files with 808 additions and 346 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/impl/psb_s_mat_impl.F90
+44 -28
View File
@@ -906,24 +906,24 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,&
end subroutine psb_s_csgetblk
subroutine psb_s_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
subroutine psb_s_tril(a,l,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,u)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod
use psb_s_mat_mod, psb_protect_name => psb_s_tril
implicit none
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(inout) :: b
class(psb_sspmat_type), intent(inout) :: l
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_sspmat_type), optional, intent(inout) :: u
integer(psb_ipk_) :: err_act
character(len=20) :: name='tril'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat), allocatable :: acoo
type(psb_s_coo_sparse_mat), allocatable :: lcoo, ucoo
info = psb_success_
call psb_erractionsave(err_act)
@@ -932,23 +932,30 @@ subroutine psb_s_tril(a,b,info,diag,imin,imax,&
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
call b%free()
if (info == psb_success_) then
call a%a%tril(acoo,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
allocate(lcoo,stat=info)
call l%free()
if (present(u)) then
if (info == psb_success_) allocate(ucoo,stat=info)
call u%free()
if (info == psb_success_) call a%a%tril(lcoo,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,ucoo)
if (info == psb_success_) call move_alloc(ucoo,u%a)
if (info == psb_success_) call u%cscnv(info,mold=a%a)
else
info = psb_err_alloc_dealloc_
if (info == psb_success_) then
call a%a%tril(lcoo,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
end if
if (info == psb_success_) call move_alloc(acoo,b%a)
if (info == psb_success_) call b%cscnv(info,mold=a%a)
if (info == psb_success_) call move_alloc(lcoo,l%a)
if (info == psb_success_) call l%cscnv(info,mold=a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@@ -956,23 +963,24 @@ subroutine psb_s_tril(a,b,info,diag,imin,imax,&
end subroutine psb_s_tril
subroutine psb_s_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
subroutine psb_s_triu(a,u,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,l)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod
use psb_s_mat_mod, psb_protect_name => psb_s_triu
implicit none
class(psb_sspmat_type), intent(in) :: a
class(psb_sspmat_type), intent(inout) :: b
class(psb_sspmat_type), intent(inout) :: u
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_sspmat_type), optional, intent(inout) :: l
integer(psb_ipk_) :: err_act
character(len=20) :: name='triu'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat), allocatable :: acoo
type(psb_s_coo_sparse_mat), allocatable :: lcoo, ucoo
info = psb_success_
@@ -983,23 +991,31 @@ subroutine psb_s_triu(a,b,info,diag,imin,imax,&
goto 9999
endif
allocate(acoo,stat=info)
call b%free()
allocate(ucoo,stat=info)
call u%free()
if (info == psb_success_) then
call a%a%triu(acoo,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
if (present(l)) then
if (info == psb_success_) allocate(lcoo,stat=info)
call l%free()
if (info == psb_success_) call a%a%triu(ucoo,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,lcoo)
if (info == psb_success_) call move_alloc(lcoo,l%a)
if (info == psb_success_) call l%cscnv(info,mold=a%a)
else
info = psb_err_alloc_dealloc_
if (info == psb_success_) then
call a%a%triu(ucoo,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
else
info = psb_err_alloc_dealloc_
end if
end if
if (info == psb_success_) call move_alloc(acoo,b%a)
if (info == psb_success_) call b%cscnv(info,mold=a%a)
if (info == psb_success_) call move_alloc(ucoo,u%a)
if (info == psb_success_) call u%cscnv(info,mold=a%a)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return