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