g77 bug 3.1 release
Mauro Moretti
moretti@fe.infn.it
Thu Jul 11 06:36:00 GMT 2002
Dear gcc mainteners. I have an executable which does not behave properly.
I have been able to reduce the source to few lines.
Relevant informations follow (hoping that the problem is not related
to my inexperience in fortran programming)
a) output from gcc -v:
Reading specs from
/home/gcc31/bin/../lib/gcc-lib/i686-pc-linux-gnu/3.1/specs
Configured with: ../gcc-3.1/configure --prefix=/home/carlo/gcc31/
--program-suffix=-3.1 --enable-languages=f77,c,c++,objc
Thread model: single
gcc version 3.1
b) problem:
the attached file
t.f
when compiled with the options
-O2 -fno-automatic
produces an executable which gives the wrong output
c) additional (may be useful) informations
c1) the attached file
t1.f
is the same as t.f plus an additional subroutine which is not
called. It still produces wrong output but different from case b)
c2) both t.f and t1.f when compiled with the options:
-O1 -fno-automatic
-O2
give correct output
c3) previous gcc releases don't show the same "problem"
Mauro Moretti, Dipartimento di Fisica Universita' di Ferrara,
Via Paradiso 12, 44100 Ferrara, Italy
tel 0532 781819
fax 0532 781810
-------------- next part --------------
c******************
program main
c*****************
implicit none
c
complex*16 a,b,c1,c2
complex*16 gamtemp(64)
c
common/vecass/a,b,c1,c2
C
a=(1.d0,0.d0)
b=(0.d0,0.d0)
c1=(2.d0,0.d0)
c2=(2.d0,0.d0)
c
call gammamat(gamtemp)
write(*,*)'gm',gamtemp
c
end
C***********************************************************************
subroutine gammamat(gamtemp)
C***********************************************************************
C
C Returns a*V + b*A interactions, needs to be modified for multiple processes
C
implicit none
C
integer n1,n2,n3,m1 !,label,flag(100)
C
complex*16 a,b,c1,c2,segno
complex*16 gamtemp(64),gamtemp1(4,4,4),gam(4,4,5),
> iden(4,4)
C
common/vecass/a,b,c1,c2
C
c data flag/100*0/
data gam/(1.,0.),(0.,0),(0.,0.),(0.,0.),(0.,0.)
> ,(1.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),
> (-1.,0.),(0.,0.),(0.,0.),(0.,0.), (0.,0.),(-1.,0.), !gamma0
> (0.,0.),(0.,0.),(0.,0.),(1.,0.),(0.,0.),
> (0.,0.),(1.,0.),(0.,0.),(0.,0.),(-1.,0.),
> (0.,0.),(0.,0.),(-1.,0.),(0.,0.),(0.,0.),(0.,0.), !gamma1
> (0.,0.),(0.,0.),(0.,0.),(0.,-1.),(0.,0.),
> (0.,0.),(0.,1.),(0.,0.),(0.,0.),(0.,1.),
> (0.,0.),(0.,0.),(0.,-1.),(0.,0.),(0.,0.), (0.,0.), !gamma2
> (0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.),
> (0.,0.),(0.,0.),(-1.,0.),(-1.,0.),(0.,0.),
> (0.,0.),(0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.), !gamma3
> (0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.),
> (0.,0.),(0.,0.),(1.,0.),(1.,0.),(0.,0.),
> (0.,0.),(0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.)/ !gamma5
data iden/(1.,0.), (0.,0.), (0.,0.), (0.,0.),
* (0.,0.), (1.,0.),(0.,0.), (0.,0.), (0.,0.), (0.,0.),
* (1.,0.), (0.,0.),(0.,0.), (0.,0.), (0.,0.), (1.,0.)/
C
C
C Static variables
C
save gam,iden ! ,flag
C
C
c label=nint(abs(4*(c1-1)+c2))
c if (label.gt.100) then
c write(6,*)'label overflow in GAMMAMAT'
c stop
c endif
c if (flag(label).eq.0) then
c flag(label)=1
do n1=1,4
do n2=1,4
do n3=1,4
gamtemp1(n1,n2,n3)=(0.d0,0.d0)
do m1=1,4
gamtemp1(n1,n2,n3)=gam(m1,n1,n3)*
* (a*iden(m1,n2)+b*gam(n2,m1,5))+gamtemp1(n1,n2,n3)
enddo
enddo
enddo
enddo
C
c write(*,*)'gm1',gamtemp1
C
do n1=0,3
do n2=0,3
do n3=0,3
if (16*n3+4*n2+n1+1.gt.16) then
segno=(-1.d0,0.d0)
else
segno=(1.d0,0.d0)
endif
gamtemp(16*n3+4*n2+n1+1)=gamtemp1(n2+1,n1+1,n3+1)*segno
enddo
enddo
enddo
C
c write(*,*)'gm',gamtemp
C
c endif
C
return
end
C**************************************************************************
subroutine colorelagsu3(momcol,newc,perm)
C**************************************************************************
C
C given three pairs of Q Qbar coulor indexes in MOMCOL(6)
C NEWC returns 0 if the two field cannot be
C combined and PERM return the correct coulor factor in the limit Ncolor = infinity
C
implicit none
C
integer momcol(6),newc,flag
real*8 perm,tabperm(0:3,0:3,0:3,0:3,0:3,0:3)
save flag,tabperm
data tabperm/4096*0./
data flag/0/
C
if(flag.eq.0) then
flag=1
tabperm(1,1,1,2,2,1)=1./sqrt(2.d0)
tabperm(1,1,1,3,3,1)=1.*sqrt(2.d0)
tabperm(1,1,2,1,1,2)=-1./sqrt(2.d0)
tabperm(1,1,2,3,3,2)=1./sqrt(2.d0)
tabperm(1,1,3,1,1,3)=-1.*sqrt(2.d0)
tabperm(1,1,3,2,2,3)=-1./sqrt(2.d0)
tabperm(1,2,1,1,2,1)=-1./sqrt(2.d0)
tabperm(1,2,2,1,1,1)=1./sqrt(2.d0)
tabperm(1,2,2,1,2,2)=-1.*sqrt(1.5d0)
tabperm(1,2,2,2,2,1)=1.*sqrt(1.5d0)
tabperm(1,2,2,3,3,1)=1.
tabperm(1,2,3,1,2,3)=-1.
tabperm(1,3,1,1,3,1)=-1.*sqrt(2.d0)
tabperm(1,3,2,1,3,2)=-1.
tabperm(1,3,3,1,1,1)=1.*sqrt(2.d0)
tabperm(1,3,3,2,2,1)=1.
tabperm(2,1,1,1,1,2)=1./sqrt(2.d0)
tabperm(2,1,1,2,1,1)=-1./sqrt(2.d0)
tabperm(2,1,1,2,2,2)=1.*sqrt(1.5d0)
tabperm(2,1,1,3,3,2)=1.
tabperm(2,1,2,2,1,2)=-1.*sqrt(1.5d0)
tabperm(2,1,3,2,1,3)=-1.
tabperm(2,2,1,2,2,1)=-1.*sqrt(1.5d0)
tabperm(2,2,2,1,1,2)=1.*sqrt(1.5d0)
tabperm(2,2,2,3,3,2)=1.*sqrt(1.5d0)
tabperm(2,2,3,2,2,3)=-1.*sqrt(1.5d0)
tabperm(2,3,1,1,3,2)=-1./sqrt(2.d0)
tabperm(2,3,1,2,3,1)=-1.
tabperm(2,3,2,2,3,2)=-1.*sqrt(1.5d0)
tabperm(2,3,3,1,1,2)=1.
tabperm(2,3,3,2,1,1)=1./sqrt(2.d0)
tabperm(2,3,3,2,2,2)=1.*sqrt(1.5d0)
tabperm(3,1,1,1,1,3)=1.*sqrt(2.d0)
tabperm(3,1,1,2,2,3)=1.
tabperm(3,1,1,3,1,1)=-1.*sqrt(2.d0)
tabperm(3,1,2,3,1,2)=-1.
tabperm(3,2,1,1,2,3)=1./sqrt(2.d0)
tabperm(3,2,1,3,2,1)=-1.
tabperm(3,2,2,1,1,3)=1.
tabperm(3,2,2,2,2,3)=1.*sqrt(1.5d0)
tabperm(3,2,2,3,1,1)=-1./sqrt(2.d0)
tabperm(3,2,2,3,2,2)=-1.*sqrt(1.5d0)
tabperm(1,1,0,1,1,0)=1./sqrt(2.d0)
tabperm(1,1,0,3,3,0)=-1./sqrt(2.d0)
tabperm(1,2,0,1,2,0)=1.
tabperm(1,3,0,1,3,0)=1.
tabperm(2,1,0,2,1,0)=1.
tabperm(2,2,0,1,1,0)=-1./sqrt(6.d0)
tabperm(2,2,0,2,2,0)=sqrt(2.d0/3.d0)
tabperm(2,2,0,3,3,0)=-1./sqrt(6.d0)
tabperm(2,3,0,2,3,0)=1.
tabperm(3,1,0,3,1,0)=1.
tabperm(3,2,0,3,2,0)=1.
tabperm(0,0,0,1,1,0)=1.
tabperm(0,0,0,2,2,0)=1.
tabperm(0,0,0,3,3,0)=1.
tabperm(0,0,0,0,0,0)=1.
endif
C
if (abs(tabperm(momcol(1),momcol(2),momcol(3),
> momcol(4),momcol(5),momcol(6))).gt.1.d-10) then
perm=perm*tabperm(momcol(1),momcol(2),momcol(3),
> momcol(4),momcol(5),momcol(6))
newc=1
else
newc=0
endif
C
return
end
-------------- next part --------------
c******************
program main
c*****************
implicit none
c
complex*16 a,b,c1,c2
complex*16 gamtemp(64)
c
common/vecass/a,b,c1,c2
C
a=(1.d0,0.d0)
b=(0.d0,0.d0)
c1=(2.d0,0.d0)
c2=(2.d0,0.d0)
c
call gammamat(gamtemp)
write(*,*)'gm',gamtemp
c
end
C***********************************************************************
subroutine gammamat(gamtemp)
C***********************************************************************
C
C Returns a*V + b*A interactions, needs to be modified for multiple processes
C
implicit none
C
integer n1,n2,n3,m1 !,label,flag(100)
C
complex*16 a,b,c1,c2,segno
complex*16 gamtemp(64),gamtemp1(4,4,4),gam(4,4,5),
> iden(4,4)
C
common/vecass/a,b,c1,c2
C
c data flag/100*0/
data gam/(1.,0.),(0.,0),(0.,0.),(0.,0.),(0.,0.)
> ,(1.,0.),(0.,0.),(0.,0.),(0.,0.),(0.,0.),
> (-1.,0.),(0.,0.),(0.,0.),(0.,0.), (0.,0.),(-1.,0.), !gamma0
> (0.,0.),(0.,0.),(0.,0.),(1.,0.),(0.,0.),
> (0.,0.),(1.,0.),(0.,0.),(0.,0.),(-1.,0.),
> (0.,0.),(0.,0.),(-1.,0.),(0.,0.),(0.,0.),(0.,0.), !gamma1
> (0.,0.),(0.,0.),(0.,0.),(0.,-1.),(0.,0.),
> (0.,0.),(0.,1.),(0.,0.),(0.,0.),(0.,1.),
> (0.,0.),(0.,0.),(0.,-1.),(0.,0.),(0.,0.), (0.,0.), !gamma2
> (0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.),
> (0.,0.),(0.,0.),(-1.,0.),(-1.,0.),(0.,0.),
> (0.,0.),(0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.), !gamma3
> (0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.),
> (0.,0.),(0.,0.),(1.,0.),(1.,0.),(0.,0.),
> (0.,0.),(0.,0.),(0.,0.),(1.,0.),(0.,0.),(0.,0.)/ !gamma5
data iden/(1.,0.), (0.,0.), (0.,0.), (0.,0.),
* (0.,0.), (1.,0.),(0.,0.), (0.,0.), (0.,0.), (0.,0.),
* (1.,0.), (0.,0.),(0.,0.), (0.,0.), (0.,0.), (1.,0.)/
C
C
C Static variables
C
save gam,iden ! ,flag
C
C
c label=nint(abs(4*(c1-1)+c2))
c if (label.gt.100) then
c write(6,*)'label overflow in GAMMAMAT'
c stop
c endif
c if (flag(label).eq.0) then
c flag(label)=1
do n1=1,4
do n2=1,4
do n3=1,4
gamtemp1(n1,n2,n3)=(0.d0,0.d0)
do m1=1,4
gamtemp1(n1,n2,n3)=gam(m1,n1,n3)*
* (a*iden(m1,n2)+b*gam(n2,m1,5))+gamtemp1(n1,n2,n3)
enddo
enddo
enddo
enddo
C
c write(*,*)'gm1',gamtemp1
C
do n1=0,3
do n2=0,3
do n3=0,3
if (16*n3+4*n2+n1+1.gt.16) then
segno=(-1.d0,0.d0)
else
segno=(1.d0,0.d0)
endif
gamtemp(16*n3+4*n2+n1+1)=gamtemp1(n2+1,n1+1,n3+1)*segno
enddo
enddo
enddo
C
c write(*,*)'gm',gamtemp
C
c endif
C
return
end
More information about the Gcc-bugs
mailing list