Program g01apfe

!     G01APF Example Program Text
!     Mark 30.0 Release. NAG Copyright 2024.

!     .. 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