PROGRAM g13affe ! G13AFF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. 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 20 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 20 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