Program g13affe ! G13AFF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g13aff, nag_wp, x04abf, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: c, s Integer :: ifail, ipd, iqd, ires, itc, kfc, & kpiv, ldcm, nadv, ndf, nit, npar, & nppc, nres, nst, nx ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: cm(:,:), par(:), res(:), sd(:), & st(:), x(:) Integer :: isf(4), mr(7) ! .. Executable Statements .. Write (nout,*) 'G13AFF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size etc Read (nin,*) nx, 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) nppc = npar + kfc iqd = mr(6)*mr(7) + mr(3) ipd = mr(4)*mr(7) + mr(1) ires = 15*iqd + 11*nx + 13*nppc + 8*ipd + 12 + 2*(iqd+nppc)**2 ldcm = nppc Allocate (x(nx),par(npar),sd(nppc),cm(ldcm,nppc),st(nx),res(ires)) ! Read in data Read (nin,*) x(1:nx) ! Read in initial values Read (nin,*) par(1:npar) ! Read in control parameters Read (nin,*) kpiv, nit ! Set the advisory channel to NOUT for monitoring information If (kpiv/=0) Then nadv = nout Call x04abf(1,nadv) End If ! Fit ARIMA model ifail = -1 Call g13aff(mr,par,npar,c,kfc,x,nx,s,ndf,sd,nppc,cm,ldcm,st,nst,kpiv, & nit,itc,isf,res,ires,nres,ifail) If (ifail/=0) Then If (ifail<7) Then Go To 100 End If End If ! Display results If (ifail==0) Then Write (nout,99999) 'Convergence was achieved after', itc, ' cycles' Else Write (nout,99999) 'Iterative process ran for', itc, ' cycles' End If Write (nout,*) Write (nout,*) & 'Final values of the PAR parameters and the constant are as follows' Write (nout,99996) par(1:npar), c Write (nout,*) Write (nout,99995) 'Residual sum of squares is', s, ' with', ndf, & ' degrees of freedom' If ((ifail==0 .Or. ifail==9) .And. itc>0) Then Write (nout,*) Write (nout,*) 'The corresponding SD array holds' Write (nout,99994) sd(1:nppc) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',nppc,nppc,cm,ldcm, & 'The correlation matrix is as follows',ifail) End If If (ifail==0 .Or. ifail==9) Then Write (nout,*) Write (nout,99999) 'The residuals consist of', nres, ' values' Write (nout,99998) res(1:nres) Write (nout,*) Write (nout,99997) 'The state set consists of', nst, ' values' Write (nout,99993) st(1:nst) End If 100 Continue 99999 Format (1X,A,I4,A) 99998 Format (1X,5F10.4) 99997 Format (1X,A,I3,A) 99996 Format (1X,4F10.4) 99995 Format (1X,A,F10.3,A,I4,A) 99994 Format (1X,10F9.4) 99993 Format (1X,6F11.3) End Program g13affe