Program g03aafe
! G03AAF Example Program Text
! Mark 30.1 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