PROGRAM g03fafe ! G03FAF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g01agf, g03faf, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: ifail, ld, ldx, liwk, lwk, n, ndim CHARACTER (1) :: roots ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: d(:), eval(:), wk(:), x(:,:) INTEGER, ALLOCATABLE :: iwk(:) ! .. Executable Statements .. WRITE (nout,*) 'G03FAF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in the problem size READ (nin,*) n, ndim, roots ld = n*(n-1)/2 ldx = n lwk = n*(n+17)/2 - 1 liwk = 5*n ALLOCATE (d(ld),x(ldx,ndim),eval(n),wk(lwk),iwk(liwk)) ! Read in the lower triangular part of the distance matrix READ (nin,*) d(1:ld) ! Perform principal co-ordinate analysis ifail = 0 CALL g03faf(roots,n,d,ndim,x,ldx,eval,wk,iwk,ifail) ! Display results WRITE (nout,*) ' Scaled Eigenvalues' WRITE (nout,*) IF (roots=='L' .OR. roots=='l') THEN WRITE (nout,99999) eval(1:ndim) ELSE WRITE (nout,99999) eval(1:n) END IF WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',n,ndim,x,ldx,'Co-ordinates',ifail) WRITE (nout,*) WRITE (nout,*) ' Plot of first two dimensions' WRITE (nout,*) FLUSH (nout) ifail = 0 CALL g01agf(x,x(1,2),n,iwk,50,18,ifail) 99999 FORMAT (8F10.4) END PROGRAM g03fafe