PROGRAM g02ldfe ! G02LDF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g02ldf, nag_wp, x04caf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: i, ifail, ip, iscale, ldb, ldyhat, & ldz, my, mz, n, orig ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: b(:,:), xbar(:), xstd(:), ybar(:), & yhat(:,:), ystd(:), z(:,:) INTEGER, ALLOCATABLE :: isz(:) ! .. Intrinsic Functions .. INTRINSIC sum ! .. Executable Statements .. WRITE (nout,*) 'G02LDF Example Program Results' WRITE (nout,*) FLUSH (nout) ! Skip heading in data file READ (nin,*) ! Read in problem size READ (nin,*) my, orig, iscale, n, mz ldyhat = n ldz = n ALLOCATE (ybar(my),ystd(my),isz(mz),z(ldz,mz),yhat(ldyhat,my)) ! Read prediction x-data READ (nin,*) (z(i,1:mz),i=1,n) ! Read in elements of ISZ READ (nin,*) isz(1:mz) ! Calculate IP ip = sum(isz(1:mz)) ldb = ip IF (orig==1) THEN ldb = ldb + 1 END IF ALLOCATE (xbar(ip),xstd(ip),b(ldb,my)) ! Read parameter estimates READ (nin,*) (b(i,1:my),i=1,ldb) ! Read means IF (orig==-1) THEN READ (nin,*) xbar(1:ip) READ (nin,*) ybar(1:my) IF (iscale/=-1) THEN ! Read scalings READ (nin,*) xstd(1:ip) READ (nin,*) ystd(1:my) END IF END IF ! Calculate predictions ifail = 0 CALL g02ldf(ip,my,orig,xbar,ybar,iscale,xstd,ystd,b,ldb,n,mz,isz,z,ldz, & yhat,ldyhat,ifail) ! Display results ifail = 0 CALL x04caf('General',' ',n,my,yhat,ldyhat,'YHAT',ifail) END PROGRAM g02ldfe