*     G05PCF Example Program Text
*     Mark 20 Release. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          KMAX, LDVAR, IPMAX, IQMAX, NMAX, NR, LIWORK
      PARAMETER        (KMAX=3,LDVAR=KMAX,IPMAX=2,IQMAX=2,NMAX=100,
     +                 NR=600,LIWORK=10)
*     .. Local Scalars ..
      INTEGER          I, IFAIL, IGEN, II, IP, IQ, J, K, L, MODE, N
*     .. Local Arrays ..
      DOUBLE PRECISION PHI(KMAX*KMAX*IPMAX), R(NR),
     +                 THETA(KMAX*KMAX*IQMAX), VAR(LDVAR,KMAX),
     +                 X(LDVAR,NMAX), XMEAN(KMAX)
      INTEGER          ISEED(4), IWORK(LIWORK)
*     .. External Subroutines ..
      EXTERNAL         G05KBF, G05PCF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G05PCF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) K, IP, IQ, N
*
      IF (K.GT.0 .AND. K.LE.KMAX .AND. IP.GE.0 .AND. IP.LE.IPMAX .AND.
     +    IQ.GE.0 .AND. IQ.LE.IQMAX) THEN
         IF (N.GT.0 .AND. N.LE.NMAX) THEN
            DO 40 L = 1, IP
               DO 20 I = 1, K
                  II = (L-1)*K*K + I
                  READ (NIN,*) (PHI(II+K*(J-1)),J=1,K)
   20          CONTINUE
   40       CONTINUE
            DO 80 L = 1, IQ
               DO 60 I = 1, K
                  II = (L-1)*K*K + I
                  READ (NIN,*) (THETA(II+K*(J-1)),J=1,K)
   60          CONTINUE
   80       CONTINUE
            READ (NIN,*) (XMEAN(I),I=1,K)
            DO 100 I = 1, K
               READ (NIN,*) (VAR(I,J),J=1,I)
  100       CONTINUE
*           Initialize the seed to a repeatable sequence
            ISEED(1) = 1762543
            ISEED(2) = 9324783
            ISEED(3) = 4234401
            ISEED(4) = 742355
*           IGEN identifies the stream.
            IGEN = 1
            CALL G05KBF(IGEN,ISEED)
*
            MODE = 2
            IFAIL = 1
*
            CALL G05PCF(MODE,K,XMEAN,IP,PHI,IQ,THETA,VAR,LDVAR,N,X,IGEN,
     +                  ISEED,R,NR,IWORK,LIWORK,IFAIL)
*
            WRITE (NOUT,*)
            IF (IFAIL.EQ.0) THEN
*
               WRITE (NOUT,*) ' Realisation Number 1'
*
               DO 120 I = 1, K
                  WRITE (NOUT,99999) '  Series number ', I
                  WRITE (NOUT,*) '  -------------'
                  WRITE (NOUT,*)
                  WRITE (NOUT,99998) (X(I,J),J=1,N)
  120          CONTINUE
*
               MODE = 3
               IFAIL = -1
*
               CALL G05PCF(MODE,K,XMEAN,IP,PHI,IQ,THETA,VAR,LDVAR,N,X,
     +                     IGEN,ISEED,R,NR,IWORK,LIWORK,IFAIL)
*
               IF (IFAIL.EQ.0) THEN
                  WRITE (NOUT,*)
                  WRITE (NOUT,*)
                  WRITE (NOUT,*) ' Realisation Number 2'
*
                  DO 140 I = 1, K
                     WRITE (NOUT,99999) '  Series number ', I
                     WRITE (NOUT,*) '  -------------'
                     WRITE (NOUT,*)
                     WRITE (NOUT,99998) (X(I,J),J=1,N)
  140             CONTINUE
               END IF
            ELSE
               WRITE (NOUT,99997) IFAIL
            END IF
*
         END IF
      END IF
*
99999 FORMAT (/1X,A,I3)
99998 FORMAT (8(2X,F8.3))
99997 FORMAT (1X,' ** G05PCF returned with IFAIL = ',I5)
      END
