OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [short.f] - Blame information for rev 325

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.