Unroll bug in egcs-2.93.04 19990205
Toon Moene
toon@moene.indiv.nluug.nl
Fri Feb 5 06:41:00 GMT 1999
Using the Fortran source below, I get:
[hirlam@moene grdy32]$ /usr/snp/bin/g77 -c -v -O2 -funroll-loops h.f
g77 version egcs-2.93.04 19990205 (gcc2 ss-980929 experimental) (from
FSF-g77 version 0.5.24-19980804)
Reading specs from
/usr/snp/lib/gcc-lib/i686-pc-linux-gnu/egcs-2.93.04/specs
gcc version egcs-2.93.04 19990205 (gcc2 ss-980929 experimental)
/usr/snp/lib/gcc-lib/i686-pc-linux-gnu/egcs-2.93.04/f771 h.f -quiet
-dumpbase h.f -O2 -version -fversion -funroll-loops -o /tmp/ccRaiaaa.s
GNU F77 version egcs-2.93.04 19990205 (gcc2 ss-980929 experimental)
(i686-pc-linux-gnu) compiled by GNU C version egcs-2.93.04 19990205
(gcc2 ss-980929 experimental).
GNU Fortran Front End version 0.5.24-19980804
../../egcs/gcc/unroll.c:1548: Internal compiler error in function
calculate_giv_inc
Please submit a full bug report to `egcs-bugs@cygnus.com'.
See <URL: http://egcs.cygnus.com/faq.html#bugreport > for details.
The Source:
SUBROUTINE GETDAT (
I KLON , KLAT , KLEV
I , KUNIT , KLUDIR , FTYPE , FSUB
I , KYEAR , KMONTH , KDAY , KHOUR
R , PTWODT , PACRIT
R , PPSZ , PLNPSZ
R , PUZ , PVZ , PTZ , PQZ , PSZ , PEDOTZ
R , PTSZ , PSWZ , PSNZ , PTSD
R , PSWD , PROU , PTSS , PTSC
R , PSWC , PSNC , PROC , PALB , PFRF
R , PFRL , PFRI , PALN , PSLT , PCLT
+ , PSVARZ , KSVAR , KWMOSV
L , LGRIB , LHUMC , LSLAN , LSIMP , LRDCW )
CHARACTER FTYPE*(*), FSUB*(*)
REAL
* PPSZ(KLON*KLAT), PLNPSZ(KLON*KLAT),
* PUZ(KLON*KLAT,KLEV), PVZ(KLON*KLAT,KLEV),
* PTZ(KLON*KLAT,KLEV), PQZ(KLON*KLAT,KLEV),
* PSZ(KLON*KLAT,KLEV), PEDOTZ(KLON*KLAT,KLEV+1),
* PTSZ(KLON*KLAT), PSWZ(KLON*KLAT), PSNZ(KLON*KLAT),
* PTSD(KLON*KLAT), PSWD(KLON*KLAT), PROU(KLON*KLAT),
* PTSS(KLON*KLAT), PTSC(KLON*KLAT), PSWC(KLON*KLAT),
* PSNC(KLON*KLAT), PROC(KLON*KLAT), PALB(KLON*KLAT),
* PFRF(KLON*KLAT),
* PFRL(KLON*KLAT), PFRI(KLON*KLAT), PALN(KLON*KLAT),
* PSLT(KLON*KLAT), PCLT(KLON*KLAT)
*, PSVARZ(KLON*KLAT,KLEV,*)
LOGICAL LGRIB , LHUMC , LSLAN , LSIMP
LOGICAL LRDCW ! indicator whether to read cloud water
LOGICAL LOCW ! indicator of cloud water in file
LOGICAL LOROU ! indicator of roughness over sea in file
INTEGER KWMOSV(*)
PARAMETER ( MLON=110, MLAT=100, MLEV = 31 )
INTEGER MLATLONX
PARAMETER ( MLATLONX=110 )
PARAMETER ( MBDPTS = 8+2, MMLFLD = 6 )
PARAMETER ( MMODES = 4 )
PARAMETER ( MTASK = 82 )
PARAMETER ( MLNLT = MLON*MLAT )
PARAMETER ( MSVAR = 0)
INTEGER MTYP
PARAMETER ( MTYP = 5 )
REAL
+ ZWORK(MLNLT)
REAL ZRHUC(KLEV),ZRELF0,ZRELF1,ZRELF2,
+ ZDRELF,ZPDPS,ZCLOUD,ZPI,ZEARTH,ZRHU,ZMEPSI,
+ ZDIST,ZRELFH,ZQSAT,
+ ZCVAL1,ZCVAL2
REAL ZESATD,ZC2,ZC4,ZES,
+ ZC1ES,ZC2ES,ZC2IS,ZC3ES,ZC4ES,ZC4IS
LOGICAL
+ LOSV(MSVAR+1) ! indicator of extra scalars in file
COMMON / COMMAP /
R ANORTH , WEST , SOUTH , EAST , APLON , APLAT
R , DLAMDA , DTHETA , RDLAM , RDTH , RA
R , AHYB(MLEV+1), BHYB(MLEV+1)
R , RHXU(MLNLT) , RHYV(MLNLT) , HXV(MLNLT) ,HYU(MLNLT)
R , PHIS(MLNLT) , FPAR(MLNLT)
R , HYBI(MLEV+1), HYBK(MLEV)
COMMON / COMBDY /
I LUBFI1 , LUBFI2 , NBDNUM , NBDPTS , NBHOUR(100)
I , NBDDIF , NBDTIM
I , NMLFLD , NBDPTR(2)
R , TIMRAT , BDFUNC(100), WEIGHT(MLNLT,3)
L , NLTANH , NLPWEI , NLBDUV
LOGICAL
* NLTANH , NLPWEI , NLBDUV
PARAMETER ( MLNLTB = MLNLT-(MLON-2*MBDPTS-1)*(MLAT-2*MBDPTS-1) )
COMMON / COMIBV / BNDVAL(MLNLTB,1+MMLFLD*MLEV,2)
+ , BNDVSV(MLNLTB,MLEV,2,MSVAR+1)
L , LCW(2)
+ , LSV(MSVAR+1,2)
LOGICAL LCW ! indicator of cloud water in boundary data
+ , LSV ! indicator of extra scalars in boundary data
COMMON / COMEXT /
I NEXTRD , NEXTRX(40) , NEXTRY(40)
COMMON /COMDDR/
1 NCODHL,NLDRHL,NLNXHL,MRCLHL,MDRLHL,NTYPHL,NEXPHL,NMDIHL
1,NIDFHL(12)
2,NDTVHL,NSCVHL,NDTBHL,NSCBHL,NFLHHL,NFLSHL,NDORHL
2,NIDTHL(13)
3,NPRJHL,NPRCHL,NLONHL,NLATHL
4,NLTPHL,NLEVHL,NPPLHL,NRFLHL
4,NLPTHL(40)
5,NMLFHL,NWMMHL(40),NMPTHL(40)
6,NSLFHL,NWMSHL(40),NSPTHL(40),NSLTHL(40)
C,APLOHL,APLAHL,AWESHL,AEASHL,ALALHL,ALAFHL,DLONHL,DLATHL
C,GRIDHL(28)
D,ALEVHL(40,4),RLEVHL(4)
E,STMXHL(40),STMYHL(40),STMZHL(40)
F,STSXHL(40),STSYHL(40),SLEVHL(40,4)
G,RSRVHL(150)
DIMENSION DDRHL(1000),NDDRHL(1000)
EQUIVALENCE (DDRHL,NDDRHL,NCODHL),(NMDIHL,AMDIHL)
real pi,latvap,rair,cpair,ccpq,epsilo,gravit,tmelt,latice,
+ rhos,rhoh2o,solar,stebol,carman,rearth,omega
common/confys/pi,latvap,rair,cpair,ccpq,epsilo,gravit,tmelt,
+ latice,rhos,rhoh2o,solar,stebol,carman,rearth,omega
LOGICAL ILPHYS
ILNLT = KLON*KLAT
ILPHYS = .FALSE.
IF (NBDNUM.EQ.1) ILPHYS = .TRUE.
CALL GETGRB (
I KLEV,KLON,KLAT,
R PHIS(1),PPSZ(1),PUZ(1,1),PVZ(1,1),PTZ(1,1),PQZ(1,1),PSZ(1,1),
R PTSZ(1),PTSD(1),PTSC(1),PSWZ(1),PSWD(1),PSWC(1),
R PSNZ(1),PTSS(1),PFRL(1),PFRI(1),
R PALB(1),PFRF(1),PROC(1),PROU(1),
I IYEAR,IMONTH,IDAY,IHOUR,ILNGTH,
R WEST,SOUTH,DLAMDA,DTHETA,APLON,APLAT,
C FTYPE,FSUB,
+ PSVARZ(1,1,1),KSVAR,KWMOSV(1),LOSV(1),
R KUNIT,KLUDIR,.FALSE.,ILPHYS,LRDCW,
L LOCW,LOROU)
IF (ILPHYS) THEN
DO JL=1,ILNLT
PSNC(JL) = PSNZ(JL)
IF (.NOT. LOROU) PROU(JL) = PROC(JL)
ENDDO
ENDIF
IF (KLON.NE.NLONHL.OR.KLAT.NE.NLATHL.OR.KLEV.NE.NLEVHL) THEN
WRITE(6,'(/,1X,A,I4)')'WRONG DIMENSIONS IN FILE',KUNIT
WRITE(6,'(1X,''NLONHL,NLATHL,NLEVHL='',3I10)')
+ NLONHL,NLATHL,NLEVHL
WRITE(6,'(1X,''KLON ,KLAT ,KLEV ='',3I10)')
+ KLON ,KLAT ,KLEV
CALL ABORT
ENDIF
IF (NBDNUM.EQ.1) THEN
WRITE(6,'(/,1X,''DATE/TIME FOR START DATA:'',I8.8,a,i6.6)')
+ NDTVHL,'/',NSCVHL
ELSE
WRITE(6,'(/,1X,''DATE/TIME FOR BOUNDARY DATA:'',I8.8,a,i6.6)')
+ NDTVHL,'/',NSCVHL
ENDIF
NBHOUR(NBDNUM) = NSCVHL/10000
WRITE(6,'(1X,''NBHOUR('',I2,'') ='',I10)')NBDNUM,NBHOUR(NBDNUM)
IF (NBDNUM.EQ.1) THEN
KYEAR = NDTVHL/10000
KMONTH = NDTVHL/100 -KYEAR*100
KDAY = NDTVHL -KYEAR*10000 -KMONTH*100
KHOUR = NSCVHL/10000
IF (DLATHL.LT.0.) THEN
ANORTH = ALAFHL
SOUTH = ALALHL
DTHETA =-DLATHL
ELSEIF (DLATHL.GT.0.) THEN
ANORTH = ALALHL
SOUTH = ALAFHL
DTHETA = DLATHL
ELSE
WRITE (6,'(/,1X,''DLATHL IS NOT DEFINED IN SDFILE'')')
CALL ABORT
END IF
WEST = AWESHL
EAST = AEASHL
APLON = APLOHL
APLAT = APLAHL
DLAMDA = DLONHL
WRITE(6,'(/,1X,''GENERATED FROM START DATA FILE:'')')
WRITE(6,'( 1X,''-------------------------------'')')
WRITE(6,'(1X,''WEST = '',F15.7)') WEST
WRITE(6,'(1X,''EAST = '',F15.7)') EAST
WRITE(6,'(1X,''SOUTH = '',F15.7)') SOUTH
WRITE(6,'(1X,''ANORTH = '',F15.7)') ANORTH
WRITE(6,'(1X,''DLAMDA = '',F15.7)') DLAMDA
WRITE(6,'(1X,''DTHETA = '',F15.7)') DTHETA
WRITE(6,'(1X,''APLON = '',F15.7)') APLON
WRITE(6,'(1X,''APLAT = '',F15.7)') APLAT
AHYB(KLEV+1) = 0.
BHYB(KLEV+1) = 1.
DO 200 JK=KLEV,2,-1
AHYB(JK) = 2.0*ALEVHL(JK,1) - AHYB(JK+1)
BHYB(JK) = 2.0*ALEVHL(JK,2) - BHYB(JK+1)
IF ( AHYB(JK).LT.1.0E-7 ) AHYB(JK) = 0.0
IF ( BHYB(JK).LT.1.0E-7 ) BHYB(JK) = 0.0
200 CONTINUE
AHYB(1) = 0.
BHYB(1) = 0.
DO 210 JK=1,KLEV+1
HYBI(JK) = AHYB(JK)/101325.0 + BHYB(JK)
210 CONTINUE
DO 220 JK=1,KLEV
HYBK(JK) = (HYBI(JK) + HYBI(JK+1))/2.0
220 CONTINUE
WRITE(6,'(/,1X,''FULL LEVELS:'')')
WRITE(6,'(1X,''FIRST PARAMETER ='')')
WRITE(6,'(3X,5F14.7,20(/,3X,5F14.7))')(ALEVHL(J,1),J=1,KLEV)
WRITE(6,'(1X,''SECOND PARAMETER ='')')
WRITE(6,'(3X,5F14.7,20(/,3X,5F14.7))')(ALEVHL(J,2),J=1,KLEV)
WRITE(6,'(/,1X,''HALF LEVELS:'')')
WRITE(6,'(1X,''FIRST PARAMETER ='')')
WRITE(6,'(3X,5F14.7,20(/,3X,5F14.7))')(AHYB(J),J=1,KLEV+1)
WRITE(6,'(1X,''SECOND PARAMETER ='')')
WRITE(6,'(3X,5F14.7,20(/,3X,5F14.7))')(BHYB(J),J=1,KLEV+1)
CALL MAPFAC (
I KLON,KLAT,KLEV,
R PALN(1),PSLT(1),PCLT(1) )
ENDIF
DO 250 JL=1,ILNLT
PLNPSZ(JL) = ALOG( PPSZ(JL) )
250 CONTINUE
IF ( NEXTRD.GT.0 ) THEN
WRITE(6,'(/,1X,''GRIDPOINT EXAMPLES:'')')
WRITE(6,'( 1X,''-------------------'')')
DO 320 J=1,NEXTRD
CALL EXTRDA (
I KLON,KLAT,KLEV,NEXTRX(J),NEXTRY(J),
R PTZ(1,1),PUZ(1,1),PVZ(1,1),PQZ(1,1),PSZ(1,1) )
IPOINT = (NEXTRY(J)-1)*KLON + NEXTRX(J)
WRITE(6,'(3X,''PS = '',F15.7)') PPSZ(IPOINT)
320 CONTINUE
END IF
IF (LHUMC)
* CALL CRIHUM (
I KLON,KLAT,KLEV,
R AHYB(1),BHYB(1),PACRIT,
R PPSZ(1),PTZ(1,1),PQZ(1,1),ZWORK(1) )
IF (LSLAN)
* CALL COMPED (
I KLON,KLAT,KLEV,
R PPSZ(1),PUZ(1,1),PVZ(1,1),PEDOTZ(1,1) )
IF( .NOT.LOCW ) THEN
ZMEPSI=1. -EPSILO
ZPI=PI
ZEARTH=REARTH
ZDIST=SQRT( ZEARTH*ZPI*0.20/180. )
ZRELF0=0.0200
ZRELF1=0.3000
ZRELF2=0.0030
ZDRELF=0.0300
ZRELFH=ZRELF1*(1. -EXP( -ZRELF2*ZDIST ))
ZC1ES=610.78
ZC2ES=17.269
ZC2IS=21.875
ZC3ES=273.16
ZC4ES=35.86
ZC4IS=7.66
DO JK=1,KLEV
ZPDPS=MIN( HYBK(JK), 1.0 )
ZRHUC(JK)=ZRELFH*
+ ( ZRELF0 +ZDRELF*(1. -ZPDPS*ZPDPS*ZPDPS ) )/
+ ( ZRELF0 +ZDRELF )
ENDDO
DO JK=1,KLEV
DO JL=1,ILNLT
ZC2=ZC2IS + min(1.,max(0.,(PTZ(JL,JK) -ZC3ES +15.)/15.))*
+ ( ZC2ES-ZC2IS )
ZC4=ZC4IS + min(1.,max(0.,(PTZ(JL,JK) -ZC3ES +15.)/15.))*
+ ( ZC4ES-ZC4IS )
ZES=ZC2*(PTZ(JL,JK) -ZC3ES)/(PTZ(JL,JK) -ZC4)
ZESATD=ZC1ES*EXP(ZES)
ZWORK(JL)=1./( ALEVHL(JK,1) +ALEVHL(JK,2)*PPSZ(JL) -
+ ZMEPSI*ZESATD )
ZQSAT=EPSILO*ZESATD*ZWORK(JL)
IF (PQZ(JL,JK).GT.ZQSAT) PQZ(JL,JK) = ZQSAT
IF (PQZ(JL,JK).LT.0. ) PQZ(JL,JK) = 1.E-7
ZRHU=MAX( PQZ(JL,JK)/ZQSAT, ZRHUC(JK) )
ZCLOUD=1. -SQRT( (1.-ZRHU)/(1.-ZRHUC(JK)) )
PSZ(JL,JK)=0. ! it was not on the file, remember!
ZCVAL1=(PQZ(JL,JK) +PSZ(JL,JK))*(1.-ZRHUC(JK))
ZCVAL2=(PQZ(JL,JK) +PSZ(JL,JK))*(1.+ZRHUC(JK))
IF( ZCVAL1.GT.ZQSAT ) THEN
PSZ(JL,JK)=ZQSAT*ZRHUC(JK)/(1.-ZRHUC(JK))
ENDIF
IF( (ZCVAL1.LE.ZQSAT).AND.(ZCVAL2.GT.ZQSAT) ) THEN
PSZ(JL,JK)=ZQSAT/
+ ( 1. +ZRHUC(JK) -2.*ZRHUC(JK)*ZCLOUD ) -PQZ(JL,JK)
ENDIF
ENDDO
ENDDO
ENDIF
CALL STATIS (
I KLON,KLAT,KLEV,0,
R PTWODT,
R PPSZ(1),PUZ(1,1),PVZ(1,1),PTZ(1,1),PQZ(1,1),PSZ(1,1),
R PPSZ(1) )
WRITE(6,'(/,1X,''STATISTICS FROM FILE'',I4)') KUNIT
WRITE(6,'( 1X,''------------------------'')')
CALL PRSTAT
IF (NBDNUM.EQ.1) THEN
ILNLTB1=0
ILNLTB2=0
ILNLTB3=0
DO JL=1,ILNLT
IF (WEIGHT(JL,1).NE.0.) ILNLTB1=ILNLTB1+1
IF (WEIGHT(JL,2).NE.0.) ILNLTB2=ILNLTB2+1
IF (WEIGHT(JL,3).NE.0.) ILNLTB3=ILNLTB3+1
ENDDO
ILNLTB=MAX(ILNLTB1,ILNLTB2,ILNLTB3)
IF (ILNLTB.GT.MLNLTB) THEN
WRITE(6,'(1X,''IN *GETDAT*:'')')
WRITE(6,'(1X,''INCREASE *MBDPTS* IN PARAMETER *PARAMM*'')')
WRITE(6,'(1X,''MLNLTB,ILNLTB='',2I9)') MLNLTB,' ',ILNLTB
WRITE(6,'(1X,''MBDPTS='',I5)') MBDPTS
CALL ABORT
ENDIF
ENDIF
IF (NBDNUM.LE.2) THEN
NBDPTR(NBDNUM) = NBDNUM
NBNEXT = NBDNUM
ELSE
ISAVE = NBDPTR(1)
NBDPTR(1) = NBDPTR(2)
NBDPTR(2) = ISAVE
NBNEXT = NBDPTR(2)
ENDIF
LCW(NBNEXT)=LOCW
IF (LSLAN) THEN
IF (.NOT.LCW(NBNEXT)) THEN
DO JK=1,KLEV
DO JL=1,ILNLT
PSZ(JL,JK)=0.
ENDDO
ENDDO
ENDIF
LCW(NBNEXT)=.TRUE.
ENDIF
DO L=1,KSVAR
LSV(L,NBNEXT)=LOSV(L)
IF (LSLAN) THEN
IF (.NOT.LSV(L,NBNEXT)) THEN
DO JK=1,KLEV
DO JL=1,ILNLT
PSVARZ(JL,JK,L)=0.
ENDDO
ENDDO
ENDIF
LSV(L,NBNEXT)=.TRUE.
ENDIF
ENDDO
IF (LSIMP) THEN
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,1).NE.0.0) THEN
IP=IP+1
BNDVAL(IP,1,NBNEXT)=PLNPSZ(JL)
ENDIF
ENDDO
ELSE
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,1).NE.0.0) THEN
IP=IP+1
BNDVAL(IP,1,NBNEXT)=PPSZ(JL)
ENDIF
ENDDO
ENDIF
DO JK=1,KLEV
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,1).NE.0.0) THEN
IP=IP+1
BNDVAL(IP,1+JK+2*KLEV,NBNEXT)=PTZ(JL,JK)
BNDVAL(IP,1+JK+3*KLEV,NBNEXT)=PQZ(JL,JK)
BNDVAL(IP,1+JK+4*KLEV,NBNEXT)=PSZ(JL,JK)
ENDIF
ENDDO
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,2).NE.0.0) THEN
IP=IP+1
BNDVAL(IP,1+JK,NBNEXT)=PUZ(JL,JK)
ENDIF
ENDDO
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,3).NE.0.0) THEN
IP=IP+1
BNDVAL(IP,1+JK+KLEV,NBNEXT)=PVZ(JL,JK)
ENDIF
ENDDO
IF (LSLAN) THEN
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,1).NE.0.0) THEN
IP=IP+1
BNDVAL(IP,1+JK+5*KLEV,NBNEXT)=PEDOTZ(JL,JK)
ENDIF
ENDDO
ENDIF
ENDDO
DO L=1,KSVAR
DO JK=1,KLEV
IP=0
DO JL=1,ILNLT
IF (WEIGHT(JL,1).NE.0.0) THEN
IP=IP+1
BNDVSV(IP,JK,NBNEXT,L)=PSVARZ(JL,JK,L)
ENDIF
ENDDO
ENDDO
ENDDO
RETURN
END
--
Toon Moene (toon@moene.indiv.nluug.nl)
Saturnushof 14, 3738 XG Maartensdijk, The Netherlands
Phone: +31 346 214290; Fax: +31 346 214286
g77 Support: fortran@gnu.org; egcs: egcs-bugs@cygnus.com
More information about the Gcc-bugs
mailing list