Program g02cefe ! G02CEF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02cef, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Integer :: i, ifail, ldr, ldr2, ldssp, ldssp2, & m, n Character (80) :: fmt ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: r(:,:), r2(:,:), ssp(:,:), & ssp2(:,:), std(:), std2(:), xbar(:), & xbar2(:) Integer, Allocatable :: korder(:) ! .. Executable Statements .. Write (nout,*) 'G02CEF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, m ldr = n ldr2 = m ldssp = n ldssp2 = m Allocate (r(ldr,n),r2(ldr2,m),ssp(ldssp,n),ssp2(ldssp2,m),std(n), & std2(m),xbar(n),xbar2(m),korder(m)) ! Read in the 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:m) ! 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,*) ! Calculate summaries on reduced number of variables ifail = 0 Call g02cef(n,xbar,std,ssp,ldssp,r,ldr,m,korder,xbar2,std2,ssp2,ldssp2, & r2,ldr2,ifail) ! Display results Write (nout,fmt) 'New vector XBAR2 : ', xbar2(1:m) Write (nout,*) Write (nout,fmt) 'New vector STD2 : ', std2(1:m) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',m,m,ssp2,ldssp2,'New matrix SSP2 :',ifail) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',m,m,r2,ldr2,'New matrix R2 :',ifail) 99999 Format (A,I0,A) End Program g02cefe