diff options
Diffstat (limited to 'gcc/testsuite/gfortran.dg/pr36206.f')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr36206.f | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/pr36206.f b/gcc/testsuite/gfortran.dg/pr36206.f new file mode 100644 index 000000000..7b0b56639 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr36206.f @@ -0,0 +1,95 @@ +! { 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 |