MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

replace with better test

Browse Source 
From-SVN: r27370
This commit is contained in:
Craig Burley 1999-06-05 14:44:16 +00:00 committed by Craig Burley
parent 0ff8379990
commit 622cc043aa
2 changed files with 67 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
1999-06-05 Craig Burley <craig@jcb-sc.com>
* g77.f-torture/compile/19990502-0.f: Replace with new,
shorter, test that still fails after recent changes.
Fri Jun 4 02:25:04 1999 Andreas Schwab <schwab@issan.cs.uni-dortmund.de>
* gcc.c-torture/execute/990604-1.c: New test.

409
gcc/testsuite/g77.f-torture/compile/19990502-0.f
View File

@ -1,351 +1,66 @@
SUBROUTINE TRF2F2(QDERIV,QPRINT,
@ XRH,XRK,XRL,FCALC,FOBS,FPART,WEIGHT,TEST,FOM,
@ ITEST)
C
C Computes the standard linear correlation coefficient between
C F(obs)^2 and F(calc)^2 or between |F(obs)| and |F(calc)|
C
C Author: Axel T. Brunger
C =======================
IMPLICIT NONE
C I/O
C*
C* BEGINNING OF INCLUDE FILE: xrefin.fcm
C*
C
C XREFIN.FCM
C
C data structure for XREFIN.FLX
C crystallographic restraints
C
C update flags
LOGICAL XRQCHK, XRUPAT, XRREUP
C
C method flag
LOGICAL QFFT, QLOOK
C target function string
CHARACTER*4 XRTRGT
C
C tolerance for linear approximation
DOUBLE PRECISION XRLTOL
C
C x-ray diffraction data
C XRMREF: max. allocation for reflections
C XRNREF: current number of reflections
C XRIREF: number of reflections within limits (resolution, f_window...)
C XRNPHA: number of phase specifications
C XRH, XRK, XRL: reflection indices
C FOBS: observed structure factor
C FOM: figure of merit for observed phases (zero if not used)
C WEIGHT: individual weight
C FCALC: calculated structure factor
C FPART: partial structure factor to be added to FCALC
C TEST: integer array for cross-validation tests
INTEGER XRMREF, XRNREF, XRIREF, XRNPHA
INTEGER HPH, HPK, HPL, HPFOBS, HPFCAL, HPFPAR, HPFOM
INTEGER HPWEIG, HPTEST, HPSIGM
C scattering tables
INTEGER XRSM, XRSN
PARAMETER (XRSM=20)
DOUBLE PRECISION XRSA(XRSM,4), XRSB(XRSM,4), XRSC(XRSM)
DOUBLE PRECISION XRF(XRSM), XRSI(XRSM)
C unit cell
DOUBLE PRECISION XRCELL(9), XRTR(3,3), XRINTR(3,3), XRVOL
C symmetry operators
INTEGER XRNSYM, XRMSYM, XRSYTH
PARAMETER (XRMSYM=192, XRSYTH=24)
INTEGER XRSYMM(XRMSYM,3,4), XRITSY(XRMSYM,3,3)
LOGICAL QHERM
C reciprocal resolution limits
DOUBLE PRECISION XRHIGH, XRLOW
C fobs limits
DOUBLE PRECISION XRFLOW, XRFHIG
C XREFIN atom lists
INTEGER XRMATO, XRNATO, XRNATF, HPFLAG, HPATOM, HPINDX
INTEGER HPATOF, HPINDF, HPFX, HPFY, HPFZ, HPFB, HPFQ, HPFQS
INTEGER HPDX, HPDY, HPDZ, HPDT, HPDQ
C scale factor
DOUBLE PRECISION XRSCAL
C phase potential scale factor and exponent
DOUBLE PRECISION XRPSCA
INTEGER XRPEXP
C Fobs/Fcalc scale factor
DOUBLE PRECISION XRFFK
LOGICAL XRFFKQ
C unscaled restraint energies
DOUBLE PRECISION XRE, XREPHA
C number of bins for R factor analysis
INTEGER MBINS
C logical flag indicating the presence of TEST sets (for
C cross-validation)
LOGICAL XCVTEST
C
C double precision common block
C
COMMON /XREFI/ XRLTOL,
@ XRSA, XRSB, XRSC, XRF, XRSI,
@ XRCELL, XRTR, XRINTR, XRHIGH, XRLOW,
@ XRSCAL, XRPSCA,
@ XRFFK, XRE, XREPHA,
@ XRFLOW, XRFHIG, XRVOL
C
C integer common block
C
COMMON /IXREFI/
@ XRMREF, XRNREF, XRIREF, XRNPHA, HPH, HPK, HPL,
@ HPFOBS, HPFCAL, HPFPAR, HPFOM, HPWEIG, HPTEST,
@ HPSIGM, XRSN, HPFLAG,
@ XRMATO, XRNATO, HPATOM, HPINDX, XRNATF, HPATOF,
@ HPINDF, HPFX, HPFY, HPFZ, HPFB, HPFQ, HPFQS,
@ HPDX, HPDY, HPDZ, HPDT, HPDQ,
@ XRPEXP,
@ XRNSYM, XRSYMM, MBINS, XRITSY
C
C logical common block
C
COMMON /LXREFI/ XRQCHK, XRUPAT, XRFFKQ,
@ QFFT, QLOOK, XRREUP, QHERM, XCVTEST
C
C character string common block
C
COMMON /CXREFI/ XRTRGT
C
SAVE /XREFI/
SAVE /IXREFI/
SAVE /LXREFI/
SAVE /CXREFI/
C*
C* BEGINNING OF INCLUDE FILE: consta.fcm
C*
C CONSTA.FCM
C
C this file contains all physical and mathematical constants
C and conversion factors.
C
C at present the following units are used:
C
C length: Angstroms
C time: ps
C energy: Kcal/mol
C mass: atomic-mass-unit
C charge: electron-charge
C
C
DOUBLE PRECISION RSMALL
PARAMETER (RSMALL=1.0D-10)
DOUBLE PRECISION R4SMAL,R4BIG
PARAMETER (R4SMAL=0.0001D0,R4BIG=1.0D+10)
C
C physical constants in SI units
C ------------------------------
C Kb = 1.380662 E-23 J/K
C Na = 6.022045 E23 1/mol
C e = 1.6021892 E-19 C
C eps = 8.85418782 E-12 F/m
C
C 1 Kcal = 4184.0 J
C 1 amu = 1.6605655 E-27 Kg
C 1 A = 1.0 E-10 m
C
C reference: CRC Handbook for Chemistry and Physics, 1983/84
C
C
DOUBLE PRECISION PI
PARAMETER(PI=3.1415926535898D0)
C
C TIMFAC is the conversion factor from AKMA time to picoseconds.
C (TIMFAC = SQRT ( ( 1A )**2 * 1amu * Na / 1Kcal )
C this factor is used only intrinsically, all I/O is in ps.
C
DOUBLE PRECISION TIMFAC
PARAMETER (TIMFAC=0.04888821D0)
C
C KBOLTZ is Boltzman constant AKMA units (KBOLTZ = N *K / 1 Kcal)
C a b
DOUBLE PRECISION KBOLTZ
PARAMETER (KBOLTZ=1.987191D-03)
C
C CCELEC is 1/ (4 pi eps ) in AKMA units, conversion from SI
C units: CCELEC = e*e*Na / (4*pi*eps*1Kcal*1A)
C
DOUBLE PRECISION CCELEC
PARAMETER (CCELEC=332.0636D0)
C
C CDEBHU is used in the Debye-Hueckel approximation:
C DIV GRAD phi = kappa**2 phi
C kappa**2 = CDEBHU * ionic_strength [M] / ( T [K] eps )
C ext
C where CDEBHU is defined as CDEBHU=2E+3 Na e**2 / (eps0 Kb )
C (in SI units, ref: Gordon M.Barrow, Physical Chemistry,
C McGraw Hill (1979) ) and ionic_strength is given in molar units.
C The conversion to AKMA units brings another factor 1.0E-20.
C
DOUBLE PRECISION CDEBHU
PARAMETER (CDEBHU=2529.09702D0)
LOGICAL QDERIV, QPRINT
INTEGER XRH(*), XRK(*), XRL(*)
DOUBLE COMPLEX FCALC(*), FOBS(*), FPART(*)
DOUBLE PRECISION WEIGHT(*)
INTEGER TEST(*)
DOUBLE PRECISION FOM(*)
INTEGER ITEST
C local
INTEGER REFLCT
DOUBLE PRECISION CI, CJ, CII, CJJ, CIJ, IFCALC, IFOBS
DOUBLE PRECISION WSUM, DSUM, CSUM, DERIV, CORR
CHARACTER*30 LINE
INTEGER LLINE
DOUBLE COMPLEX DBCOMP
C parameters
DOUBLE PRECISION ZERO, ONE, TWO, THREE, FOUR
PARAMETER (ZERO=0.0D0, ONE=1.0D0, TWO=2.0D0, THREE=3.0D0)
PARAMETER (FOUR=4.0D0)
C begin
C
C initialize correlation coefficients
WSUM=ZERO
CI=ZERO
CJ=ZERO
CII=ZERO
CJJ=ZERO
CIJ=ZERO
IF (XRTRGT.EQ.'F2F2') THEN
DO 17790 REFLCT=1,XRIREF
IF (TEST(REFLCT).EQ.ITEST) THEN
C
C compute F^2's
IFOBS=DREAL(FOBS(REFLCT))**2+DIMAG(FOBS(REFLCT))**2
IFCALC=DREAL(FCALC(REFLCT)+FPART(REFLCT))**2
@ +DIMAG(FCALC(REFLCT)+FPART(REFLCT))**2
C
C accumulate information for weighted correlation coefficients
WSUM=WSUM+WEIGHT(REFLCT)
CI=CI+WEIGHT(REFLCT)*IFOBS
CJ=CJ+WEIGHT(REFLCT)*IFCALC
CII=CII+WEIGHT(REFLCT)*IFOBS**2
CJJ=CJJ+WEIGHT(REFLCT)*IFCALC**2
CIJ=CIJ+WEIGHT(REFLCT)*IFOBS*IFCALC
* Mailing-List: contact egcs-bugs-help@egcs.cygnus.com; run by ezmlm
* Precedence: bulk
* Sender: owner-egcs-bugs@egcs.cygnus.com
* From: Norbert Conrad <Norbert.Conrad@hrz.uni-giessen.de>
* Subject: egcs g77 19990524pre Internal compiler error in `print_operand'
* To: egcs-bugs@egcs.cygnus.com
* Date: Mon, 31 May 1999 11:46:52 +0200 (CET)
* Content-Type: text/plain; charset=US-ASCII
* X-UIDL: 9a00095a5fe4d774b7223de071157374
*
* Hi,
*
* I ./configure --prefix=/opt and bootstrapped egcs g77 snapshot 19990524
* on an i686-pc-linux-gnu. The program below gives an internal compiler error.
*
*
* Script started on Mon May 31 11:30:01 1999
* lx{g010}:/tmp>/opt/bin/g77 -v -O3 -malign-double -c e3.f
* g77 version gcc-2.95 19990524 (prerelease) (from FSF-g77 version 0.5.24-19990515)
* Reading specs from /opt/lib/gcc-lib/i686-pc-linux-gnu/gcc-2.95/specs
* gcc version gcc-2.95 19990524 (prerelease)
* /opt/lib/gcc-lib/i686-pc-linux-gnu/gcc-2.95/f771 e3.f -quiet -dumpbase e3.f -malign-double -O3 -version -fversion -o /tmp/ccQgeaaa.s
* GNU F77 version gcc-2.95 19990524 (prerelease) (i686-pc-linux-gnu) compiled by GNU C version gcc-2.95 19990524 (prerelease).
* GNU Fortran Front End version 0.5.24-19990515
* e3.f:25: Internal compiler error in `print_operand', at ./config/i386/i386.c:3405
* Please submit a full bug report to `egcs-bugs@egcs.cygnus.com'.
* See <URL:http://egcs.cygnus.com/faq.html#bugreport> for details.
* lx{g010}:/tmp>cat e3.f
SUBROUTINE DLASQ2( QQ, EE, TOL2, SMALL2 )
DOUBLE PRECISION SMALL2, TOL2
DOUBLE PRECISION EE( * ), QQ( * )
INTEGER ICONV, N, OFF
DOUBLE PRECISION QEMAX, XINF
EXTERNAL DLASQ3
INTRINSIC MAX, SQRT
XINF = 0.0D0
ICONV = 0
IF( EE( N ).LE.MAX( QQ( N ), XINF, SMALL2 )*TOL2 ) THEN
END IF
17790 CONTINUE
ELSE
DO 17791 REFLCT=1,XRIREF
IF (TEST(REFLCT).EQ.ITEST) THEN
C
C compute |F|'s
IFOBS=SQRT(DREAL(FOBS(REFLCT))**2+DIMAG(FOBS(REFLCT))**2)
IFCALC=SQRT(DREAL(FCALC(REFLCT)+FPART(REFLCT))**2
@ +DIMAG(FCALC(REFLCT)+FPART(REFLCT))**2)
C
C accumulate information for weighted correlation coefficients
WSUM=WSUM+WEIGHT(REFLCT)
CI=CI+WEIGHT(REFLCT)*IFOBS
CJ=CJ+WEIGHT(REFLCT)*IFCALC
CII=CII+WEIGHT(REFLCT)*IFOBS**2
CJJ=CJJ+WEIGHT(REFLCT)*IFCALC**2
CIJ=CIJ+WEIGHT(REFLCT)*IFOBS*IFCALC
IF( EE( N-2 ).LE.MAX( XINF, SMALL2,
$ ( QQ( N ) / ( QQ( N )+EE( N-1 ) ) )* QQ( N-1 ))*TOL2 ) THEN
QEMAX = MAX( QQ( N ), QQ( N-1 ), EE( N-1 ) )
END IF
17791 CONTINUE
IF( N.EQ.0 ) THEN
IF( OFF.EQ.0 ) THEN
RETURN
ELSE
XINF =0.0D0
END IF
ELSE IF( N.EQ.2 ) THEN
END IF
C
C do some checking
IF (ABS(CI).LT.RSMALL) THEN
WRITE(6,'(A,I3,A)')
@ ' %TRF2F2-error: sum over WEIGHT*FOBS is zero (for TEST=',
@ ITEST,')'
ELSE IF (ABS(CJ).LT.RSMALL) THEN
WRITE(6,'(A,I3,A)')
@' %TRF2F2-error: sum over WEIGHT*(FCALC+FPART) is 0 (for TEST=',
@ ITEST,')'
ELSE
C
C compute weighted correlation coefficient
DSUM=(CII-CI**2/WSUM)*(CJJ-CJ**2/WSUM)
CSUM=CIJ - CI*CJ/WSUM
IF (DSUM.GT.RSMALL) THEN
DSUM=SQRT(DSUM)
CORR=CSUM/DSUM
ELSE
CORR=ZERO
END IF
C
C store in energy term
XRE=XRSCAL*(ONE-CORR)
C
C compute derivatives if required
IF (QDERIV) THEN
C
C compute derivatives for F's
IF (XRTRGT.EQ.'F2F2') THEN
DO 17792 REFLCT=1,XRIREF
IF (TEST(REFLCT).EQ.ITEST) THEN
C
C compute amplitudes
IFOBS=DREAL(FOBS(REFLCT))**2+DIMAG(FOBS(REFLCT))**2
IFCALC=DREAL(FCALC(REFLCT)+FPART(REFLCT))**2
@ +DIMAG(FCALC(REFLCT)+FPART(REFLCT))**2
C
C compute derivative with respect to FCALC(H)
IF (DSUM.GT.RSMALL) THEN
DERIV=-TWO*XRSCAL*WEIGHT(REFLCT)*( (IFOBS-CI/WSUM)/DSUM -
@ (CORR/DSUM**2)*(CII-CI**2/WSUM)*(IFCALC-CJ/WSUM) )
ELSE
DERIV=ZERO
END IF
FCALC(REFLCT)=(FCALC(REFLCT)+FPART(REFLCT))*DERIV
ELSE
FCALC(REFLCT)=ZERO
END IF
17792 CONTINUE
ELSE
DO 17793 REFLCT=1,XRIREF
IF (TEST(REFLCT).EQ.ITEST) THEN
C
C compute amplitudes
IFOBS=SQRT(DREAL(FOBS(REFLCT))**2+DIMAG(FOBS(REFLCT))**2)
IFCALC=SQRT(DREAL(FCALC(REFLCT)+FPART(REFLCT))**2
@ +DIMAG(FCALC(REFLCT)+FPART(REFLCT))**2)
C
C compute derivative with respect to |FCALC|(H)
IF (DSUM.GT.RSMALL.AND.IFCALC.GT.RSMALL) THEN
DERIV=-XRSCAL*WEIGHT(REFLCT)*( (IFOBS-CI/WSUM)/DSUM -
@ (CORR/DSUM**2)*(CII-CI**2/WSUM)*(IFCALC-CJ/WSUM) ) /
@ IFCALC
ELSE
DERIV=ZERO
END IF
FCALC(REFLCT)=(FCALC(REFLCT)+FPART(REFLCT))*DERIV
ELSE
FCALC(REFLCT)=ZERO
END IF
17793 CONTINUE
END IF
END IF
C
IF (QPRINT) THEN
IF (XCVTEST.AND.ITEST.EQ.0) THEN
CALL DECLAR( 'CORR', 'DP', ' ', DBCOMP, CORR )
LINE=' ->[WORKING SET (TEST=0)]'
LLINE=25
ELSEIF (XCVTEST.AND.ITEST.EQ.1) THEN
CALL DECLAR( 'TEST_CORR', 'DP', ' ', DBCOMP, CORR )
LINE=' ->[TEST SET (TEST=1)] '
LLINE=22
ELSE
CALL DECLAR( 'CORR', 'DP', ' ', DBCOMP, CORR )
LINE=' '
LLINE=1
END IF
IF (XRTRGT.EQ.'F2F2') THEN
WRITE(6,'(3A,F12.3)')
@ ' TRF2F2:',LINE(1:LLINE),
@ ' Corr<F(obs)^2, F(calc)^2> =',CORR
ELSE
WRITE(6,'(3A,F12.3)')
@ ' TRF2F2:',LINE(1:LLINE),
@ ' Corr<|F(obs)|, |F(calc)|> =',CORR
END IF
END IF
C
END IF
RETURN
CALL DLASQ3(ICONV)
END
* lx{g010}:/tmp>exit
*
* Script done on Mon May 31 11:30:23 1999
*
* Best regards,
*
* Norbert.
* --
* Norbert Conrad phone: ++49 641 9913021
* Hochschulrechenzentrum email: conrad@hrz.uni-giessen.de
* Heinrich-Buff-Ring 44
* 35392 Giessen
* Germany