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

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