!   G13DJF Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

    Module g13djfe_mod

!     G13DJF Example Program Module:
!            Parameters and User-defined Routines

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: fprint
!     .. Parameters ..
      Integer, Parameter, Public       :: iset = 1, nin = 5, nout = 6
    Contains
      Subroutine fprint(k,nm,lmax,predz,sefz,ldsefz,nout)

!       .. Scalar Arguments ..
        Integer, Intent (In)           :: k, ldsefz, lmax, nm, nout
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In) :: predz(ldsefz,lmax),                 &
                                          sefz(ldsefz,lmax)
!       .. Local Scalars ..
        Integer                        :: i, i2, j, l, l2, loop
!       .. Intrinsic Procedures ..
        Intrinsic                      :: min, mod
!       .. Executable Statements ..
        Write (nout,*) ' FORECAST SUMMARY TABLE'
        Write (nout,*) ' ----------------------'
        Write (nout,*)
        Write (nout,99999) ' Forecast origin is set at t = ', nm
        Write (nout,*)
        loop = lmax/5
        If (mod(lmax,5)/=0) Then
          loop = loop + 1
        End If

        Do j = 1, loop
          i2 = (j-1)*5
          l2 = min(i2+5,lmax)
          Write (nout,99998) 'Lead Time ', (i,i=i2+1,l2)
          Write (nout,*)
          i = 1
          Write (nout,99997) 'Series ', i, ' : Forecast    ',                  &
            (predz(1,l),l=i2+1,l2)
          Write (nout,99996) ' : Standard Error ', (sefz(1,l),l=i2+1,l2)
          Do i = 2, k
            Write (nout,99997) 'Series ', i, ' : Forecast    ',                &
              (predz(i,l),l=i2+1,l2)
            Write (nout,99996) ' : Standard Error ', (sefz(i,l),l=i2+1,l2)
          End Do
          Write (nout,*)
        End Do
        Return

99999   Format (1X,A,I4)
99998   Format (1X,A,12X,5I10)
99997   Format (1X,A,I2,A,5F10.2)
99996   Format (10X,A,4(F7.2,3X),F7.2)
      End Subroutine fprint
    End Module g13djfe_mod
    Program g13djfe

!     G13DJF Example Main Program

!     .. Use Statements ..
      Use g13djfe_mod, Only: fprint, iset, nin, nout
      Use nag_library, Only: g13ddf, g13djf, g13dlf, nag_wp, x04abf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: cgetol, rlogl
      Integer                          :: d, i, ifail, ip, iprint, iq, ishow,  &
                                          k, kmax, ldcm, liwork, lmax, lpar,   &
                                          lref, lwork, maxcal, n, nadv, nd,    &
                                          niter, r, tddelta
      Logical                          :: exact, meanl
      Character (1)                    :: mean
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: cm(:,:), delta(:,:), g(:), par(:),   &
                                          predz(:,:), qq(:,:), ref(:),         &
                                          sefz(:,:), v(:,:), w(:,:), work(:),  &
                                          workl(:), z(:,:)
      Integer, Allocatable             :: id(:), iwork(:)
      Logical, Allocatable             :: parhld(:)
      Character (1), Allocatable       :: tr(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: max, maxval
!     .. Executable Statements ..
      Write (nout,*) 'G13DJF Example Program Results'
      Write (nout,*)

!     Skip heading in data file
      Read (nin,*)

!     Read in the problem size
      Read (nin,*) k, n

      Allocate (tr(k),id(k))

!     Read in differencing
      Read (nin,*) id(1:k)

      d = maxval(id(1:k))
      tddelta = max(d,1)
      nd = n - d
      kmax = k
      Allocate (delta(kmax,tddelta),w(kmax,nd),workl(k*n),z(kmax,n))

!     Read in series and the transformation flag
      Read (nin,*)(z(i,1:n),i=1,k)
      Read (nin,*) tr(1:k)

!     If required, read in delta
      If (d>0) Then
        Read (nin,*)(delta(i,1:id(i)),i=1,k)
      End If

!     Difference and / or transform series
      ifail = 0
      Call g13dlf(k,n,z,kmax,tr,id,delta,w,nd,workl,ifail)

!     Read in information on the VARMA
      Read (nin,*) ip, iq, mean, lmax

!     Calculate number of parameters for the VARMA
      lpar = (ip+iq)*k*k
      meanl = .False.
      If (mean=='M' .Or. mean=='m') Then
        lpar = lpar + k
        meanl = .True.
      End If

!     Read in control parameters
      Read (nin,*) iprint, cgetol, maxcal, ishow

!     Read in exact likelihood flag
      Read (nin,*) exact

      ldcm = lpar
      kmax = k
      Allocate (par(lpar),qq(kmax,k),v(kmax,nd),g(lpar),cm(ldcm,lpar),         &
        parhld(lpar))

!     Read in initial parameter estimates and free parameter flags
      Read (nin,*) par(1:lpar)
      Read (nin,*) parhld(1:lpar)

!     Read in initial values for covariance matrix Q
      Read (nin,*)(qq(i,1:i),i=1,k)

!     Set the advisory channel to NOUT for monitoring information
      If (iprint>=0 .Or. ishow/=0) Then
        nadv = nout
        Call x04abf(iset,nadv)
      End If

!     Fit a VARMA model
      ifail = -1
      Call g13ddf(k,nd,ip,iq,meanl,par,lpar,qq,kmax,w,parhld,exact,iprint,     &
        cgetol,maxcal,ishow,niter,rlogl,v,g,cm,ldcm,ifail)
      If (ifail/=0) Then
        If (ifail<4) Then
          Go To 100
        End If
      End If

      lref = (lmax-1)*k*k + 2*k*lmax + k
      r = max(ip,iq)
      lwork = max(k*r*(k*r+2),(ip+d+2)*k**2+(n+lmax)*k)
      liwork = k*max(ip,iq)
      Allocate (predz(kmax,lmax),sefz(kmax,lmax),ref(lref),work(lwork),        &
        iwork(liwork))

!     Perform forecast
      ifail = 0
      Call g13djf(k,n,z,kmax,tr,id,delta,ip,iq,mean,par,lpar,qq,v,lmax,predz,  &
        sefz,ref,lref,work,lwork,iwork,liwork,ifail)

!     Display results
      Call fprint(k,n,lmax,predz,sefz,kmax,nout)

100   Continue

    End Program g13djfe