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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [short.f] - Blame information for rev 12

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