c    @(#)balanc.f	1.1
c
c
c
c
      subroutine balanc(nm,n,a,low,igh,scale)
      integer i,j,k,l,m,n,jj,nm,igh,low,iexc
      real a(nm,n),scale(n)
      real c,f,g,r,s,b2,radix
      logical noconv
      radix = 2.
      b2 = radix * radix
      k = 1
      l = n
      go to 100
   20 scale(m) = j
      if (j .eq. m) go to 50
      do 30 i = 1, l
         f = a(i,j)
         a(i,j) = a(i,m)
         a(i,m) = f
   30 continue
      do 40 i = k, n
         f = a(j,i)
         a(j,i) = a(m,i)
         a(m,i) = f
   40 continue
   50 go to (80,130), iexc
   80 if (l .eq. 1) go to 280
      l = l - 1
  100 do 120 jj = 1, l
         j = l + 1 - jj
         do 110 i = 1, l
            if (i .eq. j) go to 110
            if (a(j,i) .ne. 0.0) go to 120
  110    continue
         m = l
         iexc = 1
         go to 20
  120 continue
      go to 140
  130 k = k + 1
  140 do 170 j = k, l
         do 150 i = k, l
            if (i .eq. j) go to 150
            if (a(i,j) .ne. 0.0) go to 170
  150    continue 
         m = k
         iexc = 2
         go to 20
  170 continue
      do 180 i = k, l
  180 scale(i) = 1.0
  190 noconv = .false.
      do 270 i = k, l
         c = 0.0
         r = 0.0
         do 200 j = k, l
            if (j .eq. i) go to 200
            c = c + abs(a(j,i)) 
            r = r + abs(a(i,j))
  200    continue
         g = r / radix
         f = 1.0
         s = c + r
  210    if (c .ge. g) go to 220
         f = f * radix
         c = c * b2
         go to 210
  220    g = r * radix
  230    if (c .lt. g) go to 240
         f = f / radix
         c = c / b2
         go to 230
  240    if ((c + r) / f .ge. 0.95 * s) go to 270
         g = 1.0 / f
         scale(i) = scale(i) * f 
         noconv = .true.
         do 250 j = k, n
  250    a(i,j) = a(i,j) * g
         do 260 j = 1, l
  260    a(j,i) = a(j,i) * f
  270 continue
      if (noconv) go to 190
  280 low = k
      igh = l
      return
      end
