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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [short.f] - Blame information for rev 774

Line No.	Rev	Author	Line
1	694	jeremybenn	`c { dg-do run }`
2			`c { dg-options "-std=legacy" }`
3			`c`
4			`program short`
5
6			`parameter ( N=2 )`
7			`common /chb/ pi,sig(0:N)`
8			`common /parm/ h(2,2)`
9
10			`c initialize some variables`
11			`h(2,2) = 1117`
12			`h(2,1) = 1178`
13			`h(1,2) = 1568`
14			`h(1,1) = 1621`
15			`sig(0) = -1.`
16			`sig(1) = 0.`
17			`sig(2) = 1.`
18
19			`call printout`
20			`stop`
21			`end`
22
23			`c ******************************************************************`
24
25			`subroutine printout`
26			`parameter ( N=2 )`
27			`common /chb/ pi,sig(0:N)`
28			`common /parm/ h(2,2)`
29			`dimension yzin1(0:N), yzin2(0:N)`
30
31			`c function subprograms`
32			`z(i,j,k) = 0.5h(i,j)(sig(k)-1.)`
33
34			`c a four-way average of rhobar`
35			`do 260 k=0,N`
36			`yzin1(k) = 0.25 *`
37			`& ( z(2,2,k) + z(1,2,k) +`
38			`& z(2,1,k) + z(1,1,k) )`
39			`260 continue`
40
41			`c another four-way average of rhobar`
42			`do 270 k=0,N`
43			`rtmp1 = z(2,2,k)`
44			`rtmp2 = z(1,2,k)`
45			`rtmp3 = z(2,1,k)`
46			`rtmp4 = z(1,1,k)`
47			`yzin2(k) = 0.25 *`
48			`& ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )`
49			`270 continue`
50
51			`do k=0,N`
52			`if (yzin1(k) .ne. yzin2(k)) call abort`
53			`enddo`
54			`if (yzin1(0) .ne. -1371.) call abort`
55			`if (yzin1(1) .ne. -685.5) call abort`
56			`if (yzin1(2) .ne. 0.) call abort`
57
58			`return`
59			`end`
60