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