gcc/testsuite/g77.f-torture/execute/short.f

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