*     G13DSF Example Program Text
*     Mark 15 Revised. NAG Copyright 1991.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          KMAX, IPMAX, IQMAX, NMAX, NPARMX, LWORK, LIW,
     +                 MMAX, LDRCM, LDCM
      PARAMETER        (KMAX=3,IPMAX=3,IQMAX=3,NMAX=100,
     +                 NPARMX=(IPMAX+IQMAX)*KMAX*KMAX+KMAX,LWORK=2000,
     +                 LIW=100,MMAX=20,LDRCM=MMAX*KMAX*KMAX,LDCM=NPARMX)
*     .. Local Scalars ..
      DOUBLE PRECISION CGETOL, CHI, RLOGL, SIGLEV
      INTEGER          I, IDF, IFAIL, IP, IPRINT, IQ, ISHOW, J, K, M,
     +                 MAXCAL, N, NITER, NPAR, OUTCHN
      LOGICAL          EXACT, MEAN
*     .. Local Arrays ..
      DOUBLE PRECISION CM(LDCM,NPARMX), G(NPARMX), PAR(NPARMX),
     +                 QQ(KMAX,KMAX), R(KMAX,KMAX,MMAX), R0(KMAX,KMAX),
     +                 RCM(LDRCM,MMAX*KMAX*KMAX), V(KMAX,NMAX),
     +                 W(KMAX,NMAX), WORK(LWORK)
      INTEGER          IW(LIW)
      LOGICAL          PARHLD(NPARMX)
*     .. External Subroutines ..
      EXTERNAL         G13DDF, G13DSF, X04ABF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G13DSF Example Program Results'
      OUTCHN = NOUT
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) K, N
*
      CALL X04ABF(1,OUTCHN)
*
      IF (K.GT.0 .AND. K.LE.KMAX .AND. N.GE.3 .AND. N.LE.NMAX) THEN
         DO 20 I = 1, K
            READ (NIN,*) (W(I,J),J=1,N)
   20    CONTINUE
         READ (NIN,*) IP, IQ, MEAN, M
         IF (IP.GE.0 .AND. IP.LE.IPMAX .AND. IQ.GE.0 .AND. IQ.LE.IQMAX)
     +       THEN
            NPAR = (IP+IQ)*K*K
            IF (MEAN) NPAR = NPAR + K
            IF (NPAR.LE.NPARMX) THEN
               DO 40 I = 1, NPAR
                  PAR(I) = 0.0D0
                  PARHLD(I) = .FALSE.
   40          CONTINUE
               DO 80 J = 1, K
                  DO 60 I = J, K
                     QQ(I,J) = 0.0D0
   60             CONTINUE
   80          CONTINUE
               PARHLD(3) = .TRUE.
               EXACT = .TRUE.
*              ** Set IPRINT > 0 to obtain intermediate output **
               IPRINT = -1
               CGETOL = 0.0001D0
               MAXCAL = 40*NPAR*(NPAR+5)
               ISHOW = 2
               IFAIL = 1
*
               CALL G13DDF(K,N,IP,IQ,MEAN,PAR,NPAR,QQ,KMAX,W,PARHLD,
     +                     EXACT,IPRINT,CGETOL,MAXCAL,ISHOW,NITER,RLOGL,
     +                     V,G,CM,LDCM,IFAIL)
*
               WRITE (NOUT,*)
               IF (IFAIL.LT.0) THEN
                  WRITE (NOUT,*)
                  WRITE (NOUT,99999) ' ** G13DDF returned with'//
     +              ' IFAIL = ', IFAIL
               ELSE
                  IF (IFAIL.NE.0) THEN
                     WRITE (NOUT,99999) 'G13DDF fails. IFAIL =', IFAIL
                     WRITE (NOUT,*)
                  END IF
                  IF ((IFAIL.EQ.0 .OR. IFAIL.GE.4) .AND. M.LE.MMAX) THEN
                     WRITE (NOUT,*) 'Output from G13DSF'
                     WRITE (NOUT,*)
                     ISHOW = 1
                     IFAIL = -1
*
                     CALL G13DSF(K,N,V,KMAX,IP,IQ,M,PAR,PARHLD,QQ,ISHOW,
     +                           R0,R,RCM,LDRCM,CHI,IDF,SIGLEV,IW,LIW,
     +                           WORK,LWORK,IFAIL)
*
                     IF (IFAIL.NE.0) WRITE (NOUT,99999)
     +                   'G13DSF fails. IFAIL =', IFAIL
                  END IF
               END IF
            END IF
         END IF
      END IF
*
99999 FORMAT (1X,A,I5)
      END
