Program g13ajfe ! G13AJF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g13ajf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: c, rms Integer :: i, ifail, ifv, ist, iw, kfc, nfv, & npar, nst, nx, pp, qp ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: fsd(:), fva(:), par(:), st(:), w(:), & x(:) Integer :: isf(4), mr(7) ! .. Intrinsic Procedures .. Intrinsic :: max ! .. Executable Statements .. Write (nout,*) 'G13AJF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in problem size etc Read (nin,*) nx, nfv, kfc, c ! Read in the orders Read (nin,*) mr(1:7) ! Calculate NPAR and various array lengths npar = mr(1) + mr(3) + mr(4) + mr(6) ist = mr(4) + mr(7) + mr(2) + mr(5) + mr(3) + max(mr(1),mr(6)*mr(7)) ifv = max(1,nfv) qp = mr(6)*mr(7) + mr(3) pp = mr(4)*mr(7) + mr(1) iw = 6*nx + 5*npar + qp*(qp+11) + 3*pp + 7 Allocate (par(npar),x(nx),st(ist),fva(ifv),fsd(ifv),w(iw)) ! Read in data Read (nin,*) x(1:nx) ! Read in parameter estimates Read (nin,*) par(1:npar) ifail = 0 Call g13ajf(mr,par,npar,c,kfc,x,nx,rms,st,ist,nst,nfv,fva,fsd,ifv,isf,w, & iw,ifail) ! Display results Write (nout,99999) 'The residual mean square is ', rms Write (nout,*) Write (nout,99998) 'The state set consists of ', nst, ' values' Write (nout,99997) st(1:nst) Write (nout,*) Write (nout,99996) 'The ', nfv, & ' forecast values and standard errors are -' Write (nout,99995)(fva(i),fsd(i),i=1,nfv) 99999 Format (1X,A,F9.2) 99998 Format (1X,A,I1,A) 99997 Format (1X,4F11.4) 99996 Format (1X,A,I2,A) 99995 Format (10X,2F10.2) End Program g13ajfe