Program g13amfe
! G13AMF Example Program Text
! Mark 27.1 Release. NAG Copyright 2020.
! .. 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