*     G13FGF Example Program Text
*     Mark 20 Release. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          NOUT
      PARAMETER        (NOUT=6)
      INTEGER          NPARMX, NUM
      DOUBLE PRECISION ZERO
      PARAMETER        (NPARMX=10,NUM=1500,ZERO=0.0D0)
      INTEGER          NUM1, NREGMX
      PARAMETER        (NUM1=3000,NREGMX=10)
*     .. Local Scalars ..
      DOUBLE PRECISION DF, FAC1, HP, LGF, MEAN, TOL, XTERM
      INTEGER          I, IFLAG, IGEN, IP, IQ, K, LDX, LWK, MAXIT, MN,
     +                 NPAR, NPAR2, NREG, NT
      LOGICAL          COPT, FCALL
      CHARACTER        DIST
*     .. Local Arrays ..
      DOUBLE PRECISION BX(10), COVAR(NPARMX,NPARMX), CVAR(100),
     +                 ETM(NUM1), HT(NUM1+10), HTM(NUM1), PARAM(NPARMX),
     +                 RVEC(40), RWSAV(9), SC(NPARMX), SE(NPARMX),
     +                 THETA(NPARMX), WK(NUM1*3+NPARMX+NREGMX*NUM1+20*
     +                 20+1), X(NUM1,10), YT(NUM1+10)
      INTEGER          ISEED(4)
*     .. External Subroutines ..
      EXTERNAL         G05HNF, G05KBF, G13FGF, G13FHF
