Program g02lbfe ! G02LBF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02lbf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: tau Integer :: i, ifail, ip, iscale, ldc, ldp, ldt, & ldu, ldw, ldx, ldxres, ldy, ldycv, & ldyres, maxfac, maxit, mx, my, n Character (80) :: fmt ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:,:), p(:,:), t(:,:), u(:,:), & w(:,:), x(:,:), xbar(:), xcv(:), & xres(:,:), xstd(:), y(:,:), ybar(:), & ycv(:,:), yres(:,:), ystd(:) Integer, Allocatable :: isx(:) ! .. Intrinsic Procedures .. Intrinsic :: count ! .. Executable Statements .. Write (nout,*) 'G02LBF Example Program Results' Write (nout,*) Flush (nout) ! Skip headeing in data file Read (nin,*) ! Read in the problem size Read (nin,*) n, mx, my, iscale, maxfac ldx = n ldy = n Allocate (x(ldx,mx),isx(mx),y(ldy,my)) ! Read in data Read (nin,*)(x(i,1:mx),y(i,1:my),i=1,n) ! Read in variable inclusion flags Read (nin,*) isx(1:mx) ! Calculate IP ip = count(isx(1:mx)==1) ldxres = n ldyres = n ldt = n ldc = my ldu = n ldycv = maxfac ldw = ip ldp = ip Allocate (xbar(ip),ybar(my),xstd(ip),ystd(my),xres(ldxres,ip), & yres(ldyres,ip),w(ldw,maxfac),p(ldp,maxfac),t(ldt,maxfac), & c(ldc,maxfac),u(ldu,maxfac),xcv(maxfac),ycv(ldycv,my)) ! Use suggested values for control parameters maxit = 200 tau = 1.0E-4_nag_wp ! Fit a PLS model ifail = 0 Call g02lbf(n,mx,x,ldx,isx,ip,my,y,ldy,xbar,ybar,iscale,xstd,ystd, & maxfac,maxit,tau,xres,ldxres,yres,ldyres,w,ldw,p,ldp,t,ldt,c,ldc,u, & ldu,xcv,ycv,ldycv,ifail) ! Display results ifail = 0 Call x04caf('General',' ',ip,maxfac,p,ldp,'x-loadings, P',ifail) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',n,maxfac,t,ldt,'x-scores, T',ifail) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',my,maxfac,c,ldc,'y-loadings, C',ifail) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',n,maxfac,u,ldu,'y-scores, U',ifail) Write (nout,*) Write (nout,*) 'Explained Variance' Write (nout,*) ' Model effects Dependent variable(s)' Write (fmt,99999) '(', my + 1, '(F12.6,3X))' Write (nout,fmt)(xcv(i),ycv(i,1:my),i=1,maxfac) 99999 Format (A,I0,A) End Program g02lbfe