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