gcc/testsuite/gfortran.dg/pr36206.f

   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