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

Fix SPMAT take out LX_icsget; in search of a better solution.

Browse Source
scr-persistent-collective
Salvatore Filippone 6 years ago
parent b120565ae1
commit 638f777322
6 changed files with 336 additions and 8088 deletions
Show Stats Download Patch File Download Diff File

164
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -315,9 +315,9 @@ module psb_c_mat_mod
procedure, pass(a) :: csgetblk => psb_lc_csgetblk procedure, pass(a) :: csgetblk => psb_lc_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
procedure, pass(a) :: icsgetptn => psb_lc_icsgetptn !!$ procedure, pass(a) :: icsgetptn => psb_lc_icsgetptn
procedure, pass(a) :: icsgetrow => psb_lc_icsgetrow !!$ procedure, pass(a) :: icsgetrow => psb_lc_icsgetrow
generic, public :: csget => icsgetptn, icsgetrow !!$ generic, public :: csget => icsgetptn, icsgetrow
#endif #endif
procedure, pass(a) :: tril => psb_lc_tril procedure, pass(a) :: tril => psb_lc_tril
procedure, pass(a) :: triu => psb_lc_triu procedure, pass(a) :: triu => psb_lc_triu
@ -2654,83 +2654,87 @@ contains
end subroutine psb_lc_clean_zeros end subroutine psb_lc_clean_zeros
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
subroutine psb_lc_icsgetptn(imin,imax,a,nz,ia,ja,info,& !!$ subroutine psb_lc_icsgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
implicit none !!$ implicit none
class(psb_lcspmat_type), intent(in) :: a !!$ class(psb_lcspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax !!$ integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append !!$ logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale !!$ logical, intent(in), optional :: rscale,cscale
!!$
! Local !!$ ! Local
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:)
!!$ integer(psb_lpk_) :: lnz
info = psb_success_ !!$
! !!$ info = psb_success_
! Note: in principle we could use reallocate on assignment, !!$ !
! but GCC bug 52162 forces us to take defensive programming. !!$ ! Note: in principle we could use reallocate on assignment,
! !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (allocated(ia)) then !!$ !
call psb_realloc(size(ia),lia,info) !!$ if (allocated(ia)) then
if (info == psb_success_) lia(:) = ia(:) !!$ call psb_realloc(size(ia),lia,info)
end if !!$ if (info == psb_success_) lia(:) = ia(:)
if (allocated(ja)) then !!$ end if
call psb_realloc(size(ja),lja,info) !!$ if (allocated(ja)) then
if (info == psb_success_) lja(:) = ja(:) !!$ call psb_realloc(size(ja),lja,info)
end if !!$ if (info == psb_success_) lja(:) = ja(:)
call a%csget(imin,imax,nz,lia,lja,info,& !!$ end if
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ lnz = nz
!!$ call a%csget(imin,imax,lnz,lia,lja,info,&
call psb_ensure_size(size(lia),ia,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ia(:) = lia(:) !!$ nz = lnz
call psb_ensure_size(size(lja),ja,info) !!$ call psb_ensure_size(size(lia),ia,info)
if (info == psb_success_) ja(:) = lja(:) !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
end subroutine psb_lc_icsgetptn !!$ if (info == psb_success_) ja(:) = lja(:)
!!$
subroutine psb_lc_icsgetrow(imin,imax,a,nz,ia,ja,val,info,& !!$ end subroutine psb_lc_icsgetptn
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$
implicit none !!$ subroutine psb_lc_icsgetrow(imin,imax,a,nz,ia,ja,val,info,&
class(psb_lcspmat_type), intent(in) :: a !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
integer(psb_ipk_), intent(in) :: imin,imax !!$ implicit none
integer(psb_ipk_), intent(out) :: nz !!$ class(psb_lcspmat_type), intent(in) :: a
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), intent(in) :: imin,imax
complex(psb_spk_), allocatable, intent(inout) :: val(:) !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
logical, intent(in), optional :: append !!$ complex(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ logical, intent(in), optional :: append
logical, intent(in), optional :: rscale,cscale !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
! Local !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ logical, intent(in), optional :: rscale,cscale
!!$ ! Local
! !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:), liren(:)
! Note: in principle we could use reallocate on assignment, !!$ integer(psb_lpk_) :: lnz
! but GCC bug 52162 forces us to take defensive programming. !!$
! !!$ !
if (allocated(ia)) then !!$ ! Note: in principle we could use reallocate on assignment,
call psb_realloc(size(ia),lia,info) !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (info == psb_success_) lia(:) = ia(:) !!$ !
end if !!$ if (allocated(ia)) then
if (allocated(ja)) then !!$ call psb_realloc(size(ia),lia,info)
call psb_realloc(size(ja),lja,info) !!$ if (info == psb_success_) lia(:) = ia(:)
if (info == psb_success_) lja(:) = ja(:) !!$ end if
end if !!$ if (allocated(ja)) then
!!$ call psb_realloc(size(ja),lja,info)
call a%csget(imin,imax,nz,lia,lja,val,info,& !!$ if (info == psb_success_) lja(:) = ja(:)
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ end if
!!$
call psb_ensure_size(size(lia),ia,info) !!$ lnz = nz
if (info == psb_success_) ia(:) = lia(:) !!$ call a%csget(imin,imax,nz,lia,lja,val,info,&
call psb_ensure_size(size(lja),ja,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ja(:) = lja(:) !!$ nz=lnz
!!$ call psb_ensure_size(size(lia),ia,info)
end subroutine psb_lc_icsgetrow !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
!!$ if (info == psb_success_) ja(:) = lja(:)
!!$
!!$ end subroutine psb_lc_icsgetrow
#endif #endif
end module psb_c_mat_mod end module psb_c_mat_mod

164
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -315,9 +315,9 @@ module psb_d_mat_mod
procedure, pass(a) :: csgetblk => psb_ld_csgetblk procedure, pass(a) :: csgetblk => psb_ld_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
procedure, pass(a) :: icsgetptn => psb_ld_icsgetptn !!$ procedure, pass(a) :: icsgetptn => psb_ld_icsgetptn
procedure, pass(a) :: icsgetrow => psb_ld_icsgetrow !!$ procedure, pass(a) :: icsgetrow => psb_ld_icsgetrow
generic, public :: csget => icsgetptn, icsgetrow !!$ generic, public :: csget => icsgetptn, icsgetrow
#endif #endif
procedure, pass(a) :: tril => psb_ld_tril procedure, pass(a) :: tril => psb_ld_tril
procedure, pass(a) :: triu => psb_ld_triu procedure, pass(a) :: triu => psb_ld_triu
@ -2654,83 +2654,87 @@ contains
end subroutine psb_ld_clean_zeros end subroutine psb_ld_clean_zeros
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
subroutine psb_ld_icsgetptn(imin,imax,a,nz,ia,ja,info,& !!$ subroutine psb_ld_icsgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
implicit none !!$ implicit none
class(psb_ldspmat_type), intent(in) :: a !!$ class(psb_ldspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax !!$ integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append !!$ logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale !!$ logical, intent(in), optional :: rscale,cscale
!!$
! Local !!$ ! Local
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:)
!!$ integer(psb_lpk_) :: lnz
info = psb_success_ !!$
! !!$ info = psb_success_
! Note: in principle we could use reallocate on assignment, !!$ !
! but GCC bug 52162 forces us to take defensive programming. !!$ ! Note: in principle we could use reallocate on assignment,
! !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (allocated(ia)) then !!$ !
call psb_realloc(size(ia),lia,info) !!$ if (allocated(ia)) then
if (info == psb_success_) lia(:) = ia(:) !!$ call psb_realloc(size(ia),lia,info)
end if !!$ if (info == psb_success_) lia(:) = ia(:)
if (allocated(ja)) then !!$ end if
call psb_realloc(size(ja),lja,info) !!$ if (allocated(ja)) then
if (info == psb_success_) lja(:) = ja(:) !!$ call psb_realloc(size(ja),lja,info)
end if !!$ if (info == psb_success_) lja(:) = ja(:)
call a%csget(imin,imax,nz,lia,lja,info,& !!$ end if
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ lnz = nz
!!$ call a%csget(imin,imax,lnz,lia,lja,info,&
call psb_ensure_size(size(lia),ia,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ia(:) = lia(:) !!$ nz = lnz
call psb_ensure_size(size(lja),ja,info) !!$ call psb_ensure_size(size(lia),ia,info)
if (info == psb_success_) ja(:) = lja(:) !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
end subroutine psb_ld_icsgetptn !!$ if (info == psb_success_) ja(:) = lja(:)
!!$
subroutine psb_ld_icsgetrow(imin,imax,a,nz,ia,ja,val,info,& !!$ end subroutine psb_ld_icsgetptn
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$
implicit none !!$ subroutine psb_ld_icsgetrow(imin,imax,a,nz,ia,ja,val,info,&
class(psb_ldspmat_type), intent(in) :: a !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
integer(psb_ipk_), intent(in) :: imin,imax !!$ implicit none
integer(psb_ipk_), intent(out) :: nz !!$ class(psb_ldspmat_type), intent(in) :: a
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), intent(in) :: imin,imax
real(psb_dpk_), allocatable, intent(inout) :: val(:) !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
logical, intent(in), optional :: append !!$ real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ logical, intent(in), optional :: append
logical, intent(in), optional :: rscale,cscale !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
! Local !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ logical, intent(in), optional :: rscale,cscale
!!$ ! Local
! !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:), liren(:)
! Note: in principle we could use reallocate on assignment, !!$ integer(psb_lpk_) :: lnz
! but GCC bug 52162 forces us to take defensive programming. !!$
! !!$ !
if (allocated(ia)) then !!$ ! Note: in principle we could use reallocate on assignment,
call psb_realloc(size(ia),lia,info) !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (info == psb_success_) lia(:) = ia(:) !!$ !
end if !!$ if (allocated(ia)) then
if (allocated(ja)) then !!$ call psb_realloc(size(ia),lia,info)
call psb_realloc(size(ja),lja,info) !!$ if (info == psb_success_) lia(:) = ia(:)
if (info == psb_success_) lja(:) = ja(:) !!$ end if
end if !!$ if (allocated(ja)) then
!!$ call psb_realloc(size(ja),lja,info)
call a%csget(imin,imax,nz,lia,lja,val,info,& !!$ if (info == psb_success_) lja(:) = ja(:)
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ end if
!!$
call psb_ensure_size(size(lia),ia,info) !!$ lnz = nz
if (info == psb_success_) ia(:) = lia(:) !!$ call a%csget(imin,imax,nz,lia,lja,val,info,&
call psb_ensure_size(size(lja),ja,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ja(:) = lja(:) !!$ nz=lnz
!!$ call psb_ensure_size(size(lia),ia,info)
end subroutine psb_ld_icsgetrow !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
!!$ if (info == psb_success_) ja(:) = lja(:)
!!$
!!$ end subroutine psb_ld_icsgetrow
#endif #endif
end module psb_d_mat_mod end module psb_d_mat_mod

3884
base/modules/serial/psb_s_base_mat_mod.f90
View File

File diff suppressed because it is too large Load Diff

164
base/modules/serial/psb_s_mat_mod.F90
Unescape Escape View File

@ -315,9 +315,9 @@ module psb_s_mat_mod
procedure, pass(a) :: csgetblk => psb_ls_csgetblk procedure, pass(a) :: csgetblk => psb_ls_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
procedure, pass(a) :: icsgetptn => psb_ls_icsgetptn !!$ procedure, pass(a) :: icsgetptn => psb_ls_icsgetptn
procedure, pass(a) :: icsgetrow => psb_ls_icsgetrow !!$ procedure, pass(a) :: icsgetrow => psb_ls_icsgetrow
generic, public :: csget => icsgetptn, icsgetrow !!$ generic, public :: csget => icsgetptn, icsgetrow
#endif #endif
procedure, pass(a) :: tril => psb_ls_tril procedure, pass(a) :: tril => psb_ls_tril
procedure, pass(a) :: triu => psb_ls_triu procedure, pass(a) :: triu => psb_ls_triu
@ -2654,83 +2654,87 @@ contains
end subroutine psb_ls_clean_zeros end subroutine psb_ls_clean_zeros
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
subroutine psb_ls_icsgetptn(imin,imax,a,nz,ia,ja,info,& !!$ subroutine psb_ls_icsgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
implicit none !!$ implicit none
class(psb_lsspmat_type), intent(in) :: a !!$ class(psb_lsspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax !!$ integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append !!$ logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale !!$ logical, intent(in), optional :: rscale,cscale
!!$
! Local !!$ ! Local
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:)
!!$ integer(psb_lpk_) :: lnz
info = psb_success_ !!$
! !!$ info = psb_success_
! Note: in principle we could use reallocate on assignment, !!$ !
! but GCC bug 52162 forces us to take defensive programming. !!$ ! Note: in principle we could use reallocate on assignment,
! !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (allocated(ia)) then !!$ !
call psb_realloc(size(ia),lia,info) !!$ if (allocated(ia)) then
if (info == psb_success_) lia(:) = ia(:) !!$ call psb_realloc(size(ia),lia,info)
end if !!$ if (info == psb_success_) lia(:) = ia(:)
if (allocated(ja)) then !!$ end if
call psb_realloc(size(ja),lja,info) !!$ if (allocated(ja)) then
if (info == psb_success_) lja(:) = ja(:) !!$ call psb_realloc(size(ja),lja,info)
end if !!$ if (info == psb_success_) lja(:) = ja(:)
call a%csget(imin,imax,nz,lia,lja,info,& !!$ end if
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ lnz = nz
!!$ call a%csget(imin,imax,lnz,lia,lja,info,&
call psb_ensure_size(size(lia),ia,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ia(:) = lia(:) !!$ nz = lnz
call psb_ensure_size(size(lja),ja,info) !!$ call psb_ensure_size(size(lia),ia,info)
if (info == psb_success_) ja(:) = lja(:) !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
end subroutine psb_ls_icsgetptn !!$ if (info == psb_success_) ja(:) = lja(:)
!!$
subroutine psb_ls_icsgetrow(imin,imax,a,nz,ia,ja,val,info,& !!$ end subroutine psb_ls_icsgetptn
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$
implicit none !!$ subroutine psb_ls_icsgetrow(imin,imax,a,nz,ia,ja,val,info,&
class(psb_lsspmat_type), intent(in) :: a !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
integer(psb_ipk_), intent(in) :: imin,imax !!$ implicit none
integer(psb_ipk_), intent(out) :: nz !!$ class(psb_lsspmat_type), intent(in) :: a
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), intent(in) :: imin,imax
real(psb_spk_), allocatable, intent(inout) :: val(:) !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
logical, intent(in), optional :: append !!$ real(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ logical, intent(in), optional :: append
logical, intent(in), optional :: rscale,cscale !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
! Local !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ logical, intent(in), optional :: rscale,cscale
!!$ ! Local
! !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:), liren(:)
! Note: in principle we could use reallocate on assignment, !!$ integer(psb_lpk_) :: lnz
! but GCC bug 52162 forces us to take defensive programming. !!$
! !!$ !
if (allocated(ia)) then !!$ ! Note: in principle we could use reallocate on assignment,
call psb_realloc(size(ia),lia,info) !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (info == psb_success_) lia(:) = ia(:) !!$ !
end if !!$ if (allocated(ia)) then
if (allocated(ja)) then !!$ call psb_realloc(size(ia),lia,info)
call psb_realloc(size(ja),lja,info) !!$ if (info == psb_success_) lia(:) = ia(:)
if (info == psb_success_) lja(:) = ja(:) !!$ end if
end if !!$ if (allocated(ja)) then
!!$ call psb_realloc(size(ja),lja,info)
call a%csget(imin,imax,nz,lia,lja,val,info,& !!$ if (info == psb_success_) lja(:) = ja(:)
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ end if
!!$
call psb_ensure_size(size(lia),ia,info) !!$ lnz = nz
if (info == psb_success_) ia(:) = lia(:) !!$ call a%csget(imin,imax,nz,lia,lja,val,info,&
call psb_ensure_size(size(lja),ja,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ja(:) = lja(:) !!$ nz=lnz
!!$ call psb_ensure_size(size(lia),ia,info)
end subroutine psb_ls_icsgetrow !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
!!$ if (info == psb_success_) ja(:) = lja(:)
!!$
!!$ end subroutine psb_ls_icsgetrow
#endif #endif
end module psb_s_mat_mod end module psb_s_mat_mod

3884
base/modules/serial/psb_z_base_mat_mod.f90
View File

File diff suppressed because it is too large Load Diff

164
base/modules/serial/psb_z_mat_mod.F90
Unescape Escape View File

@ -315,9 +315,9 @@ module psb_z_mat_mod
procedure, pass(a) :: csgetblk => psb_lz_csgetblk procedure, pass(a) :: csgetblk => psb_lz_csgetblk
generic, public :: csget => csgetptn, csgetrow, csgetblk generic, public :: csget => csgetptn, csgetrow, csgetblk
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
procedure, pass(a) :: icsgetptn => psb_lz_icsgetptn !!$ procedure, pass(a) :: icsgetptn => psb_lz_icsgetptn
procedure, pass(a) :: icsgetrow => psb_lz_icsgetrow !!$ procedure, pass(a) :: icsgetrow => psb_lz_icsgetrow
generic, public :: csget => icsgetptn, icsgetrow !!$ generic, public :: csget => icsgetptn, icsgetrow
#endif #endif
procedure, pass(a) :: tril => psb_lz_tril procedure, pass(a) :: tril => psb_lz_tril
procedure, pass(a) :: triu => psb_lz_triu procedure, pass(a) :: triu => psb_lz_triu
@ -2654,83 +2654,87 @@ contains
end subroutine psb_lz_clean_zeros end subroutine psb_lz_clean_zeros
#if defined(IPK4) && defined(LPK8) #if defined(IPK4) && defined(LPK8)
subroutine psb_lz_icsgetptn(imin,imax,a,nz,ia,ja,info,& !!$ subroutine psb_lz_icsgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
implicit none !!$ implicit none
class(psb_lzspmat_type), intent(in) :: a !!$ class(psb_lzspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax !!$ integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append !!$ logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale !!$ logical, intent(in), optional :: rscale,cscale
!!$
! Local !!$ ! Local
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:)
!!$ integer(psb_lpk_) :: lnz
info = psb_success_ !!$
! !!$ info = psb_success_
! Note: in principle we could use reallocate on assignment, !!$ !
! but GCC bug 52162 forces us to take defensive programming. !!$ ! Note: in principle we could use reallocate on assignment,
! !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (allocated(ia)) then !!$ !
call psb_realloc(size(ia),lia,info) !!$ if (allocated(ia)) then
if (info == psb_success_) lia(:) = ia(:) !!$ call psb_realloc(size(ia),lia,info)
end if !!$ if (info == psb_success_) lia(:) = ia(:)
if (allocated(ja)) then !!$ end if
call psb_realloc(size(ja),lja,info) !!$ if (allocated(ja)) then
if (info == psb_success_) lja(:) = ja(:) !!$ call psb_realloc(size(ja),lja,info)
end if !!$ if (info == psb_success_) lja(:) = ja(:)
call a%csget(imin,imax,nz,lia,lja,info,& !!$ end if
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ lnz = nz
!!$ call a%csget(imin,imax,lnz,lia,lja,info,&
call psb_ensure_size(size(lia),ia,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ia(:) = lia(:) !!$ nz = lnz
call psb_ensure_size(size(lja),ja,info) !!$ call psb_ensure_size(size(lia),ia,info)
if (info == psb_success_) ja(:) = lja(:) !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
end subroutine psb_lz_icsgetptn !!$ if (info == psb_success_) ja(:) = lja(:)
!!$
subroutine psb_lz_icsgetrow(imin,imax,a,nz,ia,ja,val,info,& !!$ end subroutine psb_lz_icsgetptn
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$
implicit none !!$ subroutine psb_lz_icsgetrow(imin,imax,a,nz,ia,ja,val,info,&
class(psb_lzspmat_type), intent(in) :: a !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
integer(psb_ipk_), intent(in) :: imin,imax !!$ implicit none
integer(psb_ipk_), intent(out) :: nz !!$ class(psb_lzspmat_type), intent(in) :: a
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:) !!$ integer(psb_ipk_), intent(in) :: imin,imax
complex(psb_dpk_), allocatable, intent(inout) :: val(:) !!$ integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_),intent(out) :: info !!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
logical, intent(in), optional :: append !!$ complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_), intent(in), optional :: iren(:) !!$ integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin !!$ logical, intent(in), optional :: append
logical, intent(in), optional :: rscale,cscale !!$ integer(psb_ipk_), intent(in), optional :: iren(:)
! Local !!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
integer(psb_ipk_), allocatable :: lia(:), lja(:) !!$ logical, intent(in), optional :: rscale,cscale
!!$ ! Local
! !!$ integer(psb_lpk_), allocatable :: lia(:), lja(:), liren(:)
! Note: in principle we could use reallocate on assignment, !!$ integer(psb_lpk_) :: lnz
! but GCC bug 52162 forces us to take defensive programming. !!$
! !!$ !
if (allocated(ia)) then !!$ ! Note: in principle we could use reallocate on assignment,
call psb_realloc(size(ia),lia,info) !!$ ! but GCC bug 52162 forces us to take defensive programming.
if (info == psb_success_) lia(:) = ia(:) !!$ !
end if !!$ if (allocated(ia)) then
if (allocated(ja)) then !!$ call psb_realloc(size(ia),lia,info)
call psb_realloc(size(ja),lja,info) !!$ if (info == psb_success_) lia(:) = ia(:)
if (info == psb_success_) lja(:) = ja(:) !!$ end if
end if !!$ if (allocated(ja)) then
!!$ call psb_realloc(size(ja),lja,info)
call a%csget(imin,imax,nz,lia,lja,val,info,& !!$ if (info == psb_success_) lja(:) = ja(:)
& jmin,jmax,iren,append,nzin,rscale,cscale) !!$ end if
!!$
call psb_ensure_size(size(lia),ia,info) !!$ lnz = nz
if (info == psb_success_) ia(:) = lia(:) !!$ call a%csget(imin,imax,nz,lia,lja,val,info,&
call psb_ensure_size(size(lja),ja,info) !!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
if (info == psb_success_) ja(:) = lja(:) !!$ nz=lnz
!!$ call psb_ensure_size(size(lia),ia,info)
end subroutine psb_lz_icsgetrow !!$ if (info == psb_success_) ia(:) = lia(:)
!!$ call psb_ensure_size(size(lja),ja,info)
!!$ if (info == psb_success_) ja(:) = lja(:)
!!$
!!$ end subroutine psb_lz_icsgetrow
#endif #endif
end module psb_z_mat_mod end module psb_z_mat_mod

Write Preview
Loading…
Cancel
Save