URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [short.f] - Rev 302
Go to most recent revision | Compare with Previous | Blame | View Log
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
Go to most recent revision | Compare with Previous | Blame | View Log