URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [pr36206.f] - Blame information for rev 399

Go to most recent revision | Details | Compare with Previous | View Log

Line No.	Rev	Author	Line
1	302	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`

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [pr36206.f] - Blame information for rev 399