PROGRAM g02cffe ! G02CFF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g02cff, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: i, ifail, ldr, ldssp, n CHARACTER (80) :: fmt ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: r(:,:), ssp(:,:), std(:), xbar(:) INTEGER, ALLOCATABLE :: korder(:), kwork(:) ! .. Executable Statements .. WRITE (nout,*) 'G02CFF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in the problem size READ (nin,*) n ldr = n ldssp = n ALLOCATE (r(ldr,n),ssp(ldssp,n),std(n),xbar(n),korder(n),kwork(n)) ! Read in data READ (nin,*) xbar(1:n) READ (nin,*) std(1:n) READ (nin,*) (ssp(i,1:n),i=1,n) READ (nin,*) (r(i,1:n),i=1,n) ! Read in the reordering vector READ (nin,*) korder(1:n) ! Format for displaying vectors WRITE (fmt,99999) '(1x,A,', n, '(1X,F10.4))' ! Display data WRITE (nout,fmt) 'Original vector XBAR : ', xbar(1:n) WRITE (nout,*) WRITE (nout,fmt) 'Original vector STD : ', std(1:n) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',n,n,ssp,ldssp,'Original matrix SSP :',ifail) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',n,n,r,ldr,'Original matrix R :',ifail) WRITE (nout,*) ! Reorder the results ifail = 0 CALL g02cff(n,korder,xbar,std,ssp,ldssp,r,ldr,kwork,ifail) ! Display results WRITE (nout,fmt) 'New vector XBAR : ', xbar(1:n) WRITE (nout,*) WRITE (nout,fmt) 'New vector STD : ', std(1:n) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',n,n,ssp,ldssp,'New matrix SSP :',ifail) WRITE (nout,*) FLUSH (nout) ifail = 0 CALL x04caf('General',' ',n,n,r,ldr,'New matrix R :',ifail) 99999 FORMAT (A,I0,A) END PROGRAM g02cffe