c { dg-do run }
|
c { dg-do run }
|
c { dg-options "-std=legacy" }
|
c { dg-options "-std=legacy" }
|
c
|
c
|
program short
|
program short
|
|
|
parameter ( N=2 )
|
parameter ( N=2 )
|
common /chb/ pi,sig(0:N)
|
common /chb/ pi,sig(0:N)
|
common /parm/ h(2,2)
|
common /parm/ h(2,2)
|
|
|
c initialize some variables
|
c initialize some variables
|
h(2,2) = 1117
|
h(2,2) = 1117
|
h(2,1) = 1178
|
h(2,1) = 1178
|
h(1,2) = 1568
|
h(1,2) = 1568
|
h(1,1) = 1621
|
h(1,1) = 1621
|
sig(0) = -1.
|
sig(0) = -1.
|
sig(1) = 0.
|
sig(1) = 0.
|
sig(2) = 1.
|
sig(2) = 1.
|
|
|
call printout
|
call printout
|
stop
|
stop
|
end
|
end
|
|
|
c ******************************************************************
|
c ******************************************************************
|
|
|
subroutine printout
|
subroutine printout
|
parameter ( N=2 )
|
parameter ( N=2 )
|
common /chb/ pi,sig(0:N)
|
common /chb/ pi,sig(0:N)
|
common /parm/ h(2,2)
|
common /parm/ h(2,2)
|
dimension yzin1(0:N), yzin2(0:N)
|
dimension yzin1(0:N), yzin2(0:N)
|
|
|
c function subprograms
|
c function subprograms
|
z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
|
z(i,j,k) = 0.5*h(i,j)*(sig(k)-1.)
|
|
|
c a four-way average of rhobar
|
c a four-way average of rhobar
|
do 260 k=0,N
|
do 260 k=0,N
|
yzin1(k) = 0.25 *
|
yzin1(k) = 0.25 *
|
& ( z(2,2,k) + z(1,2,k) +
|
& ( z(2,2,k) + z(1,2,k) +
|
& z(2,1,k) + z(1,1,k) )
|
& z(2,1,k) + z(1,1,k) )
|
260 continue
|
260 continue
|
|
|
c another four-way average of rhobar
|
c another four-way average of rhobar
|
do 270 k=0,N
|
do 270 k=0,N
|
rtmp1 = z(2,2,k)
|
rtmp1 = z(2,2,k)
|
rtmp2 = z(1,2,k)
|
rtmp2 = z(1,2,k)
|
rtmp3 = z(2,1,k)
|
rtmp3 = z(2,1,k)
|
rtmp4 = z(1,1,k)
|
rtmp4 = z(1,1,k)
|
yzin2(k) = 0.25 *
|
yzin2(k) = 0.25 *
|
& ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
|
& ( rtmp1 + rtmp2 + rtmp3 + rtmp4 )
|
270 continue
|
270 continue
|
|
|
do k=0,N
|
do k=0,N
|
if (yzin1(k) .ne. yzin2(k)) call abort
|
if (yzin1(k) .ne. yzin2(k)) call abort
|
enddo
|
enddo
|
if (yzin1(0) .ne. -1371.) call abort
|
if (yzin1(0) .ne. -1371.) call abort
|
if (yzin1(1) .ne. -685.5) call abort
|
if (yzin1(1) .ne. -685.5) call abort
|
if (yzin1(2) .ne. 0.) call abort
|
if (yzin1(2) .ne. 0.) call abort
|
|
|
return
|
return
|
end
|
end
|
|
|
|
|