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

psblas-testpre:

Browse Source 
base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_mat_impl.F90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_mat_impl.F90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_s_mat_impl.F90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_mat_impl.F90
 base/tools/psb_csphalo.F90
 base/tools/psb_dsphalo.F90
 base/tools/psb_ssphalo.F90
 base/tools/psb_zsphalo.F90

Reverted fix due to bug in GNU fortran.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent 523056dbb6
commit afecc0a1ed
12 changed files with 796 additions and 864 deletions
Show Stats Download Patch File Download Diff File

25
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -2164,6 +2164,10 @@ contains
end subroutine psb_c_coo_csgetptn end subroutine psb_c_coo_csgetptn
!
! NZ is the number of non-zeros on output.
! The output is guaranteed to be sorted
!
subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& subroutine psb_c_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) & jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format ! Output is always in COO format
@ -2271,6 +2275,7 @@ contains
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_sort_mod use psb_sort_mod
use psb_ip_reord_mod
implicit none implicit none
class(psb_c_coo_sparse_mat), intent(in) :: a class(psb_c_coo_sparse_mat), intent(in) :: a
@ -2369,21 +2374,21 @@ contains
if (present(iren)) then if (present(iren)) then
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = iren(a%ia(i)) ia(nzin_+nz) = iren(a%ia(i))
ja(nzin_) = iren(a%ja(i)) ja(nzin_+nz) = iren(a%ja(i))
end if end if
enddo enddo
call psb_c_fix_coo_inner(nzin_+nz,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
else else
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = a%ia(i) ia(nzin_+nz) = a%ia(i)
ja(nzin_) = a%ja(i) ja(nzin_+nz) = a%ja(i)
end if end if
enddo enddo
end if end if
@ -2438,9 +2443,9 @@ contains
ja(nzin_+k) = (a%ja(i)) ja(nzin_+k) = (a%ja(i))
endif endif
enddo enddo
nzin_=nzin_+k
end if end if
nz = k call psb_c_fix_coo_inner(nzin_+k,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
end if end if
end subroutine coo_getrow end subroutine coo_getrow

20
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -867,7 +867,7 @@ subroutine psb_c_csgetblk(imin,imax,a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_c_base_sparse_mat), allocatable :: acoo type(psb_c_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
@ -878,17 +878,11 @@ subroutine psb_c_csgetblk(imin,imax,a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_c_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_c_coo_sparse_mat)
call a%a%csget(imin,imax,acoo,info,& call a%a%csget(imin,imax,acoo,info,&
& jmin,jmax,iren,append,rscale,cscale) & jmin,jmax,iren,append,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if
@ -929,7 +923,7 @@ subroutine psb_c_csclip(a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csclip' character(len=20) :: name='csclip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_c_base_sparse_mat), allocatable :: acoo type(psb_c_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -939,17 +933,11 @@ subroutine psb_c_csclip(a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_c_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_c_coo_sparse_mat)
call a%a%csclip(acoo,info,& call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale) & imin,imax,jmin,jmax,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if

25
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -2164,6 +2164,10 @@ contains
end subroutine psb_d_coo_csgetptn end subroutine psb_d_coo_csgetptn
!
! NZ is the number of non-zeros on output.
! The output is guaranteed to be sorted
!
subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) & jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format ! Output is always in COO format
@ -2271,6 +2275,7 @@ contains
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_sort_mod use psb_sort_mod
use psb_ip_reord_mod
implicit none implicit none
class(psb_d_coo_sparse_mat), intent(in) :: a class(psb_d_coo_sparse_mat), intent(in) :: a
@ -2369,21 +2374,21 @@ contains
if (present(iren)) then if (present(iren)) then
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = iren(a%ia(i)) ia(nzin_+nz) = iren(a%ia(i))
ja(nzin_) = iren(a%ja(i)) ja(nzin_+nz) = iren(a%ja(i))
end if end if
enddo enddo
call psb_d_fix_coo_inner(nzin_+nz,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
else else
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = a%ia(i) ia(nzin_+nz) = a%ia(i)
ja(nzin_) = a%ja(i) ja(nzin_+nz) = a%ja(i)
end if end if
enddo enddo
end if end if
@ -2438,9 +2443,9 @@ contains
ja(nzin_+k) = (a%ja(i)) ja(nzin_+k) = (a%ja(i))
endif endif
enddo enddo
nzin_=nzin_+k
end if end if
nz = k call psb_d_fix_coo_inner(nzin_+k,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
end if end if
end subroutine coo_getrow end subroutine coo_getrow

20
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -867,7 +867,7 @@ subroutine psb_d_csgetblk(imin,imax,a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_d_base_sparse_mat), allocatable :: acoo type(psb_d_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
@ -878,17 +878,11 @@ subroutine psb_d_csgetblk(imin,imax,a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_d_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_d_coo_sparse_mat)
call a%a%csget(imin,imax,acoo,info,& call a%a%csget(imin,imax,acoo,info,&
& jmin,jmax,iren,append,rscale,cscale) & jmin,jmax,iren,append,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if
@ -929,7 +923,7 @@ subroutine psb_d_csclip(a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csclip' character(len=20) :: name='csclip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_d_base_sparse_mat), allocatable :: acoo type(psb_d_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -939,17 +933,11 @@ subroutine psb_d_csclip(a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_d_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_d_coo_sparse_mat)
call a%a%csclip(acoo,info,& call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale) & imin,imax,jmin,jmax,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if

25
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -2164,6 +2164,10 @@ contains
end subroutine psb_s_coo_csgetptn end subroutine psb_s_coo_csgetptn
!
! NZ is the number of non-zeros on output.
! The output is guaranteed to be sorted
!
subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& subroutine psb_s_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) & jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format ! Output is always in COO format
@ -2271,6 +2275,7 @@ contains
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_sort_mod use psb_sort_mod
use psb_ip_reord_mod
implicit none implicit none
class(psb_s_coo_sparse_mat), intent(in) :: a class(psb_s_coo_sparse_mat), intent(in) :: a
@ -2369,21 +2374,21 @@ contains
if (present(iren)) then if (present(iren)) then
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = iren(a%ia(i)) ia(nzin_+nz) = iren(a%ia(i))
ja(nzin_) = iren(a%ja(i)) ja(nzin_+nz) = iren(a%ja(i))
end if end if
enddo enddo
call psb_s_fix_coo_inner(nzin_+nz,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
else else
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = a%ia(i) ia(nzin_+nz) = a%ia(i)
ja(nzin_) = a%ja(i) ja(nzin_+nz) = a%ja(i)
end if end if
enddo enddo
end if end if
@ -2438,9 +2443,9 @@ contains
ja(nzin_+k) = (a%ja(i)) ja(nzin_+k) = (a%ja(i))
endif endif
enddo enddo
nzin_=nzin_+k
end if end if
nz = k call psb_s_fix_coo_inner(nzin_+k,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
end if end if
end subroutine coo_getrow end subroutine coo_getrow

20
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -867,7 +867,7 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_s_base_sparse_mat), allocatable :: acoo type(psb_s_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
@ -878,17 +878,11 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_s_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_s_coo_sparse_mat)
call a%a%csget(imin,imax,acoo,info,& call a%a%csget(imin,imax,acoo,info,&
& jmin,jmax,iren,append,rscale,cscale) & jmin,jmax,iren,append,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if
@ -929,7 +923,7 @@ subroutine psb_s_csclip(a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csclip' character(len=20) :: name='csclip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_s_base_sparse_mat), allocatable :: acoo type(psb_s_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -939,17 +933,11 @@ subroutine psb_s_csclip(a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_s_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_s_coo_sparse_mat)
call a%a%csclip(acoo,info,& call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale) & imin,imax,jmin,jmax,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if

25
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -2164,6 +2164,10 @@ contains
end subroutine psb_z_coo_csgetptn end subroutine psb_z_coo_csgetptn
!
! NZ is the number of non-zeros on output.
! The output is guaranteed to be sorted
!
subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,& subroutine psb_z_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale) & jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format ! Output is always in COO format
@ -2271,6 +2275,7 @@ contains
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
use psb_sort_mod use psb_sort_mod
use psb_ip_reord_mod
implicit none implicit none
class(psb_z_coo_sparse_mat), intent(in) :: a class(psb_z_coo_sparse_mat), intent(in) :: a
@ -2369,21 +2374,21 @@ contains
if (present(iren)) then if (present(iren)) then
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = iren(a%ia(i)) ia(nzin_+nz) = iren(a%ia(i))
ja(nzin_) = iren(a%ja(i)) ja(nzin_+nz) = iren(a%ja(i))
end if end if
enddo enddo
call psb_z_fix_coo_inner(nzin_+nz,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
else else
do i=ip,jp do i=ip,jp
if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then if ((jmin <= a%ja(i)).and.(a%ja(i)<=jmax)) then
nzin_ = nzin_ + 1
nz = nz + 1 nz = nz + 1
val(nzin_) = a%val(i) val(nzin_+nz) = a%val(i)
ia(nzin_) = a%ia(i) ia(nzin_+nz) = a%ia(i)
ja(nzin_) = a%ja(i) ja(nzin_+nz) = a%ja(i)
end if end if
enddo enddo
end if end if
@ -2438,9 +2443,9 @@ contains
ja(nzin_+k) = (a%ja(i)) ja(nzin_+k) = (a%ja(i))
endif endif
enddo enddo
nzin_=nzin_+k
end if end if
nz = k call psb_z_fix_coo_inner(nzin_+k,psb_dupl_add_,ia,ja,val,nz,info)
nz = nz - nzin_
end if end if
end subroutine coo_getrow end subroutine coo_getrow

20
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -867,7 +867,7 @@ subroutine psb_z_csgetblk(imin,imax,a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csget' character(len=20) :: name='csget'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_z_base_sparse_mat), allocatable :: acoo type(psb_z_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
@ -878,17 +878,11 @@ subroutine psb_z_csgetblk(imin,imax,a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_z_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_z_coo_sparse_mat)
call a%a%csget(imin,imax,acoo,info,& call a%a%csget(imin,imax,acoo,info,&
& jmin,jmax,iren,append,rscale,cscale) & jmin,jmax,iren,append,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if
@ -929,7 +923,7 @@ subroutine psb_z_csclip(a,b,info,&
Integer :: err_act Integer :: err_act
character(len=20) :: name='csclip' character(len=20) :: name='csclip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
class(psb_z_base_sparse_mat), allocatable :: acoo type(psb_z_coo_sparse_mat), allocatable :: acoo
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -939,17 +933,11 @@ subroutine psb_z_csclip(a,b,info,&
goto 9999 goto 9999
endif endif
allocate(psb_z_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
select type (acoo)
type is (psb_z_coo_sparse_mat)
call a%a%csclip(acoo,info,& call a%a%csclip(acoo,info,&
& imin,imax,jmin,jmax,rscale,cscale) & imin,imax,jmin,jmax,rscale,cscale)
class default
! This is impossible
info = psb_err_internal_error_
end select
else else
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
end if end if

14
base/tools/psb_csphalo.F90
Unescape Escape View File

@ -83,7 +83,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
complex(psb_spk_), allocatable :: valsnd(:) complex(psb_spk_), allocatable :: valsnd(:)
class(psb_c_base_sparse_mat), allocatable :: acoo type(psb_c_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:) integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
@ -164,16 +164,13 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select end select
allocate(psb_c_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
select type (acoo)
type is (psb_c_coo_sparse_mat)
l1 = 0 l1 = 0
@ -352,13 +349,6 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call acoo%set_nzeros(l1) call acoo%set_nzeros(l1)
class default
! This is impossible
info = psb_err_internal_error_
call psb_Errpush(info,name)
goto 9999
end select
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1 & ': End data exchange',counter,l1

14
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -83,7 +83,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
real(psb_dpk_), allocatable :: valsnd(:) real(psb_dpk_), allocatable :: valsnd(:)
class(psb_d_base_sparse_mat), allocatable :: acoo type(psb_d_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:) integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
@ -164,16 +164,13 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select end select
allocate(psb_d_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
select type (acoo)
type is (psb_d_coo_sparse_mat)
l1 = 0 l1 = 0
@ -352,13 +349,6 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call acoo%set_nzeros(l1) call acoo%set_nzeros(l1)
class default
! This is impossible
info = psb_err_internal_error_
call psb_Errpush(info,name)
goto 9999
end select
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1 & ': End data exchange',counter,l1

14
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -83,7 +83,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
real(psb_spk_), allocatable :: valsnd(:) real(psb_spk_), allocatable :: valsnd(:)
class(psb_s_base_sparse_mat), allocatable :: acoo type(psb_s_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:) integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
@ -164,16 +164,13 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select end select
allocate(psb_s_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
select type (acoo)
type is (psb_s_coo_sparse_mat)
l1 = 0 l1 = 0
@ -352,13 +349,6 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call acoo%set_nzeros(l1) call acoo%set_nzeros(l1)
class default
! This is impossible
info = psb_err_internal_error_
call psb_Errpush(info,name)
goto 9999
end select
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1 & ': End data exchange',counter,l1

14
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -83,7 +83,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
complex(psb_dpk_), allocatable :: valsnd(:) complex(psb_dpk_), allocatable :: valsnd(:)
class(psb_z_base_sparse_mat), allocatable :: acoo type(psb_z_coo_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:) integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
@ -164,16 +164,13 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select end select
allocate(psb_z_coo_sparse_mat :: acoo,stat=info) allocate(acoo,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
select type (acoo)
type is (psb_z_coo_sparse_mat)
l1 = 0 l1 = 0
@ -352,13 +349,6 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
call acoo%set_nzeros(l1) call acoo%set_nzeros(l1)
class default
! This is impossible
info = psb_err_internal_error_
call psb_Errpush(info,name)
goto 9999
end select
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1 & ': End data exchange',counter,l1

Write Preview
Loading…
Cancel
Save