PROGRAM g13amfe ! G13AMF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g13amf, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. REAL (KIND=nag_wp) :: ad, dv INTEGER :: i, ifail, itype, ival, k, mode, n, & nf, p ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: fse(:), fv(:), init(:), param(:), & r(:), res(:), y(:), yhat(:) ! .. Executable Statements .. WRITE (nout,*) 'G13AMF Example Program Results' WRITE (nout,*) ! Skip headings in data file READ (nin,*) ! Read in the initial arguments and check array sizes READ (nin,*) mode, itype, n, nf ALLOCATE (y(n),fv(nf),fse(nf),yhat(n),res(n)) ! Read in data READ (nin,*) y(1:n) ! Read in the ITYPE dependent arguments (skipping headings) SELECT CASE (itype) CASE (1) ! Single exponential smoothing ALLOCATE (param(1)) READ (nin,*) param(1) p = 0 ival = 1 CASE (2) ! Brown double exponential smoothing ALLOCATE (param(2)) READ (nin,*) param(1), param(2) p = 0 ival = 2 CASE (3) ! Linear holt smoothing ALLOCATE (param(3)) READ (nin,*) param(1), param(2), param(3) p = 0 ival = 2 CASE DEFAULT ! Additive or multiplicative Holt-Winter smoothing ALLOCATE (param(4)) READ (nin,*) param(1), param(2), param(3), param(4), p ival = p + 2 END SELECT ALLOCATE (init(ival),r(p+13)) ! Read in the MODE dependent arguments (skipping headings) SELECT CASE (mode) CASE (0) ! User supplied initial values READ (nin,*) init(1:ival) CASE (1) ! Continuing from a previously saved R READ (nin,*) r(1:(p+13)) CASE (2) ! Initial values calculated from first K observations READ (nin,*) k END SELECT ! Call the library routine ifail = 0 CALL g13amf(mode,itype,p,param,n,y,k,init,nf,fv,fse,yhat,res,dv,ad,r, & ifail) ! Display output WRITE (nout,*) 'Initial values used:' WRITE (nout,99997) (i,init(i),i=1,ival) WRITE (nout,*) WRITE (nout,99999) 'Mean Deviation = ', dv WRITE (nout,99999) 'Absolute Deviation = ', ad WRITE (nout,*) WRITE (nout,*) ' Observed 1-Step' WRITE (nout,*) ' Period Values Forecast Residual' WRITE (nout,*) WRITE (nout,99998) (i,y(i),yhat(i),res(i),i=1,n) WRITE (nout,*) WRITE (nout,*) ' Forecast Standard' WRITE (nout,*) ' Period Values Errors' WRITE (nout,*) WRITE (nout,99996) (n+i,fv(i),fse(i),i=1,nf) 99999 FORMAT (A,E12.4) 99998 FORMAT (I4,1X,F12.3,1X,F12.3,1X,F12.3) 99997 FORMAT (I4,1X,F12.3) 99996 FORMAT (I4,1X,F12.3,1X,F12.3) END PROGRAM g13amfe