NAG Library Manual, Mark 30.2
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program g13mffe
!     G13MFF Example Program Text

!     Mark 30.2 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