!-----------------------------------------------------------------------
! CHUONG TRINH GOI TINH TAI TRONG NHAN TO VA CAC NHAN TO

  SUBROUTINE PTNT(XX,N,M,NEig_Max) !CON) ! ,VarName, Sample,Grads_File, Out_Dir, NT1_TT2, StartTime)
! 
      INCLUDE 'FTNT.INC'
      real :: B(MMax),D(MMax),S(MMax),XBAR(MMax)
      real :: T(MMax),V(MMax*MMax),R(MMax*MMax),TV(MMax*MMax)
      real :: xx(NMax,MMax), x(NMax*MMax), Y(NMax,MMax)
      real :: TriRieng(MMax),VTORieng(MMax,MMax) ! MOI COT LA MOT VECTO
      real :: TaiTrong(MMax,MMax) ! MOI COT LA TAI TRONG CUA MOT NHAN TO
      REAL :: NhanTo(NMax,MMax)   ! MOI COT LA MOT NHAN TO
!		   
      REAL :: TT_DAQUAY(MMAX,MMAX), NT_DAQUAY(NMAX,MMAX)
      REAL :: SumEig, TMP,tmp1, tmp2
      Character*20 :: Fmt
      real :: Con, Threshold
!@      Character (Len = 11) :: VarName(MMax), Sample(MMax)
      Integer :: M, N, I, J, K, IO, Nthre, NEig, NEig_Max
!@      Character *(*) :: Grads_File, Out_Dir, StartTime

!@      Common /StationInfo/ Lon, Lat, H
      Common /Factors/ TaiTrong, NhanTo, TT_DAQUAY, NT_DAQUAY
      Common /CEigen/ NEig, TriRieng, VTORieng, SumEig

      Threshold = 0.95  ! Giu lai 95% luong thong tin
!@@@      NEig_Max  = 3     ! So luong Gia tri rieng toi da duoc giu lai
      WRITE(*,*)'  BAT DAU C.T FACTOR: N,M=',N,M
!------------------------------------------------------------------------
      k=0
      do j=1,m
         do i=1,n
            k=k+1
            x(k)=xx(i,j)
         enddo
      enddo
!@      write (3, "(A)") "PHAN TICH NHAN TO"
!@      WRITE(3,'(A17,I3)')'Dung luong mau = ',N
!@      WRITE(3,'(A17,I3)')'So bien = ',M

      IO=1
      CALL CORRE(N,M,IO,x,xbar,s,V,R,d,b,T)

 ! Tinh Ma tran Do lech (Y) cua X
      Tmp=SQRT(REAL(N))
      do i=1,N
         do j=1,M
            Y(i,j) = (XX(i,j)-XBAR(j))/S(J)/TMP
         enddo
      enddo

!@      write (Fmt, '(A,I3.3,A)') '(',M,'(1x,A7))'
!@      write (3, Fmt) (VarName(j),j=1,M)

!@      write (3, '(A)') 'Trung binh '
!@      write (Fmt,'(A1,I3.3,A5)') "(", M, "F8.1)"
!@      WRITE(3,Fmt)(XBAR(J),J=1,M)

!@      write (3, '(A)') 'Do lech chuan '
!@      WRITE (3,Fmt)(S(J),J=1,M)

!@      WRITE(3,'(A)') 'Ma tran tuong quan '
!@      write (Fmt,'(A6,I3.3,A5)') "(I3,", M, "F8.4)"

      Do I=1,M
         DO J=1,M
            if ((I-J) < 0) then
               L=I+(J*J-J)/2
            else
               L=J+(I*I-I)/2
            endif
            D(J)=R(L)
         ENDDO
!@         WRITE(3,Fmt)I,(D(J),J=1,M)
      ENDDO
!---------------------------------------------

      MV=0
      CALL EIGEN(R,V,M,MV)
! Luu cac tri rieng va Vecto rieng
      tmp = 0. ! Tong cac tri rieng
      do I=1,M
         L=I+(I*I-I)/2
         TriRieng(I) = R(L)
         tmp = tmp+TriRieng(I) ! Tong cac tri rieng
      enddo
      SumEig=tmp

      tmp1 = 0; Nthre = 0  ! De so voi Tong cac tri rieng
      Do i=1,M
         tmp1 = tmp1+TriRieng(I); 
         Nthre=Nthre+1
         tmp2 = tmp1/tmp
         if (NEig_Max==0) then    ! 
            if (tmp2 > Threshold) exit
!@         if ((tmp2 > Threshold) .OR. (Nthre >= NEig_Max)) exit  ! Vuot nguong nhung khong qua 4 nhan to
         else
            if (Nthre >= NEig_Max) exit  ! Vuot nguong nhung khong qua 4 nhan to
         endif
      Enddo

!!     CON = 3.  
      CON =  TriRieng(Nthre)   ! Xac dinh lai nguong gia tri cua Tri rieng duoc giu lai
      L=0
      do J=1,M
         do I=1,M
            L=L+1
            VTORieng(i,j) = V(L)
         enddo
      enddo

