Subversion Repositories openrisc

! PR rtl-optimization/37243

! { dg-do run }

! { dg-add-options ieee }

! Check if register allocator handles IR flattening correctly.

      SUBROUTINE SCHMD(V,M,N,LDV)

      IMPLICIT DOUBLE PRECISION(A-H,O-Z)

      LOGICAL GOPARR,DSKWRK,MASWRK

      DIMENSION V(LDV,N)

      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(400)

      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK

      PARAMETER (ZERO=0.0D+00, ONE=1.0D+00, TOL=1.0D-10)

      IF (M .EQ. 0) GO TO 180

      DO 160 I = 1,M

      DUMI = ZERO

      DO 100 K = 1,N

  100 DUMI = DUMI+V(K,I)*V(K,I)

      DUMI = ONE/ SQRT(DUMI)

      DO 120 K = 1,N

  120 V(K,I) = V(K,I)*DUMI

      IF (I .EQ. M) GO TO 160

      I1 = I+1

      DO 140 J = I1,M

      DUM = -DDOT(N,V(1,J),1,V(1,I),1)

      CALL DAXPY(N,DUM,V(1,I),1,V(1,J),1)

  140 CONTINUE

  160 CONTINUE

      IF (M .EQ. N) RETURN

  180 CONTINUE

      I = M

      J = 0

  200 I0 = I

      I = I+1

      IF (I .GT. N) RETURN

  220 J = J+1

      IF (J .GT. N) GO TO 320

      DO 240 K = 1,N

  240 V(K,I) = ZERO

      CALL DAXPY(N,DUM,V(1,I),1,V(1,I),1)

  260 CONTINUE

      DUMI = ZERO

      DO 280 K = 1,N

  280 DUMI = DUMI+V(K,I)*V(K,I)

      IF ( ABS(DUMI) .LT. TOL) GO TO 220

      DO 300 K = 1,N

  300 V(K,I) = V(K,I)*DUMI

      GO TO 200

  320 END

      program main

      DOUBLE PRECISION V

      DIMENSION V(18, 18)

      common // v

      call schmd(V, 1, 18, 18)

      end

      subroutine DAXPY

      end

      FUNCTION DDOT ()

      DOUBLE PRECISION DDOT

      DDOT = 1

      end