PROGRAM g01apfe

!      G01APF Example Program Text
!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g01apf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: eps
       INTEGER                         :: i, ifail, ind, licomm, lrcomm,       &
                                          ltcomm, n, nb, np, nq
       LOGICAL                         :: repeat
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: q(:), qv(:), rcomm(:), rv(:),        &
                                          trcomm(:)
       INTEGER, ALLOCATABLE            :: icomm(:), ticomm(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'G01APF Example Program Results'
       WRITE (nout,*)

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

!      Read in approximation factor
       READ (nin,*) eps

!      Read in number of elements in the output vector qv
       READ (nin,*) nq
       ALLOCATE (qv(nq),q(nq))

!      Read in vector q
       READ (nin,*) q(1:nq)

       lrcomm = 100
       licomm = 400
       nb = 20
       ALLOCATE (rcomm(lrcomm),icomm(licomm),rv(nb))

       ind = 0
       repeat = .TRUE.
       n = 0

M_LP:  DO WHILE (repeat)

          IF (ind==0 .OR. ind==1) THEN
D_LP:        DO i = 1, nb
                READ (nin,*,IOSTAT=ifail) rv(i)
                IF (ifail/=0) THEN
                   EXIT D_LP
                END IF
             END DO D_LP

             IF (i==1) THEN
                EXIT M_LP
             ELSE IF (i-1<nb) THEN
                nb = i - 1
                repeat = .FALSE.
             END IF
             n = n + nb
          END IF

!         Call the routine
          ifail = 1
          CALL g01apf(ind,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm, &
             ifail)
          IF (ifail/=0) THEN
!            This routine is most likely to be used to process large datasets, 
!            certain parameter checks will only be done once all the data has 
!            been processed. Calling the routine with a hard failure (IFAIL=0) 
!            would cause any processing to be lost as the program terminates.
!            It is likely that a soft failure would be more appropriate. This 
!            would allow any issues with the input parameters to be resolved 
!            without losing any processing already carried out. 

!            In this small example we are just calling the routine again with
!            a hard failure so that the error messages are displayed.
             ifail = 0
             CALL g01apf(ind,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm, &
                ifail)
          END IF

!         If ind=2, the communication arrays are too small.
!         Allocate more memory, copy the content back to the communication
!         arrays and call the routine again with the same rv
          IF (ind==2) THEN
             IF (lrcomm<icomm(1)) THEN
                ltcomm = lrcomm
                lrcomm = icomm(1)
                ALLOCATE (trcomm(ltcomm))
                trcomm(1:ltcomm) = rcomm(1:ltcomm)
                DEALLOCATE (rcomm)
                ALLOCATE (rcomm(lrcomm))
                rcomm(1:ltcomm) = trcomm(1:ltcomm)
                DEALLOCATE (trcomm)
             END IF
             IF (licomm<icomm(2)) THEN
                ltcomm = licomm
                licomm = icomm(2)
                ALLOCATE (ticomm(ltcomm))
                ticomm(1:ltcomm) = icomm(1:ltcomm)
                DEALLOCATE (icomm)
                ALLOCATE (icomm(licomm))
                icomm(1:ltcomm) = ticomm(1:ltcomm)
                DEALLOCATE (ticomm)
             END IF
          END IF
       END DO M_LP

!      Call NAG again with ind=3 to calculate quantiles specified in vector q
       ind = 3
       ifail = 0
       CALL g01apf(ind,rv,nb,eps,np,q,qv,nq,rcomm,lrcomm,icomm,licomm,ifail)

!      Print the results
       WRITE (nout,*) 'Input data:'
       WRITE (nout,99999) n, ' observations'
       WRITE (nout,99998) 'eps = ', eps
       WRITE (nout,*)
       WRITE (nout,*) 'Quantile     Result'
       WRITE (nout,99997) (q(i),qv(i),i=1,nq)

99999  FORMAT (1X,I2,A)
99998  FORMAT (1X,A,F5.2)
99997  FORMAT (1X,F7.2,4X,F7.2)
    END PROGRAM g01apfe