[Patch fortran] PR41113 and PR41117 - Unnecessary invocations of internal_pack
Dominique Dhumieres
dominiq@lps.ens.fr
Wed Dec 23 10:04:00 GMT 2009
Paul,
Your patch regtested without regression. However I got segfaults when compiling the following
codes:
2583 : oop_3.f90: In function 'd_csgetblk':
2584 : oop_3.f90:565:0: internal compiler error: Segmentation fault
2589 : oop_4.f90: In function 'd_csgetblk':
2590 : oop_4.f90:222:0: internal compiler error: Segmentation fault
It was on trunk revision 155401 with Jerry's patches for data and init, and
the vtabs onr from fortran-dev.
Cheers,
Dominique
Since the two codes are quite long and similar, I am sending only the shorter
one:
module psb_const_mod
! This should be integer(8), and normally different from default integer.
integer, parameter :: longndig=12
integer, parameter :: psb_long_int_k_ = selected_int_kind(longndig)
!
! These must be the kind parameter corresponding to MPI_DOUBLE_PRECISION
! and MPI_REAL
!
integer, parameter :: psb_dpk_ = kind(1.d0)
integer, parameter :: psb_spk_ = kind(1.e0)
integer, save :: psb_sizeof_dp, psb_sizeof_sp
integer, save :: psb_sizeof_int, psb_sizeof_long_int
integer, parameter :: psb_invalid_ = -1
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
! These are usually set while calling spcnv as one of its
! optional arugments.
integer, parameter :: psb_dupl_ovwrt_ = 0
integer, parameter :: psb_dupl_add_ = 1
integer, parameter :: psb_dupl_err_ = 2
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
! Matrix update mode
integer, parameter :: psb_upd_srch_ = 98764
integer, parameter :: psb_upd_perm_ = 98765
integer, parameter :: psb_upd_dflt_ = psb_upd_srch_
end module psb_const_mod
module psb_base_mat_mod
use psb_const_mod
type :: psb_base_sparse_mat
integer, private :: m, n
integer, private :: state, duplicate
logical, private :: triangle, unitd, upper, sorted
integer, allocatable :: aux(:)
contains
procedure, pass(a) :: get_nzeros
procedure, pass(a) :: is_null
procedure, pass(a) :: get_neigh
procedure, pass(a) :: csgetptn
generic, public :: csget => csgetptn
end type psb_base_sparse_mat
private :: get_nzeros, is_null, get_neigh, csgetptn
contains
function is_null(a) result(res)
implicit none
class(psb_base_sparse_mat), intent(in) :: a
logical :: res
res = (a%state == psb_spmat_null_)
end function is_null
function get_nzeros(a) result(res)
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='base_get_nzeros'
logical, parameter :: debug=.false.
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
end function get_nzeros
subroutine csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_const_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
info = 700
return
end subroutine csgetptn
subroutine get_neigh(a,idx,neigh,n,info,lev)
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
integer :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl
integer, allocatable :: ia(:), ja(:)
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
info = 0
n = 0
return
end subroutine get_neigh
end module psb_base_mat_mod
module psb_d_base_mat_mod
use psb_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_d_base_sparse_mat
contains
procedure, pass(a) :: d_csgetrow
procedure, pass(a) :: d_csgetblk
generic, public :: csget => d_csgetrow, d_csgetblk
end type psb_d_base_sparse_mat
private :: d_csgetrow, d_csgetblk
type, extends(psb_d_base_sparse_mat) :: psb_d_coo_sparse_mat
integer :: nnz
integer, allocatable :: ia(:), ja(:)
real(psb_dpk_), allocatable :: val(:)
contains
procedure, pass(a) :: get_nzeros => d_coo_get_nzeros
procedure, pass(a) :: set_nzeros => d_coo_set_nzeros
procedure, pass(a) :: fix => d_fix_coo
end type psb_d_coo_sparse_mat
private :: d_coo_get_nzeros, d_coo_set_nzeros, d_fix_coo
interface
subroutine d_fix_coo_impl(a,info,idir)
use psb_const_mod
import psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: idir
end subroutine d_fix_coo_impl
end interface
contains
subroutine d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_const_mod
implicit none
class(psb_d_base_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = 700
return
end subroutine d_csgetrow
subroutine d_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_const_mod
implicit none
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
Integer :: err_act, nzin, nzout
character(len=20) :: name='csget'
logical :: append_
logical, parameter :: debug=.false.
info = 0
if (present(append)) then
append_ = append
else
append_ = .false.
endif
if (append_) then
nzin = a%get_nzeros()
else
nzin = 0
endif
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
& nzin=nzin, rscale=rscale, cscale=cscale)
if (info /= 0) goto 9999
call b%set_nzeros(nzin+nzout)
call b%fix(info)
if (info /= 0) goto 9999
return
9999 continue
return
end subroutine d_csgetblk
function d_coo_get_nzeros(a) result(res)
implicit none
class(psb_d_coo_sparse_mat), intent(in) :: a
integer :: res
res = a%nnz
end function d_coo_get_nzeros
subroutine d_coo_set_nzeros(nz,a)
implicit none
integer, intent(in) :: nz
class(psb_d_coo_sparse_mat), intent(inout) :: a
a%nnz = nz
end subroutine d_coo_set_nzeros
subroutine d_fix_coo(a,info,idir)
use psb_const_mod
implicit none
class(psb_d_coo_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: idir
Integer :: err_act
character(len=20) :: name='fix_coo'
logical, parameter :: debug=.false.
info = 0
call d_fix_coo_impl(a,info,idir)
if (info /= 0) goto 9999
return
9999 continue
return
end subroutine d_fix_coo
end module psb_d_base_mat_mod
module psb_d_mat_mod
use psb_d_base_mat_mod
type :: psb_d_sparse_mat
class(psb_d_base_sparse_mat), allocatable :: a
contains
procedure, pass(a) :: is_null
procedure, pass(a) :: d_csgetptn
procedure, pass(a) :: d_csgetrow
procedure, pass(a) :: d_csgetblk
generic, public :: csget => d_csgetptn, d_csgetrow, d_csgetblk
end type psb_d_sparse_mat
private :: d_csgetrow,&
& d_csgetblk, d_csgetptn, is_null
contains
function is_null(a) result(res)
implicit none
class(psb_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_null()
else
res = .true.
end if
end function is_null
subroutine d_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_const_mod
use psb_d_base_mat_mod
implicit none
class(psb_d_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
info = 0
if (a%is_null()) then
info = 1121
goto 9999
endif
call a%a%csget(imin,imax,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
if (info /= 0) goto 9999
return
9999 continue
end subroutine d_csgetptn
subroutine d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_const_mod
use psb_d_base_mat_mod
implicit none
class(psb_d_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
info = 0
if (a%is_null()) then
info = 1121
goto 9999
endif
call a%a%csget(imin,imax,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
if (info /= 0) goto 9999
return
9999 continue
end subroutine d_csgetrow
subroutine d_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
! Output is always in COO format
use psb_const_mod
use psb_d_base_mat_mod
implicit none
class(psb_d_sparse_mat), intent(in) :: a
class(psb_d_sparse_mat), intent(out) :: b
integer, intent(in) :: imin,imax
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat), allocatable :: acoo
info = 0
if (a%is_null()) then
info = 1121
goto 9999
endif
allocate(acoo,stat=info)
if (info == 0) call a%a%csget(imin,imax,acoo,info,&
& jmin,jmax,iren,append,rscale,cscale)
if (info == 0) call move_alloc(acoo,b%a)
if (info /= 0) goto 9999
return
9999 continue
end subroutine d_csgetblk
end module psb_d_mat_mod
More information about the Fortran
mailing list