*     G13ASF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NPARMX, NPPCMX, NXMAX, IRES, LIW, LWORK, MMAX,
     +                 ICM, LDRCM
      PARAMETER        (NPARMX=10,NPPCMX=NPARMX+1,NXMAX=50,IRES=550,
     +                 LIW=10,LWORK=500,MMAX=10,ICM=NPARMX+1,LDRCM=MMAX)
*     .. Local Scalars ..
      DOUBLE PRECISION C, CHI, S, SIGLEV
      INTEGER          I, IDF, IFAIL, ISHOW, ITC, KFC, KPIV, M, N, NDF,
     +                 NIT, NPAR, NPPC, NST, NX, OUTCHN
*     .. Local Arrays ..
      DOUBLE PRECISION CM(ICM,ICM), PAR(NPARMX), R(MMAX),
     +                 RCM(LDRCM,MMAX), SD(NPPCMX), ST(NXMAX), V(IRES),
     +                 WORK(LWORK), X(NXMAX)
      INTEGER          ISF(4), IW(LIW), MR(7)
*     .. External Subroutines ..
      EXTERNAL         G13AFF, G13ASF, X04ABF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G13ASF Example Program Results'
      OUTCHN = NOUT
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) NX
      IF (NX.GT.0 .AND. NX.LE.NXMAX) THEN
         READ (NIN,*) (X(I),I=1,NX)
         READ (NIN,*) (MR(I),I=1,7)
         NPAR = MR(1) + MR(3) + MR(4) + MR(6)
         IF (NPAR.GT.0 .AND. NPAR.LE.NPARMX) THEN
            DO 20 I = 1, NPAR
               PAR(I) = 0.0D0
   20       CONTINUE
            KFC = 1
            C = 0.0D0
            NPPC = NPAR + KFC
*           * Set KPIV to 1 to obtain monitoring information *
            KPIV = 0
            NIT = 50
            IFAIL = 1
*
            CALL G13AFF(MR,PAR,NPAR,C,KFC,X,NX,S,NDF,SD,NPPC,CM,ICM,ST,
     +                  NST,KPIV,NIT,ITC,ISF,V,IRES,N,IFAIL)
*
            IF (IFAIL.LT.0) THEN
               WRITE (NOUT,*)
               WRITE (NOUT,99999) ' ** G13AFF returned with IFAIL = ',
     +           IFAIL
            ELSE
               IF (IFAIL.NE.0) WRITE (NOUT,99999)
     +             'G13AFF fails.'//' IFAIL =', IFAIL
*
               IF (IFAIL.EQ.0 .OR. IFAIL.EQ.9) THEN
                  CALL X04ABF(1,OUTCHN)
                  M = 10
                  ISHOW = 1
                  IFAIL = -1
*
                  CALL G13ASF(N,V,MR,M,PAR,NPAR,ISHOW,R,RCM,LDRCM,CHI,
     +                        IDF,SIGLEV,IW,LIW,WORK,LWORK,IFAIL)
*
                  IF (IFAIL.NE.0) WRITE (NOUT,99999)
     +                'G13ASF fails. IFAIL =', IFAIL
               END IF
            END IF
         END IF
      END IF
*
99999 FORMAT (1X,A,I5)
      END
