Program g03aafe

!     G03AAF Example Program Text

!     Mark 30.2 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g03aaf, nag_wp, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Integer                          :: i, ifail, lde, ldp, ldv, ldx, lwt,   &
                                          m, n, nvar
      Logical                          :: verbose
      Character (1)                    :: matrix, std, weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: e(:,:), p(:,:), s(:), v(:,:), wk(:), &
                                          wt(:), x(:,:)
      Integer, Allocatable             :: isx(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: count
!     .. Executable Statements ..
      Write (nout,*) 'G03AAF Example Program Results'
      Write (nout,*)

!     Skip heading in data file
      Read (nin,*)

!     Read in the problem size
      Read (nin,*) matrix, std, weight, n, m

      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      ldx = n
      Allocate (x(ldx,m),wt(lwt),isx(m),s(m))

!     Read in data
      If (lwt>0) Then
        Read (nin,*)(x(i,1:m),wt(i),i=1,n)
      Else
        Read (nin,*)(x(i,1:m),i=1,n)
      End If

!     Read in variable inclusion flags
      Read (nin,*) isx(1:m)

!     Read in standardizations
      If (matrix=='S' .Or. matrix=='s') Then
        Read (nin,*) s(1:m)
      End If

!     Calculate NVAR
      nvar = count(isx(1:m)==1)

      lde = nvar
      ldp = nvar
      ldv = n
      Allocate (e(lde,6),p(ldp,nvar),v(ldv,nvar),wk(1))

!     Perform PCA
      ifail = 0
      Call g03aaf(matrix,std,weight,n,m,x,ldx,isx,s,wt,nvar,e,lde,p,ldp,v,ldv, &
        wk,ifail)

!     Display results
      Write (nout,*)                                                           &
        'Eigenvalues  Percentage  Cumulative     Chisq      DF     Sig'
      Write (nout,*) '              variation   variation'
      Write (nout,*)
      Write (nout,99999)(e(i,1:6),i=1,nvar)

!     Set verbose to .True. to see principal component loadings and scores
      verbose = .False.
      If (verbose) Then
        Write (nout,*)
        Flush (nout)
        ifail = 0
        Call x04caf('General',' ',nvar,nvar,p,ldp,                             &
          'Principal component loadings',ifail)
        Write (nout,*)
        Flush (nout)
        ifail = 0
        Call x04caf('General',' ',n,nvar,v,ldv,'Principal component scores',   &
          ifail)
      End If

99999 Format (1X,F11.4,2F12.4,F10.4,F8.1,F8.4)
    End Program g03aafe