Subversion Repositories openrisc_2011-10-31

! 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