program simq5
c
c -- fortran program to solve simultaneous equations
c -- by gauss-jordan elimination
c -- there may be more equations than unknowns
c -- subroutines square, gaussj and swap are also needed
c -- figure 4.12
c     
      logical error
      integer maxr, maxc, out, n, m, 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, n, m)
      if (m .lt. 2) goto 100
      call square(a, y, b, coef, n, m, maxr, maxc)
      call gaussj(b, coef, index, m, maxr, nvec, error, out)
      if (.not. error) call output(a, y, coef, n, m)
      goto 10
100   stop
101   format('1 best fit to simultaneous equations',
     * ' by gauss-jordan elimination')
      end
      subroutine input(a, y, n, m)
c
c --  get values for n and arrays a and y
c
      integer n, m, out, i, j, maxr
      real a(8,8), y(8)
      common /inout/ out, maxr, maxc, error
c
5     write(out, 107)
      read(*, 106) m
      if (m .gt. maxc) goto 5
      if (m .lt. 2) return
7     write(out, 105)
      read(*, 106) n
      if (n .lt. m) goto 7
      do 20 i = 1, n
       write(out, 101) i
       do 10 j = 1, m
        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)
107   format(' how many unknows? ' )
      end
      subroutine output(a, y, coef, n, m)
c
c -- print the answers
c
      logical error
      integer n, m, 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, m), y(i)
10    continue
      write(out,*) '   solution'
      if (error) return
      write(out, 101) (coef(i), i = 1, m)
      return
101   format(1p6e12.4)
      end