*     G13AEF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NPMAX, IEXMAX, NXMAX, IGHMAX, ISTMAX, IH, IWAMAX
      PARAMETER        (NPMAX=10,IEXMAX=50,NXMAX=50,IGHMAX=10,ISTMAX=10,
     +                 IH=IGHMAX,IWAMAX=350)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION C, S
      INTEGER          I, IEX, IFAIL, IGH, IST, ITC, IWA, J, KFC, KPIV,
     +                 KZSP, NDF, NEX, NGH, NIT, NPAR, NST, NX
*     .. Local Arrays ..
      DOUBLE PRECISION AL(IEXMAX), EX(IEXMAX), EXR(IEXMAX), G(IGHMAX),
     +                 H(IH,IGHMAX), HC(IH,IGHMAX), PAR(NPMAX),
     +                 SD(IGHMAX), ST(ISTMAX), WA(IWAMAX), X(NXMAX),
     +                 ZSP(4)
      INTEGER          ICOUNT(6), ISF(4), MR(7)
*     .. External Subroutines ..
      EXTERNAL         G13AEF, PIV
*     .. Intrinsic Functions ..
      INTRINSIC        MAX
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G13AEF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) NX, (MR(I),I=1,7)
      IF (NX.GT.0 .AND. NX.LE.NXMAX) THEN
         READ (NIN,*) (X(I),I=1,NX)
         NPAR = MR(1) + MR(3) + MR(4) + MR(6)
         IF (NPAR.GT.0 .AND. NPAR.LE.NPMAX) THEN
            DO 20 I = 1, NPAR
               PAR(I) = 0.0D0
   20       CONTINUE
            KFC = 1
            C = 0.0D0
            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)))
*           * Set KPIV to 1 to obtain monitoring information *
            KPIV = 0
            NIT = 25
            ZSP(1) = 0.001D0
            ZSP(2) = 10.0D0
            ZSP(3) = 1000.0D0
            ZSP(4) = 0.0001D0
            KZSP = 1
            IWA = ((NX+1+MR(1)+(MR(4)*MR(7))+MR(3)+(MR(6)*MR(7)))*8) +
     +            (9*NPAR)
            IF (IEX.LE.IEXMAX .AND. IGH.LE.IGHMAX .AND. IST.LE.
     +          ISTMAX .AND. IWA.LE.IWAMAX) THEN
               IFAIL = 1
*
               CALL G13AEF(MR,PAR,NPAR,C,KFC,X,NX,ICOUNT,EX,EXR,AL,IEX,
     +                     S,G,IGH,SD,H,IH,ST,IST,NST,PIV,KPIV,NIT,ITC,
     +                     ZSP,KZSP,ISF,WA,IWA,HC,IFAIL)
*
               IF (IFAIL.NE.0) WRITE (NOUT,99999)
     +             'G13AEF fails. IFAIL = ', IFAIL
               IF (IFAIL.EQ.0 .OR. IFAIL.GE.7) THEN
                  NEX = ICOUNT(4)
                  NDF = ICOUNT(5)
                  NGH = ICOUNT(6)
                  WRITE (NOUT,*)
                  WRITE (NOUT,99998) 'Convergence was achieved after',
     +              ITC, ' cycles'
                  WRITE (NOUT,*)
                  WRITE (NOUT,*)
     +'Final values of the PAR parameters and the constant are as follow
     +s'
                  WRITE (NOUT,99997) (PAR(I),I=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(I),I=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(I),I=1,NGH)
                  IF ((IFAIL.EQ.0 .OR. IFAIL.EQ.9) .AND. ITC.GT.0) THEN
                     WRITE (NOUT,*)
                     WRITE (NOUT,*) 'The corresponding SD array holds'
                     WRITE (NOUT,99994) (SD(I),I=1,NGH)
                     WRITE (NOUT,*)
                     WRITE (NOUT,*)
     +             'The corresponding H matrix holds second derivatives'
                     WRITE (NOUT,*)
     +                 'in the upper half (including the main diagonal)'
                     WRITE (NOUT,*)
     +              'and correlation coefficients in the lower triangle'
                     DO 40 I = 1, NGH
                        WRITE (NOUT,99993) (H(I,J),J=1,NGH)
   40                CONTINUE
                  END IF
                  WRITE (NOUT,*)
                  WRITE (NOUT,99992) 'EX, EXR, and AL each hold', NEX,
     +              ' values made up of', ICOUNT(1),
     +              ' back forecast(s),'
                  WRITE (NOUT,99991) ICOUNT(2),
     +              ' differenced values, and'
                  WRITE (NOUT,99991) ICOUNT(3),
     +              ' element(s) of reconstituted information'
                  WRITE (NOUT,*)
                  WRITE (NOUT,*) '  EX'
                  WRITE (NOUT,99990) (EX(I),I=1,NEX)
                  IF (IFAIL.EQ.0 .OR. IFAIL.EQ.9) THEN
                     WRITE (NOUT,*)
                     WRITE (NOUT,*) '  EXR'
                     WRITE (NOUT,99990) (EXR(I),I=1,NEX)
                  END IF
                  IF (IFAIL.EQ.0) THEN
                     WRITE (NOUT,*)
                     WRITE (NOUT,*) '  AL'
                     WRITE (NOUT,99990) (AL(I),I=1,NEX)
                  END IF
                  IF (IFAIL.EQ.0 .OR. IFAIL.EQ.9) THEN
                     WRITE (NOUT,*)
                     WRITE (NOUT,99998) 'The state set consists of',
     +                 NST, ' values'
                     WRITE (NOUT,99990) (ST(I),I=1,NST)
                  END IF
               END IF
            END IF
         END IF
      END IF
      STOP
*
99999 FORMAT (1X,A,I2)
99998 FORMAT (1X,A,I3,A)
99997 FORMAT (1X,4F10.4)
99996 FORMAT (1X,A,F10.3,A,I4,A)
99995 FORMAT (1X,4D15.4)
99994 FORMAT (1X,10F9.4)
99993 FORMAT (1X,6F11.3)
99992 FORMAT (1X,A,I5,A,I5,A)
99991 FORMAT (1X,I5,A)
99990 FORMAT (1X,5F11.4)
      END
*
      SUBROUTINE PIV(MR,PAR,NPAR,C,KFC,ICOUNT,S,G,H,IH,NGH,ITC,ZSP)
*     .. Parameters ..
      INTEGER        NOUT
      PARAMETER      (NOUT=6)
*     .. Scalar Arguments ..
      DOUBLE PRECISION C, S
      INTEGER        IH, ITC, KFC, NGH, NPAR
*     .. Array Arguments ..
      DOUBLE PRECISION G(NGH), H(IH,NGH), PAR(NPAR), ZSP(4)
      INTEGER        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,D11.4)
      END
