PROGRAM g03aafe ! G03AAF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. 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 CHARACTER (1) :: matrix, std, weight ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: e(:,:), p(:,:), s(:), v(:,:), wk(:), & wt(:), x(:,:) INTEGER, ALLOCATABLE :: isx(:) ! .. Intrinsic Functions .. 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) 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) 99999 FORMAT (1X,F11.4,2F12.4,F10.4,F8.1,F8.4) END PROGRAM g03aafe