gcc/testsuite/gfortran.dg/g77/short.f

   1 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