c-----------------------------------------------------------
c Chapter 17: Renumbering Rows and Columns of a Array(p150)
c-----------------------------------------------------------
c   Name of subroutine: RENUMB
c
c   Algorithm:Renumber rows and columns of a matrix.
c
c   input:    
c   complier: f77 renumb_2.f cycles.f
c-----------------------------------------------------------

      parameter(m=9,n=9)
      integer m,n,sig(m),tau(n),a(m,n)
      write(*,10)
10    format('Input the number of sig')
      read(*,15), (sig(i),i=1,m) 
15    format(9(i2))
      write(*,20)
20    format('Input the number of tau')
      read(*,25) (tau(i),i=1,n) 
25    format(9(i2))
      write(*,30)
30    format('Input the matrix A')
      do 40 i=1,m
      read(5,*) (a(i,j),j=1,n) 
40    continue
      call renumb(m,n,sig,tau,a)
      write(*,45)
45    format('The output matrix A is')
      do 50 i=1,m
      write(*,60) (a(i,j),j=1,n) 
60    format(9(i3))
50    continue
      stop 
      end
      

c-----Subroutine begins here--------------------------------
      subroutine renumb(m,n,sig,tau,a)
      integer sig(m),tau(n),a(m,n),t1,t2
      call cycles(sig,m,is,nc,1)
      if(tau(1) .gt. 0) call cycles(tau,n,is,nc,1)
      do 10  i=1,m
      i1=-sig(i)
      if(i1.lt.0) go to 10 
      lc=0
20    i1=sig(i1)
      lc=lc+1
      if(i1.gt.0) go to 20
      i1=i
      do 30 j=1,n
      if(tau(j) .gt. 0) go to 30 
      j2=j
      k=lc
40    j1=j2
      t1=a(i1,j1)
50    i1=iabs(sig(i1))
      j1=iabs(tau(j1))
      t2=a(i1,j1)
      a(i1,j1)=t1
      t1=t2
      if(j1 .ne. j2) go to 50
      k=k-1
      if(i1. ne. i) go to 50
      j2=iabs(tau(j2))
55    if(k.ne.0) go to 40
30    continue
10    continue
      do 60  i=1,m
60    sig(i)=iabs(sig(i))
      if(tau(1) .gt. 0) return
      do 70 j=1,n
70    tau(j)=iabs(tau(j))
      return
      end