PROGRAM g05pffe

!      G05PFF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g05kff, g05pff, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: lseed = 1, nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: gamma
       INTEGER                         :: df, genid, i, ifail, ip, iq, lr,     &
                                          lstate, ltheta, nreal, num, rn, subid
       LOGICAL                         :: fcall
       CHARACTER (1)                   :: dist
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: et(:), ht(:), r(:), theta(:)
       INTEGER                         :: seed(lseed)
       INTEGER, ALLOCATABLE            :: state(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'G05PFF Example Program Results'
       WRITE (nout,*)

!      Skip heading in data file
       READ (nin,*)

!      Read in the base generator information and seed
       READ (nin,*) genid, subid, seed(1)

!      Initial call to initialiser to get size of STATE array
       lstate = 0
       ALLOCATE (state(lstate))
       ifail = 0
       CALL g05kff(genid,subid,seed,lseed,state,lstate,ifail)

!      Reallocate STATE
       DEALLOCATE (state)
       ALLOCATE (state(lstate))

!      Initialize the generator to a repeatable sequence
       ifail = 0
       CALL g05kff(genid,subid,seed,lseed,state,lstate,ifail)

!      Read in sample size and number of realizations
       READ (nin,*) num, nreal

!      Read in number of coefficients
       READ (nin,*) ip, iq

       lr = 2*(ip+iq+2)
       ltheta = ip + iq + 1
       ALLOCATE (theta(ltheta),ht(num),et(num),r(lr))

!      Read in error distribution
       READ (nin,*) dist

!      Read in degrees of freedom if required
       IF (dist=='T' .OR. dist=='t') THEN
          READ (nin,*) df
       END IF

!      Read in rest of series parameters
       READ (nin,*) theta(1:ltheta)
       READ (nin,*) gamma

!      Set FCALL for first realization
       fcall = .TRUE.

!      Generate NREAL realizations
       DO rn = 1, nreal

          ifail = 0
          CALL g05pff(dist,num,ip,iq,theta,gamma,df,ht,et,fcall,r,lr,state, &
             ifail)

!         Display the results
          WRITE (nout,99998) 'Realization Number ', rn
          WRITE (nout,*) '   I            HT(I)            ET(I)'
          WRITE (nout,*) '  --------------------------------------'
          WRITE (nout,99999) (i,ht(i),et(i),i=1,num)
          WRITE (nout,*)

!         Set FCALL flag for any further realizations
          fcall = .FALSE.
       END DO

99999  FORMAT (1X,I5,1X,F16.4,1X,F16.4)
99998  FORMAT (1X,A,I0)
    END PROGRAM g05pffe