*     .. Intrinsic Functions ..

      INTRINSIC        DBLE, SIN
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G13FGF Example Program Results'

      ISEED(1) = 111
      IGEN = 0

      LDX = NUM1
      BX(1) = 1.5D0
      BX(2) = 2.5D0
      BX(3) = 3.0D0
      MEAN = 3.0D0

      DO 20 I = 1, NUM
         FAC1 = DBLE(I)*0.01D0
         X(I,1) = 0.01D0 + 0.7D0*SIN(FAC1)
         X(I,2) = 0.5D0 + FAC1*0.1D0
         X(I,3) = 1.0D0
   20 CONTINUE

      NREG = 2
      MN = 1
      IP = 1
      IQ = 1
      NPAR = IP + 2*IQ + 1

      PARAM(1) = 0.1D0
      PARAM(2) = -0.3D0
      PARAM(3) = 0.1D0
      PARAM(4) = 0.9D0

      DF = 5.0D0
      DIST = 'N'

      FCALL = .TRUE.
      CALL G05KBF(IGEN,ISEED)
      CALL G05HNF(DIST,800,IP,IQ,PARAM,DF,HT,YT,FCALL,RVEC,IGEN,ISEED,
     +            RWSAV,IFLAG)
      FCALL = .FALSE.
      CALL G05HNF(DIST,NUM,IP,IQ,PARAM,DF,HT,YT,FCALL,RVEC,IGEN,ISEED,
     +            RWSAV,IFLAG)

      IFLAG = -1
      DO 60 I = 1, NUM
         XTERM = ZERO
         DO 40 K = 1, NREG
            XTERM = XTERM + X(I,K)*BX(K)
   40    CONTINUE
         IF (MN.EQ.1) THEN
            YT(I) = MEAN + XTERM + YT(I)
         ELSE
            YT(I) = XTERM + YT(I)
         END IF
   60 CONTINUE

      COPT = .TRUE.

      MAXIT = 50
      TOL = 1.0D-5

      DO 80 I = 1, NPAR
         THETA(I) = PARAM(I)*0.5D0
   80 CONTINUE

      IF (MN.EQ.1) THEN
         THETA(NPAR+MN) = MEAN*0.5D0
      END IF

      DO 100 I = 1, NREG
         THETA(NPAR+MN+I) = BX(I)*0.5D0
  100 CONTINUE

      LWK = NREG*NUM + 3*NUM + 3
      NPAR2 = 1 + IQ*2 + IP + MN + NREG

      CALL G13FGF(DIST,YT,X,LDX,NUM,IP,IQ,NREG,MN,NPAR2,THETA,SE,SC,
     +            COVAR,NPARMX,HP,ETM,HTM,LGF,COPT,MAXIT,TOL,WK,LWK,
     +            IFLAG)

      WRITE (NOUT,*)
      WRITE (NOUT,*) 'Normal distribution'
      WRITE (NOUT,*)
      WRITE (NOUT,*) '          Parameter       Standard        Correct'
      WRITE (NOUT,*) '          estimates       errors          values'

      DO 120 I = 1, NPAR
         WRITE (NOUT,99999) THETA(I), SE(I), PARAM(I)
  120 CONTINUE

      IF (MN.EQ.1) THEN
         WRITE (NOUT,99999) THETA(NPAR+1), SE(NPAR+1), MEAN
      END IF

      DO 140 I = 1, NREG
         WRITE (NOUT,99999) THETA(NPAR+MN+I), SE(NPAR+MN+I), BX(I)
  140 CONTINUE

      NT = 4
      CALL G13FHF(NUM,NT,IP,IQ,THETA,CVAR,HTM,ETM,IFLAG)

      WRITE (NOUT,*)
      WRITE (NOUT,99998) 'Volatility forecast = ', CVAR(NT)
      WRITE (NOUT,*)

      NREG = 2
      MN = 1
      IP = 1
      IQ = 2
      NPAR = IP + 2*IQ + 1

      PARAM(1) = 0.1D0
      PARAM(2) = -0.3D0
      PARAM(3) = -0.1D0
      PARAM(4) = 0.1D0
      PARAM(5) = 0.3D0
      PARAM(6) = 0.7D0

      DIST = 'T'

      FCALL = .TRUE.
      ISEED(1) = 111
      CALL G05KBF(IGEN,ISEED)
      CALL G05HNF(DIST,NUM,IP,IQ,PARAM,DF,HT,YT,FCALL,RVEC,IGEN,ISEED,
     +            RWSAV,IFLAG)
      FCALL = .FALSE.
      CALL G05HNF(DIST,NUM,IP,IQ,PARAM,DF,HT,YT,FCALL,RVEC,IGEN,ISEED,
     +            RWSAV,IFLAG)

      IFLAG = -1
      DO 180 I = 1, NUM
         XTERM = ZERO
         DO 160 K = 1, NREG
            XTERM = XTERM + X(I,K)*BX(K)
  160    CONTINUE
         IF (MN.EQ.1) THEN
            YT(I) = MEAN + XTERM + YT(I)
         ELSE
            YT(I) = XTERM + YT(I)
         END IF
  180 CONTINUE

      COPT = .TRUE.
      MAXIT = 50
      TOL = 1.0D-5

      DO 200 I = 1, NPAR
         THETA(I) = PARAM(I)*0.5D0
  200 CONTINUE

      THETA(NPAR+1) = DF*0.65D0

      IF (MN.EQ.1) THEN
         THETA(NPAR+1+MN) = MEAN*0.5D0
      END IF

      DO 220 I = 1, NREG
         THETA(NPAR+1+MN+I) = BX(I)*0.5D0
  220 CONTINUE

      LWK = NREG*NUM + 3*NUM + 3
      NPAR2 = 2 + IQ*2 + IP + MN + NREG

      CALL G13FGF(DIST,YT,X,LDX,NUM,IP,IQ,NREG,MN,NPAR2,THETA,SE,SC,
     +            COVAR,NPARMX,HP,ETM,HTM,LGF,COPT,MAXIT,TOL,WK,LWK,
     +            IFLAG)

      WRITE (NOUT,*)
      WRITE (NOUT,*) 'Student t-distribution'
      WRITE (NOUT,*)
      WRITE (NOUT,*) '          Parameter       Standard        Correct'
      WRITE (NOUT,*) '          estimates       errors          values'

      DO 240 I = 1, NPAR
         WRITE (NOUT,99999) THETA(I), SE(I), PARAM(I)
  240 CONTINUE

      WRITE (NOUT,99999) THETA(NPAR+1), SE(NPAR+1), DF

      IF (MN.EQ.1) THEN
         WRITE (NOUT,99999) THETA(NPAR+1+MN), SE(NPAR+1+MN), MEAN
      END IF

      DO 260 I = 1, NREG
         WRITE (NOUT,99999) THETA(NPAR+1+MN+I), SE(NPAR+1+MN+I), BX(I)
  260 CONTINUE

      NT = 4
      CALL G13FHF(NUM,NT,IP,IQ,THETA,CVAR,HTM,ETM,IFLAG)

      WRITE (NOUT,*)
      WRITE (NOUT,99998) 'Volatility forecast = ', CVAR(NT)
      WRITE (NOUT,*)
      STOP
*
99999 FORMAT (1X,3F16.4)
99998 FORMAT (1X,A,F12.4)
      END
