program simq3
c
c -- fortran program to solve simultaneous equations
c -- by gauss-jordan elimination
c -- subroutines gausj and swap are also needed
c -- figure 4.6
c     
      logical error
      integer size, maxr, maxc, out, index(8,3), nvec
      real a(8,8), y(8), coef(8), b(8,8)
      common /inout/ out, maxr, maxc, error
      data nvec/1/
c
      out = 6
      maxr = 8
      maxc = 8
      write(out, 101)
10    call input(a, y, size)
      if (size .lt. 2) goto 100
      do 30 i = 1, size
       do 20 j = 1, size
        b(i,j) = a(i,j)
20     continue
       coef(i) = y(i)
30    continue
      call gaussj(b, coef, index, size, maxc, nvec, error, out)
      if (.not. error) call output(a, y, coef, size)
      goto 10
100   stop
101   format('1 simultaneous solution by',
     * ' gauss-jordan elimination')
      end
      subroutine input(a, y, n)
c -- get values for n and arrays a, y
c
      integer n, out, i, j, m, maxr
      real a(8,8), y(8)
      common /inout/ out, maxr, maxc, error
c
5     write(out, 105)
      read(*, 106) n
      m = n
      if (n .gt. maxr) goto 5
      if (n .lt. 2) return
      do 20 i = 1, n
       write(out, 101) i
       do 10 j = 1, n
        write(out, 102) j
        read(*, 103) a(i,j)
10     continue
       write(out, 104)
       read(*, 103) y(i)
20    continue
      return
101   format(' equation ', i3/)
102   format('+',i4, ': ' )
103   format(f10.0)
104   format('+ c: ' )
105   format(/' how many equations? ' )
106   format(i2)
      end
      subroutine output(a, y, coef, n)
c
c -- print out the answers
c
      logical error
      integer n, out, i, j, maxr, maxc
      real a(8,8), y(8), coef(8)
      common /inout/ out, maxr, maxc, error
c
      do 10 i = 1, n
       write(out, 101) (a(i,j), j = 1, n), y(i)
10    continue
      write(out,*) '   solution'
      if (error) return
      write(out, 101) (coef(i), i = 1, n)
      return
101   format(1p6e12.4)
      end