1! { dg-do compile } 2! { dg-options "-O3" } 3! PR fortran/36206 4 5 SUBROUTINE SSPR(UPLO,N,ALPHA,X,INCX,AP) 6 REAL ALPHA 7 INTEGER INCX,N 8 CHARACTER UPLO 9 REAL AP(*),X(*) 10 REAL ZERO 11 PARAMETER (ZERO=0.0E+0) 12 REAL TEMP 13 INTEGER I,INFO,IX,J,JX,K,KK,KX 14 LOGICAL LSAME 15 EXTERNAL LSAME 16 EXTERNAL XERBLA 17 18 INFO = 0 19 IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN 20 INFO = 1 21 ELSE IF (N.LT.0) THEN 22 INFO = 2 23 ELSE IF (INCX.EQ.0) THEN 24 INFO = 5 25 END IF 26 IF (INFO.NE.0) THEN 27 CALL XERBLA('SSPR ',INFO) 28 RETURN 29 END IF 30 IF ((N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN 31 IF (INCX.LE.0) THEN 32 KX = 1 - (N-1)*INCX 33 ELSE IF (INCX.NE.1) THEN 34 KX = 1 35 END IF 36 KK = 1 37 IF (LSAME(UPLO,'U')) THEN 38 IF (INCX.EQ.1) THEN 39 DO 20 J = 1,N 40 IF (X(J).NE.ZERO) THEN 41 TEMP = ALPHA*X(J) 42 K = KK 43 DO 10 I = 1,J 44 AP(K) = AP(K) + X(I)*TEMP 45 K = K + 1 46 10 CONTINUE 47 END IF 48 KK = KK + J 49 20 CONTINUE 50 ELSE 51 JX = KX 52 DO 40 J = 1,N 53 IF (X(JX).NE.ZERO) THEN 54 TEMP = ALPHA*X(JX) 55 IX = KX 56 DO 30 K = KK,KK + J - 1 57 AP(K) = AP(K) + X(IX)*TEMP 58 IX = IX + INCX 59 30 CONTINUE 60 END IF 61 JX = JX + INCX 62 KK = KK + J 63 40 CONTINUE 64 END IF 65 ELSE 66 IF (INCX.EQ.1) THEN 67 DO 60 J = 1,N 68 IF (X(J).NE.ZERO) THEN 69 TEMP = ALPHA*X(J) 70 K = KK 71 DO 50 I = J,N 72 AP(K) = AP(K) + X(I)*TEMP 73 K = K + 1 74 50 CONTINUE 75 END IF 76 KK = KK + N - J + 1 77 60 CONTINUE 78 ELSE 79 JX = KX 80 DO 80 J = 1,N 81 IF (X(JX).NE.ZERO) THEN 82 TEMP = ALPHA*X(JX) 83 IX = JX 84 DO 70 K = KK,KK + N - J 85 AP(K) = AP(K) + X(IX)*TEMP 86 IX = IX + INCX 87 70 CONTINUE 88 END IF 89 JX = JX + INCX 90 KK = KK + N - J + 1 91 80 CONTINUE 92 END IF 93 END IF 94 RETURN 95 END 96