OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [20010116.f] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
c { dg-do run }
2
c { dg-options "-std=legacy" }
3
c
4
*
5
*  Derived from LAPACK 3.0 routine CHGEQZ
6
*  Fails on i686-pc-cygwin with gcc-2.97 snapshots at -O2 and higher
7
*  PR fortran/1645
8
*
9
*  David Billinghurst, (David.Billinghurst@riotinto.com)
10
*  14 January 2001
11
*  Rewritten by Toon Moene (toon@moene.indiv.nluug.nl)
12
*  15 January 2001
13
*
14
      COMPLEX A(5,5)
15
      DATA A/25*(0.0,0.0)/
16
      A(4,3) = (0.05,0.2)/3.0E-7
17
      A(4,4) = (-0.03,-0.4)
18
      A(5,4) = (-2.0E-07,2.0E-07)
19
      CALL CHGEQZ( 5, A )
20
      END
21
      SUBROUTINE CHGEQZ( N, A )
22
      COMPLEX   A(N,N), X
23
      ABS1( X ) = ABS( REAL( X ) ) + ABS( AIMAG( X ) )
24
      DO J = 4, 2, -1
25
         I = J
26
         TEMP  = ABS1( A(J,J) )
27
         TEMP2 = ABS1( A( J+1, J ) )
28
         TEMPR = MAX( TEMP, TEMP2 )
29
         IF( TEMPR .LT. 1.0 .AND. TEMPR .NE. 0.0 ) THEN
30
            TEMP  = TEMP / TEMPR
31
            TEMP2 = TEMP2 / TEMPR
32
         END IF
33
         IF ( ABS1(A(J,J-1))*TEMP2 .LE. TEMP ) GO TO 90
34
      END DO
35
c     Should not reach here, but need a statement
36
      PRINT*
37
  90  IF ( I .NE. 4 ) THEN
38
         PRINT*,'I =', I, ' but should be 4'
39
         CALL ABORT()
40
      END IF
41
      END

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.