      programminvt
      integer*1l,n
      dimensiona(5,5),l(5)
      integer*1char
      reallog,log10
      datan/5/
      datakb/3/,kons/3/
      datarpd/.01745329/,dpr/57.29578/
      datapi/3.141593/
      do 23000i=1,n
      do 23002j=1,n
      a(j,i)=1./real(i+j-1)
23002 continue
23003 continue
23000 continue
23001 continue
      write(kons,20)a
20    format(1x,5g12.6)
      callminv(a,n,l,det)
      write(kons,20)det
      write(kons,20)a
      callminv(a,n,l,det)
      write(kons,20)det
      write(kons,20)a
      stop
      end
      subroutineminv(a,n,l,det)
      dimensiona(n,n),l(n)
      integer*1l,j,k,n,it,i
      datakb/3/,kons/3/
      datarpd/.01745329/,dpr/57.29578/
      datapi/3.141593/
      nd=n
      do 23004j=1,n
      l(j)=j
23004 continue
23005 continue
      det=1.
      do 23006k=1,n
      if(.not.(fmxmgv(a(k,k),n,n-k+1,jr).eq.0.))goto 23008
      write(kons,900)
      goto 23007
23008 continue
900   format(1x,15hSingular Matrix)
      if(.not.(jr.ne.1))goto 23010
      j=k-1+jr
      it=l(k)
      l(k)=l(j)
      l(j)=it
      callfvswap(a(1,k),1,a(1,j),1,nd)
      det=-det
23010 continue
      q=a(k,k)
      det=q*det
      a(k,k)=1.
      do 23012i=1,n
      a(i,k)=a(i,k)/q
23012 continue
23013 continue
      continue
      j=1
23014 if(.not.(j.le.n))goto 23016
      if(.not.(j.eq.k))goto 23017
      goto 23015
23017 continue
      q=-a(k,j)
      a(k,j)=0.
      do 23019i=1,n
      a(i,j)=a(i,k)*q+a(i,j)
23019 continue
23020 continue
23015 j=j+1
      goto 23014
23016 continue
23006 continue
23007 continue
      n1=n-1
      do 23021k=1,n1
      continue
      i=k
23023 if(.not.(i.le.n.and.l(i).ne.k))goto 23025
23024 i=i+1
      goto 23023
23025 continue
      callfvswap(a(k,1),nd,a(i,1),nd,nd)
      l(i)=l(k)
23021 continue
23022 continue
      return
      end
      functionfmxmgv(a,ia,l,k)
      dimensiona(1)
      fmxmgv=0.
      is=1
      do 23026i=1,l
      absa=abs(a(is))
      if(.not.(absa.gt.fmxmgv))goto 23028
      fmxmgv=absa
      k=i
23028 continue
      is=is+ia
23026 continue
23027 continue
      return
      end
      subroutinefvswap(a,ia,b,ib,n)
      dimensiona(1),b(1)
      isa=1
      isb=1
      do 23030i=1,n
      t=a(isa)
      a(isa)=b(isb)
      b(isb)=t
      isa=isa+ia
      isb=isb+ib
23030 continue
23031 continue
      return
      end
