C     CHUONG TRINH FAN TICH NHAN TO
c   Day la c.t gep noi goi cac c.t con trong bo c.t PTNT
$LARGE
$DEBUG
c   Ma tran x1 la ma tran duoc goi tu c.t chinh.
c   Do chinh la ma tran de chuyen thanh mang 1 chieu x.
      SUBROUTINE ptnt(x,N,M,CON)
      dimension B(1),D(1),S(1),XBAR(1)
      DIMENSION T(1),V(1),R(1),TV(1)
      dimension x(1)
   1  FORMAT(//20X,'FAN TICH NHAN TO '//10X,'Dung luong mau = ',
     /I6/10X,'So bien = ',7X,I6)
    2 FORMAT(10X,'Trung binh '/1X,15(F8.1,1X))
    3 FORMAT(10X,'Do lech chuan '/1x,15(F8.1,1X))
    4 FORMAT(10X,'Ma tran tuong quan ')
    5 FORMAT(3X,I3,2X,15F8.3)
    6 FORMAT(10X,'Cac gia tri rieng'/1X,10f12.3)
    7 FORMAT(10X,'Ty so tich luy cua cac tri rieng'/1X,10F8.4)
    8 FORMAT(/10X,'Cac vec to rieng')
    9 FORMAT(2X,15F8.3)
   10 FORMAT(/10X,'Ma tran cac nhan to (',I3,' Nhan to )')
   11 FORMAT(2X,10F11.4)
   12 FORMAT(/5X,'Vong lap ',5X,'Phuong sai ')
   13 FORMAT(7X,I4,9X,E9.4)
   14 FORMAT(/10X,'Ma tran cac nhan to da quay (',I3,' Nhan to)')
   15 FORMAT(2X,10F11.4)
   16 FORMAT(/15X,'Kiem tra tinh tuong thich'/10x,'Bien thu',6X,
     /'Dau',6X,'Cuoi',6X,'Hieu')
   17 FORMAT(12X,I3,6X,3(E9.2  ))
   19 FORMAT(/10X,'Chi co',I3,' nhan to duoc giu lai.
     /Khong thuc hien phep quay')
      WRITE(*,*)'  BAT DAU C.T FACTOR'
      WRITE(3,1)N,M
      IO=1
      CALL CORRE(N,M,IO,x,xbar,s,V,R,d,b,T)
      WRITE(3,2)(XBAR(J),J=1,M)
      WRITE(3,3)(S(J),J=1,M)
c      WRITE(3,4)
c      DO 120 I=1,M
c      DO 110 J=1,M
c      IF(I-J) 102,104,104
c  102 L=I+(J*J-J)/2
c      GOTO 110
c 104 L=J+(I*I-I)/2
c 110 D(J)=R(L)
c 120 WRITE(3,5)I,(D(J),J=1,M)
      MV=0
      CALL EIGEN(R,V,M,MV)
      WRITE(*,*)' TRI RIENG 1,2,3,4,5=',R(1),R(3),R(6),R(10),R(15)
      WRITE(*,'(A\)')'  VAO LAI THAM SO (CON)='
      READ(*,*)CON
      CALL TRACE(M,R,CON,K,D)
      DO 130 I=1,K
      L=I+(I*I-I)/2
c      gtr(i)=r(l)
  130 S(I)=R(L)
      WRITE(3,6)(S(J),J=1,K)
      WRITE(3,7)(D(J),J=1,K)
      WRITE(3,8)
      L=0
      DO 150 J=1,K
      DO 140 I=1,M
      L=L+1
  140 D(I)=V(L)
      write(3,'(5x,'' Vec to '',i4)') j
  150 WRITE(3,9) (D(I),I=1,M)
      CALL LOAD(M,K,R,V)
      WRITE(3,10)K
      DO 180 I=1,M
      DO 170 J=1,K
      L=M*(J-1)+I
c      a1(i,j)=v(l)
  170 D(J)=V(L)
      write(3,'(5x,'' Bien thu '',i4)') i
  180 WRITE(3,11) (D(J),J=1,K)
      IF(K-1)185,185,188
  185 WRITE(3,19)K
      GOTO 100
  188 CALL VARMX(M,K,V,NC,TV,B,T,D)
      NV=NC+1
      WRITE(3,12)
      DO 190 I=1,NV
      NC=I-1
  190 WRITE(3,13)NC,TV(I)
      WRITE(3,14)K
      DO 220 I=1,M
      DO 210 J=1,K
      L=M*(J-1)+I
c      a2(i,j)=v(l)
  210 S(J)=V(L)
      write(3,'(5x,'' Bien thu '',i4)') i
  220 WRITE(3,15) (S(J),J=1,K)
c     do 350 i=1,m
c     do 350 j=1,k
c     a1(i,j)=a1(i,j)/gtr(j)
c 350 a2(i,j)=a2(i,j)/gtr(j)
c     write(3,400)
c 400 format(/10x,'Ma tran cac gia tri nhan to (Tinh voi SL goc)'
c    //5x,'Ma tran TTNT chua quay',20x,'Ma tran TTNT da quay')
c     it=1
c 360 do 351 i=1,n
c     do 351 j=1,m
c     f1(i,j)=0.
c     f2(i,j)=0.
c     do 351 j1=1,m
c     f1(i,j)=f1(i,j)+x1(i,j1)*a1(j1,j)
c 351 f2(i,j)=f2(i,j)+x1(i,j1)*a2(j1,j)
c     do 352 i=1,n
c 352 write(3,401)i,(f1(i,j),j=1,k),(f2(i,j),j=1,k)
c 401 format(1x,i4,2(6f14.1,2x))
c     it=it+1
c     goto 361
c 362 do 353 i=1,n
c     do 353 j=1,m
c 353 x1(i,j)=x1(i,j)-xbar(j)
c     write(3,405)
c 405 format(/10x,'Ma tran cac gia tri nhan to (SL qui tam)'
c    //5x,'Ma tran TTNT chua quay',20x,'Ma tran TTNT da quay')
c     goto 360
c 361 if(it.eq.2)goto 362
c      WRITE(3,16)
c      DO 230 I=1,M
c  230 WRITE(3,17)I,B(I),T(I),D(I)
  100 RETURN
      END