PROGRAM g08edfe

!      G08EDF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g08edf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: chi, df, prob, rlo, rup, totlen
       INTEGER                         :: i, ifail, m, maxg, n, ngaps, nsamp, pn
       CHARACTER (1)                   :: cl
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: ex(:), x(:)
       INTEGER, ALLOCATABLE            :: ncount(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'G08EDF Example Program Results'
       WRITE (nout,*)

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

!      Read in number of samples and control parameters
       READ (nin,*) nsamp, m, maxg
       READ (nin,*) rlo, rup, totlen

       ALLOCATE (ncount(maxg),ex(maxg),x(1))

       IF (nsamp==1) THEN
          cl = 'S'
       ELSE
          cl = 'F'
       END IF

       pn = 0
       DO i = 1, nsamp
!         Skip run heading in data file
          READ (nin,*)

!         Read in sample size
          READ (nin,*) n

          IF (n>pn) THEN
!            Reallocate X if required
             DEALLOCATE (x)
             ALLOCATE (x(n))
             pn = n
          END IF

!         Read in the sample
          READ (nin,*) x(1:n)

!         Process the sample
          ifail = -1
          CALL g08edf(cl,n,x,m,maxg,rlo,rup,totlen,ngaps,ncount,ex,chi,df, &
             prob,ifail)
          IF (ifail/=0 .AND. ifail<8) THEN
             GO TO 20
          END IF

!         Adjust CL for intermediate calls
          IF (i<nsamp-1) THEN
             cl = 'I'
          ELSE
             cl = 'L'
          END IF

       END DO

!      Display results
       WRITE (nout,99999) 'Total number of gaps found = ', ngaps
       IF (ifail==8) THEN
          WRITE (nout,*) &
             ' ** Note : the number of gaps requested were not found.'
       END IF
       WRITE (nout,*)
       WRITE (nout,*) 'Count'
       WRITE (nout,*) &
          '      0      1      2      3      4      5      6      7      8', &
          '     >9'
       WRITE (nout,99998) ncount(1:maxg)
       WRITE (nout,*)
       WRITE (nout,*) 'Expect'
       WRITE (nout,*) &
          '      0      1      2      3      4      5      6      7      8', &
          '     >9'
       WRITE (nout,99997) ex(1:maxg)
       WRITE (nout,*)
       WRITE (nout,99996) 'Chisq = ', chi
       WRITE (nout,99995) 'DF    = ', df
       WRITE (nout,99996) 'Prob  = ', prob
       IF (ifail==9) THEN
          WRITE (nout,*) ' ** Note : expected value <= 5.0'
          WRITE (nout,*) &
             '    the chi square approximation may not be very good.'
       END IF

20     CONTINUE

99999  FORMAT (1X,A,I10)
99998  FORMAT (1X,10I7)
99997  FORMAT (1X,10F7.1)
99996  FORMAT (1X,A,F10.4)
99995  FORMAT (1X,A,F7.1)
    END PROGRAM g08edfe