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

    MODULE g13aefe_mod

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

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
!dec$ attributes offload : mic :: piv
       SUBROUTINE piv(mr,par,npar,c,kfc,icount,s,g,h,ldh,igh,itc,zsp)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: c, s
          INTEGER, INTENT (IN)                :: igh, itc, kfc, ldh, npar
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: g(igh), h(ldh,igh),           &
                                                 par(npar), zsp(4)
          INTEGER, INTENT (IN)                :: icount(6), mr(7)
!         .. Executable Statements ..
          WRITE (nout,*)
          WRITE (nout,99999) 'Iteration', itc, '  residual sum of squares = ', &
             s
          RETURN

99999     FORMAT (1X,A,I3,A,E11.4)
!dec$ attributes offload : mic :: piv
       END SUBROUTINE piv
    END MODULE g13aefe_mod
    PROGRAM g13aefe

!      G13AEF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : g13aef, nag_wp, x04caf
       USE g13aefe_mod, ONLY : nin, nout, piv
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: c, s
       INTEGER                             :: iex, ifail, igh, ist, itc, iwa,  &
                                              kfc, kpiv, kzsp, ldh, ndf, nex,  &
                                              ngh, nit, npar, nst, nx
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: al(:), ex(:), exr(:), g(:),      &
                                              h(:,:), hc(:,:), par(:), sd(:),  &
                                              st(:), wa(:), x(:)
       REAL (KIND=nag_wp)                  :: zsp(4)
       INTEGER                             :: icount(6), isf(4), mr(7)
!      .. Intrinsic Functions ..
       INTRINSIC                              max
!      .. Executable Statements ..
       WRITE (nout,*) 'G13AEF Example Program Results'
       WRITE (nout,*)

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

!      Read in the problem size etc
       READ (nin,*) nx, kfc, c

!      Read in the orders
       READ (nin,*) mr(1:7)

!      Calculate NPAR and various array lengths
       npar = mr(1) + mr(3) + mr(4) + mr(6)
       iex = mr(3) + (mr(6)*mr(7)) + nx
       igh = mr(3) + (mr(6)*mr(7)) + npar + kfc
       ist = (mr(4)*mr(7)) + mr(2) + (mr(5)*mr(7)) + mr(3) + &
          max(mr(1),(mr(6)*mr(7)))
       iwa = ((nx+1+mr(1)+(mr(4)*mr(7))+mr(3)+(mr(6)*mr(7)))*8) + (9*npar)

       ldh = igh + 1
       ALLOCATE (x(nx),par(npar),ex(iex),exr(iex),al(iex),g(igh),sd(igh), &
          h(ldh,igh),st(ist),wa(iwa),hc(ldh,igh))

!      Read in data
       READ (nin,*) x(1:nx)

!      Read in initial values
       READ (nin,*) par(1:npar)

!      Read in control parameters
       READ (nin,*) kpiv, nit, kzsp
       IF (kzsp==1) THEN
          READ (nin,*) zsp(1:4)
       END IF

!      Fit ARIMA model
       ifail = -1
       CALL g13aef(mr,par,npar,c,kfc,x,nx,icount,ex,exr,al,iex,s,g,igh,sd,h, &
          ldh,st,ist,nst,piv,kpiv,nit,itc,zsp,kzsp,isf,wa,iwa,hc,ifail)
       IF (ifail/=0) THEN
          IF (ifail<7) THEN
             GO TO 20
          END IF
       END IF

!      Display results
       nex = icount(4)
       ndf = icount(5)
       ngh = icount(6)
       IF (ifail==0) THEN
          WRITE (nout,99998) 'Convergence was achieved after', itc, ' cycles'
       ELSE
          WRITE (nout,99998) 'Iterative process ran for', itc, ' cycles'
       END IF
       WRITE (nout,*)
       WRITE (nout,*) 'Final values of the PAR parameters and the &
          &constant are as follows'
       WRITE (nout,99997) par(1:npar), c
       WRITE (nout,*)
       WRITE (nout,99996) 'Residual sum of squares is', s, '  with', ndf, &
          ' degrees of freedom'
       WRITE (nout,*)
       WRITE (nout,*) 'The final values of ZSP were'
       WRITE (nout,99995) zsp(1:4)
       WRITE (nout,*)
       WRITE (nout,99999) 'The number of parameters estimated was', ngh
       WRITE (nout,*) '( backward forecasts, PAR and C, in that order )'
       WRITE (nout,*)
       WRITE (nout,*) 'The corresponding G array holds'
       WRITE (nout,99994) g(1:ngh)
       IF ((ifail==0 .OR. ifail==9) .AND. itc>0) THEN
          WRITE (nout,*)
          WRITE (nout,*) 'The corresponding SD array holds'
          WRITE (nout,99994) sd(1:ngh)
          WRITE (nout,*)
          FLUSH (nout)
          ifail = 0
          CALL x04caf('General',' ',ngh,ngh,h,ldh,'Corresponding H matrix', &
             ifail)
          WRITE (nout,*) 'Holds second derivatives in the upper &
             &half (including the main diagonal)'
          WRITE (nout,*) 'and correlation coefficients in the lower triangle'
       END IF
       WRITE (nout,*)
       WRITE (nout,99993) 'EX, EXR, and AL each hold', nex, &
          ' values made up of', icount(1), ' back forecast(s),'
       WRITE (nout,99992) icount(2), ' differenced values, and'
       WRITE (nout,99992) icount(3), &
          ' element(s) of reconstituted information'
       WRITE (nout,*)
       WRITE (nout,*) '  EX'
       WRITE (nout,99991) ex(1:nex)
       IF (ifail==0 .OR. ifail==9) THEN
          WRITE (nout,*)
          WRITE (nout,*) '  EXR'
          WRITE (nout,99991) exr(1:nex)
       END IF
       IF (ifail==0) THEN
          WRITE (nout,*)
          WRITE (nout,*) '  AL'
          WRITE (nout,99991) al(1:nex)
       END IF
       IF (ifail==0 .OR. ifail==9) THEN
          WRITE (nout,*)
          WRITE (nout,99998) 'The state set consists of', nst, ' values'
          WRITE (nout,99991) st(1:nst)
       END IF

20     CONTINUE

99999  FORMAT (1X,A,I5)
99998  FORMAT (1X,A,I3,A)
99997  FORMAT (1X,4F10.4)
99996  FORMAT (1X,A,F10.3,A,I4,A)
99995  FORMAT (1X,4E15.4)
99994  FORMAT (1X,10F9.4)
99993  FORMAT (1X,A,I5,A,I5,A)
99992  FORMAT (1X,I5,A)
99991  FORMAT (1X,5F11.4)
    END PROGRAM g13aefe
