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 708

Go to most recent revision | 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.