This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
ICE with gfortran 4.3.3 20081226 and gfortran 4.4.0 20081226
- From: "marco restelli" <mrestelli at gmail dot com>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>
- Date: Mon, 29 Dec 2008 21:01:28 +0100
- Subject: ICE with gfortran 4.3.3 20081226 and gfortran 4.4.0 20081226
- Reply-to: mrestelli at gmail dot com
Dear all,
the attached code gives an internal compiler error. The first two
modules (seem to) compile
without problems, while the third one, mod_sympoly, gives the ice. (I
have tried to reduce as much
as possible this latter module, but still the code fragment is quite long.)
System:
Linux 2.6.23-gentoo-r6 x86_64 AMD Turion(tm) 64 Mobile Technology
ML-32 AuthenticAMD GNU/Linux
gfortran:
gfortran --version
GNU Fortran (GCC) 4.3.3 20081226 (prerelease) [gcc-4_3-branch revision 138185]
gfortran -c ice-test.f90
ice-test.f90:85: internal compiler error: in check_host_association,
at fortran/resolve.c:4243
and
GNU Fortran (GCC) 4.4.0 20081226 (experimental) [trunk revision 142926]
gfortran -c ice-test.f90
ice-test.f90:85: internal compiler error: in check_host_association,
at fortran/resolve.c:4369
module mod_kinds
implicit none
public :: wp
private
integer, parameter :: wp = selected_real_kind(12,307)
end module mod_kinds
!-----------------------------------------------------------------------
module mod_symmon
use mod_kinds, only: wp
implicit none
public :: &
t_symmon, &
symmon, &
operator(+), &
operator(-), &
operator(*), &
operator(**), &
ev, &
refel_int, &
pderj, &
show
private
!-----------------------------------------------------------------------
integer, parameter :: &
wrong_input = 1, &
wrong_previous = 2
type t_symmon
real(wp) :: coeff
integer :: nsv
integer, allocatable :: degs(:)
integer :: deg
integer :: ierr = 0
end type t_symmon
character(len=*), parameter :: &
this_mod_name = 'mod_symmon'
interface operator(+)
module procedure add
end interface
interface operator(-)
module procedure sub
end interface
interface operator(*)
module procedure mult, mult_scal
end interface
interface operator(**)
module procedure pow
end interface
interface ev
module procedure ev_scal, ev_1d
end interface
interface refel_int
module procedure refel_int_mon
end interface
interface pderj
module procedure pderj_mon
end interface
interface show
module procedure monshow
end interface
!-----------------------------------------------------------------------
contains
!-----------------------------------------------------------------------
pure function symmon(coeff,degs) result(m)
integer, intent(in) :: degs(:)
real(wp), intent(in) :: coeff
type(t_symmon) :: m
m%coeff = coeff
m%nsv = size(degs,1)
allocate(m%degs(m%nsv))
m%degs = degs
m%deg = sum(m%degs)
end function symmon
!-----------------------------------------------------------------------
elemental function add(m1,m2) result(m)
type(t_symmon), intent(in) :: m1, m2
type(t_symmon) :: m
if( (m1%ierr.ne.0).or.(m2%ierr.ne.0) ) then
m%ierr = wrong_previous
return
endif
if(m1%nsv.ne.m2%nsv) then
m%ierr = wrong_input
return
endif
if(any(m1%degs.ne.m2%degs)) then
m%ierr = wrong_input
return
endif
m = symmon(m1%coeff+m2%coeff,m1%degs)
end function add
!-----------------------------------------------------------------------
elemental function sub(m1,m2) result(m)
type(t_symmon), intent(in) :: m1, m2
type(t_symmon) :: m
real(wp), parameter :: mone = -1.0_wp
m = m1 + mone*m2
end function sub
!-----------------------------------------------------------------------
elemental function mult(m1,m2) result(m)
type(t_symmon), intent(in) :: m1, m2
type(t_symmon) :: m
integer, allocatable :: degs(:)
if( (m1%ierr.ne.0).or.(m2%ierr.ne.0) ) then
m%ierr = wrong_previous
return
endif
allocate(degs(max(m1%nsv,m2%nsv)))
if(m1%nsv.ge.m2%nsv) then
degs(1:m2%nsv) = m1%degs(1:m2%nsv) + m2%degs(1:m2%nsv)
degs(m2%nsv+1:m1%nsv) = m1%degs(m2%nsv+1:m1%nsv)
else
degs(1:m1%nsv) = m1%degs(1:m1%nsv) + m2%degs(1:m1%nsv)
degs(m1%nsv+1:m2%nsv) = m2%degs(m1%nsv+1:m2%nsv)
endif
m = symmon(m1%coeff*m2%coeff,degs)
deallocate(degs)
end function mult
!-----------------------------------------------------------------------
elemental function mult_scal(r,m1) result(m)
real(wp), intent(in) :: r
type(t_symmon), intent(in) :: m1
type(t_symmon) :: m
if(m1%ierr.ne.0) then
m%ierr = wrong_previous
return
endif
m = symmon(r*m1%coeff,m1%degs)
end function mult_scal
!-----------------------------------------------------------------------
elemental function pow(m1,n) result(m)
type(t_symmon), intent(in) :: m1
integer, intent(in) :: n
type(t_symmon) :: m
if(m1%ierr.ne.0) then
m%ierr = wrong_previous
return
endif
m = symmon(m1%coeff**n,n*m1%degs)
end function pow
!-----------------------------------------------------------------------
pure function ev_scal(m,x) result(z)
type(t_symmon), intent(in) :: m
real(wp), intent(in) :: x(:)
real(wp) :: z
z = m%coeff * product(x**(m%degs))
end function ev_scal
!-----------------------------------------------------------------------
pure function ev_1d(m,x) result(z)
type(t_symmon), intent(in) :: m
real(wp), intent(in) :: x(:,:)
real(wp) :: z(size(x,2))
integer :: i
do i=1,size(z)
z(i) = ev(m,x(:,i))
enddo
end function ev_1d
!-----------------------------------------------------------------------
elemental function refel_int_mon(m) result(i)
real(wp) :: i
type(t_symmon), intent(in) :: m
integer :: k, c
integer, allocatable :: coeff(:)
select case(m%nsv)
case(1)
if(m%degs(1).ne.2*(m%degs(1)/2)) then ! odd
i = 0.0_wp
else
i = 2.0_wp/real(m%degs(1)+1,wp)*m%coeff
endif
case(2)
if(m%degs(2).ne.2*(m%degs(2)/2)) then ! odd
i = 0.0_wp
else ! even
call binsquare_coeff(m%degs(2)+1,coeff)
i = 0.0_wp
do k=0,m%degs(2)+1
c = m%degs(1)+k+1
i = i + &
real(((-1)**k)*coeff(k+1),wp) * &
(1.0_wp - (-0.5_wp)**c)/real(c,wp)
enddo
i = 2.0_wp/real(m%degs(2)+1,wp) * &
(sqrt(3.0_wp)/3.0_wp)**(m%degs(2)+1) * i
i = m%coeff*i
deallocate(coeff)
endif
case default
i = 0.0_wp
end select
end function refel_int_mon
!-----------------------------------------------------------------------
pure subroutine binsquare_coeff(n,coeff)
integer, intent(in) :: n
integer, intent(out), allocatable :: coeff(:)
integer :: k, h, i, j, temp(n+1,n+1)
temp(1,:) = 1
temp(:,1) = 1
do k=2,n+1
do h=2,k-1
i = k-h+1
j = h
temp(i,j) = temp(i-1,j)+temp(i,j-1)
enddo
enddo
allocate(coeff(n+1))
do k=1,n+1
i = n+1-k+1
j = k
coeff(k) = temp(i,j)
enddo
end subroutine binsquare_coeff
!-----------------------------------------------------------------------
elemental function pderj_mon(m,j) result(djm)
type(t_symmon) :: djm
type(t_symmon), intent(in) :: m
integer, intent(in) :: j
integer, allocatable :: degs(:)
if(j.gt.m%nsv) then
djm%ierr = wrong_input
return
endif
if(m%degs(j).eq.0) then
djm = symmon(0.0_wp,0*m%degs)
else
allocate(degs(m%nsv))
degs = m%degs
degs(j) = m%degs(j)-1
djm = symmon(m%coeff*real(m%degs(j),wp),degs)
deallocate(degs)
endif
end function pderj_mon
!-----------------------------------------------------------------------
subroutine monshow(m)
type(t_symmon), intent(in) :: m
integer :: i, is, ie
integer, parameter :: clen = 2+1+1+2
character(len=9+clen*m%nsv) :: monchar
select case(m%ierr)
case(0)
write(monchar(1:9),'(E9.2)') m%coeff
do i=1,m%nsv
is = 9 + (i-1)*clen + 1
ie = 9 + i*clen
write(monchar(is:ie),'(A,I1,A,I2)') ' x',i,'^',m%degs(i)
enddo
write(*,'(A)') monchar
case(wrong_input)
write(*,*) 'wrong_input'
case(wrong_previous)
write(*,*) 'wrong_previous'
end select
end subroutine monshow
!-----------------------------------------------------------------------
end module mod_symmon
!-----------------------------------------------------------------------
module mod_sympoly
use mod_kinds, only: wp
use mod_symmon, only: &
t_symmon, &
symmon, &
operator(+), &
operator(-), &
operator(*), &
operator(**), &
ev, &
refel_int, &
pderj, &
show
!-----------------------------------------------------------------------
implicit none
!-----------------------------------------------------------------------
public :: &
t_symmon, &
t_sympol, &
operator(+), &
operator(*)
private
!-----------------------------------------------------------------------
type t_sympol
integer :: nmon
type(t_symmon), allocatable :: mons(:)
integer :: deg
integer :: ierr = 0
logical :: reduced = .false.
end type t_sympol
interface operator(+)
module procedure add
end interface
interface operator(*)
module procedure mult
end interface
!-----------------------------------------------------------------------
contains
!-----------------------------------------------------------------------
pure function sympoly(mons) result(p)
type(t_symmon), intent(in) :: mons(:)
type(t_sympol) :: p
p%nmon = size(mons)
allocate(p%mons(p%nmon))
p%mons = mons
p%deg = maxval(p%mons%deg)
end function sympoly
!-----------------------------------------------------------------------
elemental function add(p1,p2) result(p)
type(t_sympol), intent(in) :: p1,p2
type(t_sympol) :: p
p = sympoly((/ p1%mons , p2%mons /))
end function add
!-----------------------------------------------------------------------
elemental function mult(p1,p2) result(p)
type(t_sympol), intent(in) :: p1,p2
type(t_sympol) :: p
integer :: i, j, h
type(t_symmon), allocatable :: mons(:)
allocate(mons(p1%nmon*p2%nmon))
do i=1,p1%nmon
do j=1,p2%nmon
h = (i-1)*p2%nmon + j
mons(h) = p1%mons(i)*p2%mons(j)
enddo
enddo
p = sympoly(mons)
deallocate(mons)
end function mult
!-----------------------------------------------------------------------
end module mod_sympoly