Program g02ldfe ! G02LDF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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 Procedures .. 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