| 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)) STOP 1 |
| enddo |
| if (yzin1(0) .ne. -1371.) STOP 2 |
| if (yzin1(1) .ne. -685.5) STOP 3 |
| if (yzin1(2) .ne. 0.) STOP 4 |
| |
| return |
| end |
| |
