OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [pr36206.f] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.