! { dg-do compile } ! { dg-options "-O3" } ! PR fortran/36206 SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP) REAL ALPHA INTEGER INCX,N CHARACTER UPLO REAL AP(*),X(*) REAL ZERO PARAMETER (ZERO=0.0E+0) REAL TEMP INTEGER I,INFO,IX,J,JX,K,KK,KX LOGICAL LSAME EXTERNAL LSAME EXTERNAL XERBLA INFO = 0 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN INFO = 1 ELSE IF (N.LT.0) THEN INFO = 2 ELSE IF (INCX.EQ.0) THEN INFO = 5 END IF IF (INFO.NE.0) THEN CALL XERBLA('SSPR ',INFO) RETURN END IF IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN IF (INCX.LE.0) THEN KX = 1 - (N-1)*INCX ELSE IF (INCX.NE.1) THEN KX = 1 END IF KK = 1 IF (LSAME(UPLO,'U')) THEN IF (INCX.EQ.1) THEN DO 20 J = 1,N IF (X(J).NE.ZERO) THEN TEMP = ALPHA*X(J) K = KK DO 10 I = 1,J AP(K) = AP(K) + X(I)*TEMP K = K + 1 10 CONTINUE END IF KK = KK + J 20 CONTINUE ELSE JX = KX DO 40 J = 1,N IF (X(JX).NE.ZERO) THEN TEMP = ALPHA*X(JX) IX = KX DO 30 K = KK,KK + J - 1 AP(K) = AP(K) + X(IX)*TEMP IX = IX + INCX 30 CONTINUE END IF JX = JX + INCX KK = KK + J 40 CONTINUE END IF ELSE IF (INCX.EQ.1) THEN DO 60 J = 1,N IF (X(J).NE.ZERO) THEN TEMP = ALPHA*X(J) K = KK DO 50 I = J,N AP(K) = AP(K) + X(I)*TEMP K = K + 1 50 CONTINUE END IF KK = KK + N - J + 1 60 CONTINUE ELSE JX = KX DO 80 J = 1,N IF (X(JX).NE.ZERO) THEN TEMP = ALPHA*X(JX) IX = JX DO 70 K = KK,KK + N - J AP(K) = AP(K) + X(IX)*TEMP IX = IX + INCX 70 CONTINUE END IF JX = JX + INCX KK = KK + N - J + 1 80 CONTINUE END IF END IF RETURN END