* 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