!@      WRITE(*,*)' TRI RIENG 1,2,3,4,5=',R(1),R(3),R(6),R(10),R(15)
!@      write(*,'(A,F10.3)') "Gia tri nguong CON: ", CON
!@      write(*,'(A,F10.3)') "So phan tram luong thong tin duoc giu lai: ",tmp1/tmp*100.

!      WRITE(*,'(A\)')'  VAO LAI THAM SO (CON)='
!      READ(*,*)CON
      CALL TRACE(M,R,CON,K,D)
      DO I=1,K
         L=I+(I*I-I)/2
         S(I)=R(L)
      ENDDO
      NEig = K   ! Luu so tri rieng

!@      WRITE(3,'(A)') 'Cac gia tri rieng '
!@      write (Fmt,'(A,I3.3,A5)') "(", K, "F8.2)"

!@      WRITE(3,Fmt)(S(J),J=1,K)
!@      WRITE(3,'(A)') 'Ty so tich luy cua cac tri rieng '
!@      WRITE(3,Fmt)(D(J),J=1,K)
!@      WRITE(3,'(A)') 'Cac vec to rieng'

!@      write (Fmt,'(A,I3.3,A5)') "(A,I3,", M, "F8.3)"
      L=0
      DO J=1,K
         DO I=1,M
            L=L+1
            D(I)=V(L)
         ENDDO
!@         WRITE(3,Fmt) "Vector ",j, (D(I),I=1,M)
      ENDDO
      CALL LOAD(M,K,R,V)
!@      WRITE(3,'(A,I2,A)') 'Ma tran cac Tai trong nhan to (',K,' Nhan to )'
!@      write (Fmt,'(A,I2.2,A5)') "(I4,1x,A11,1x", K, "F8.4)"

      DO I=1,M
         DO J=1,K
            L=M*(J-1)+I
            D(J)=V(L)
         ENDDO
! Luu Ma tran Tai trong Nhan to (K nhan to)
         do j=1,K
            TaiTrong(I,J) = D(j)
         enddo
!@         WRITE(3,Fmt) i, VarName(i), (D(J),J=1,K)
      ENDDO

   If (K > 1) Then
      CALL VARMX(M,K,V,NC,TV,B,T,D)
      NV=NC+1


! In Ket qua kiem tra (Unit=4)
!      WRITE(4,'(2A10)') 'Vong lap ','Phuong sai'
!      DO I=1,NV
!         NC=I-1
!         WRITE(4,'(I4,6X,F20.10)') NC, TV(I)
!      ENDDO

!@      WRITE(3,'(A,I2,A)') 'Ma tran cac Tai trong nhan to da quay (',K,' Nhan to)'

!@      write (Fmt,'(A,I2.2,A5)') "(I4,1x,A11,1x", K, "F8.4)"
      DO I=1,M
         DO J=1,K
            L=M*(J-1)+I
            TT_DAQUAY(I,J)=V(L)
            S(J)=V(L)
         ENDDO
!@         WRITE(3,Fmt) i, VarName(i), (S(J),J=1,K)
      ENDDO
! Thu so sanh
!      WRITE(3,'(A)') 'Ma tran cac nhan to da quay (de so sanh)'
!      Do i=1,M
!         WRITE(3,Fmt) i, VarName(i), (TT_DAQUAY(I,J),j=1,K)
!      Enddo 
! Tinh Ma tran Nhan to (F) & NTO DA QUAY
      do i=1,N
         do j=1,K
            NhanTo(i,j)=0.0
            NT_DAQUAY(I,J)=0.0
            do L=1,M
               NhanTo(i,j)=NhanTo(i,j)+Y(i,L)*TaiTrong(L,j)
               NT_DAQUAY(I,J)=NT_DAQUAY(I,J)+Y(I,L)*TT_DAQUAY(L,J)
            enddo
  
            NhanTo(i,j)=NhanTo(i,j)/(TriRieng(j))
            NT_DAQUAY(i,j)=NT_DAQUAY(i,j)/(TriRieng(j))
         enddo
      enddo

! In Ket qua 

!      write(3,*)' Tai trong Nhan to'
!      write (Fmt,'(A,I2.2,A5)') "(I2,1x,A11,1x", K, "F8.4)"
!      do i=1,M
!         write(3,Fmt) i, VarName(i), (TaiTrong(i,j),j=1,K)
!      enddo

!@      write(3,*)' Ma tran Nhan to'
!@      do i=1,N
!@         write(3,Fmt) i, Sample(i), (NhanTo(i,j),j=1,K)
!@      enddo

!@      write(3,*)' Ma tran Nhan to da quay'
!@      do i=1,N
!@         write(3,Fmt) i, Sample(i), (NT_DaQuay(i,j),j=1,K)
!@      enddo

! Write out for GrADS
!      Call Write_GrADS (M, N, K, Grads_File, Out_Dir, NT1_TT2, StartTime)
!--------------------
  Else
      Stop "Nothing done !!!"
!     WRITE(3,'(A,I3,A)') 'Chi co',K,' nhan to duoc giu lai. Khong thuc hien phep quay'
  EndIF

  END SUBROUTINE PTNT
!-----------------------------------------------------------------------
! Include "Sub_Factor.f90"
!==============================================================