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