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

psblas3:

Browse Source 
base/tools/psb_csphalo.F90
 base/tools/psb_dsphalo.F90
 base/tools/psb_ssphalo.F90
 base/tools/psb_zsphalo.F90

Fix usage of move_alloc for polymorphic variables.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent b0e7e05899
commit 523056dbb6
4 changed files with 770 additions and 703 deletions
Show Stats Download Patch File Download Diff File

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

@ -57,7 +57,6 @@
!
Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_csphalo
#ifdef MPI_MOD
@ -84,7 +83,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
complex(psb_spk_), allocatable :: valsnd(:)
type(psb_c_coo_sparse_mat), allocatable :: acoo
class(psb_c_base_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
@ -165,6 +164,17 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select
allocate(psb_c_coo_sparse_mat :: acoo,stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
select type (acoo)
type is (psb_c_coo_sparse_mat)
l1 = 0
sdsz(:)=0
@ -338,9 +348,17 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,&
else
call acoo%set_ncols(icmax)
end if
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_)&
& write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1

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

@ -55,7 +55,6 @@
! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine.
!
!
Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_dsphalo
@ -68,9 +67,9 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h'
#endif
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: blk
type(psb_desc_type),intent(in), target :: desc_a
Type(psb_dspmat_type),Intent(in) :: a
Type(psb_dspmat_type),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a
integer, intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale
character(len=5), optional :: outfmt
@ -84,15 +83,15 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
real(psb_dpk_), allocatable :: valsnd(:)
type(psb_d_coo_sparse_mat), allocatable :: acoo
class(psb_d_base_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer :: debug_level, debug_unit
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
info=psb_success_
if (psb_errstatus_fatal()) return
name='psb_dsphalo'
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
@ -133,12 +132,6 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
outfmt_ = 'CSR'
endif
if (.not.desc_a%is_asb()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
@ -171,6 +164,17 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select
allocate(psb_d_coo_sparse_mat :: acoo,stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
select type (acoo)
type is (psb_d_coo_sparse_mat)
l1 = 0
sdsz(:)=0
@ -344,9 +348,17 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
else
call acoo%set_ncols(icmax)
end if
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_)&
& write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1

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

@ -55,7 +55,6 @@
! psb_comm_ext_ use ext_index
! psb_comm_ovrl_ DISABLED for this routine.
!
!
Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,outfmt,data)
use psb_base_mod, psb_protect_name => psb_ssphalo
@ -84,7 +83,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
real(psb_spk_), allocatable :: valsnd(:)
type(psb_s_coo_sparse_mat), allocatable :: acoo
class(psb_s_base_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
@ -165,6 +164,17 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select
allocate(psb_s_coo_sparse_mat :: acoo,stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
select type (acoo)
type is (psb_s_coo_sparse_mat)
l1 = 0
sdsz(:)=0
@ -338,9 +348,17 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,&
else
call acoo%set_ncols(icmax)
end if
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_)&
& write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1

21
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(:,:), &
& rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:)
complex(psb_dpk_), allocatable :: valsnd(:)
type(psb_z_coo_sparse_mat), allocatable :: acoo
class(psb_z_base_sparse_mat), allocatable :: acoo
integer, pointer :: idxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
@ -164,6 +164,17 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
end select
allocate(psb_z_coo_sparse_mat :: acoo,stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
select type (acoo)
type is (psb_z_coo_sparse_mat)
l1 = 0
sdsz(:)=0
@ -337,9 +348,17 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,&
else
call acoo%set_ncols(icmax)
end if
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_)&
& write(debug_unit,*) me,' ',trim(name),&
& ': End data exchange',counter,l1

Write Preview
Loading…
Cancel
Save