Program g13mffe
! G13MFF Example Program Text
! Mark 30.3 Release. nAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: g13mff, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: p, tau
Integer :: ftype, i, ierr, ifail, ldiema, &
lrcomm, m1, m2, miema, nb, pn, &
sdiema, sorder
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: iema(:,:), rcomm(:), sinit(:), t(:), &
x(:), z(:)
Integer :: inter(2)
! .. Intrinsic Procedures ..
Intrinsic :: repeat
! .. Executable Statements ..
Write (nout,*) 'G13MFF Example Program Results'
Write (nout,*)
! Skip heading in data file
Read (nin,*)
! Read in the required order for the output matrix
Read (nin,*) sorder
! Read in the problem size
Read (nin,*) m1, m2
! Read in the transformation function, its parameter, the interpolation
! method to use and the decay parameter tau
Read (nin,*) ftype, p, inter(1:2), tau
! Read in the initial values
Allocate (sinit(m2+2))
Read (nin,*) sinit(1:m2+2)
miema = m2 - m1 + 1
! Print some titles
Write (nout,99997) repeat(' ',5*miema), 'Iteration'
Write (nout,99996) 'Time', (i,i=m1,m2)
Write (nout,99998) repeat('-',22+10*miema)
lrcomm = m2 + 20
Allocate (rcomm(lrcomm))
! Loop over each block of data
pn = 0
Do
! Read in the number of observations in this block
Read (nin,*,Iostat=ierr) nb
If (ierr/=0) Then
Exit
End If
! Allocate Z and T to the required size
Allocate (z(nb),t(nb))
! Read in the data for this block
If (ftype/=3) Then
Allocate (x(0))
Do i = 1, nb
Read (nin,*) t(i), z(i)
End Do
Else
Allocate (x(nb))
Do i = 1, nb
Read (nin,*) t(i), z(i), x(i)
End Do
End If
If (sorder==1) Then
ldiema = nb
sdiema = miema
Else
ldiema = miema
sdiema = nb
End If
Allocate (iema(ldiema,sdiema))
! Update the iterated EMA for this block of data
ifail = 0
Call g13mff(sorder,nb,z,iema,ldiema,t,tau,m1,m2,sinit,inter,ftype,p,x, &
pn,rcomm,lrcomm,ifail)
! Display the results for this block of data
If (sorder==1) Then
! IEMA(NB,M2-M1+1)
Do i = 1, nb
Write (nout,99999) pn - nb + i, t(i), iema(i,1:miema)
End Do
Else
! IEMA(NB,M2-M1+1)
Do i = 1, nb
Write (nout,99999) pn - nb + i, t(i), iema(1:miema,i)
End Do
End If
Write (nout,*)
Deallocate (z,t,x,iema)
End Do
99999 Format (1X,I3,4X,F10.1,4X,20(2X,F8.3))
99998 Format (1X,A)
99997 Format (20X,A,A)
99996 Format (14X,A,10X,20(I2,8X))
End Program g13mffe