!   G13DJF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: iset = 1, nin = 5, nout = 6
    CONTAINS
!dec$ attributes offload : mic :: fprint
       SUBROUTINE fprint(k,nm,lmax,predz,sefz,ldsefz,nout)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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)
!dec$ attributes offload : mic :: fprint
       END SUBROUTINE fprint
    END MODULE g13djfe_mod
    PROGRAM g13djfe

!      G13DJF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : g13ddf, g13djf, g13dlf, nag_wp, x04abf
       USE g13djfe_mod, ONLY : fprint, iset, nin, nout
!      .. 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 Functions ..
       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 20
          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)

20     CONTINUE

    END PROGRAM g13djfe
