Program g02lcfe ! G02LCF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g02lcf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: rcond Integer :: i, ifail, ip, iscale, ldb, ldc, & ldob, ldp, ldvip, ldw, ldycv, & maxfac, my, nfact, orig, vipopt ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: b(:,:), c(:,:), ob(:,:), p(:,:), & vip(:,:), w(:,:), xbar(:), xstd(:), & ybar(:), ycv(:,:), ystd(:) ! .. Executable Statements .. Write (nout,*) 'G02LCF Example Program Results' Write (nout,*) Flush (nout) ! Skip headeing in data file Read (nin,*) ! Read problem size Read (nin,*) ip, my, maxfac, nfact, orig, iscale, vipopt ldp = ip ldc = my ldw = ip ldb = ip If (orig==1) Then ldob = ip + 1 Else ldob = 1 End If If (vipopt/=0) Then ldycv = nfact ldvip = ip Else ldycv = 0 ldvip = 0 End If Allocate (p(ldp,maxfac),c(ldc,maxfac),w(ldw,maxfac),b(ldb,my),xbar(ip), & ybar(my),xstd(ip),ystd(my),ob(ldob,my),ycv(ldycv,my), & vip(ldvip,vipopt)) ! Read in data Read (nin,*)(p(i,1:maxfac),i=1,ip) Read (nin,*)(c(i,1:maxfac),i=1,my) Read (nin,*)(w(i,1:maxfac),i=1,ip) If (vipopt/=0) Then Read (nin,*)(ycv(i,1:my),i=1,nfact) End If ! Read means and scalings If (orig==1) Then Read (nin,*) xbar(1:ip) Read (nin,*) ybar(1:my) If (iscale/=-1) Then Read (nin,*) xstd(1:ip) Read (nin,*) ystd(1:my) End If End If ! Calculate predictions rcond = -1.0E0_nag_wp ifail = 0 Call g02lcf(ip,my,maxfac,nfact,p,ldp,c,ldc,w,ldw,rcond,b,ldb,orig,xbar, & ybar,iscale,xstd,ystd,ob,ldob,vipopt,ycv,ldycv,vip,ldvip,ifail) ! Display results ifail = 0 Call x04caf('General',' ',ip,my,b,ldb,'B',ifail) If (orig==1) Then Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',ip+1,my,ob,ldob,'OB',ifail) End If If (vipopt/=0) Then Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',ip,vipopt,vip,ldvip,'VIP',ifail) End If End Program g02lcfe