Program g11bbfe

!     G11BBF Example Program Text

!     Mark 30.2 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g11bbf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: percnt
      Integer                          :: i, ifail, j, k, ldf, liwk, lwk, lwt, &
                                          maxt, n, ncells, ncol, ndim, nfac,   &
                                          nrow
      Character (1)                    :: typ, weight
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: table(:), wk(:), wt(:), y(:)
      Integer, Allocatable             :: icount(:), idim(:), ifac(:,:),       &
                                          isf(:), iwk(:), lfac(:)
!     .. Executable Statements ..
      Write (nout,*) 'G11BBF Example Program Results'
      Write (nout,*)

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

!     Read in the problem size
      Read (nin,*) typ, weight, n, nfac, percnt

      If (weight=='W' .Or. weight=='w') Then
        lwt = n
      Else
        lwt = 0
      End If
      liwk = 2*nfac + n
      lwk = 2*n
      ldf = n
      Allocate (isf(nfac),lfac(nfac),ifac(ldf,nfac),idim(nfac),iwk(liwk),y(n), &
        wt(lwt),wk(lwk))

!     Read in data
      If (lwt>0) Then
        Read (nin,*)(ifac(i,1:nfac),y(i),wt(i),i=1,n)
      Else
        Read (nin,*)(ifac(i,1:nfac),y(i),i=1,n)
      End If
      Read (nin,*) lfac(1:nfac)
      Read (nin,*) isf(1:nfac)

!     Calculate the size of TABLE
      maxt = 1
      Do i = 1, nfac
        If (isf(i)>0) Then
          maxt = maxt*lfac(i)
        End If
      End Do

      Allocate (table(maxt),icount(maxt))

!     Compute classification table
      ifail = 0
      Call g11bbf(typ,weight,n,nfac,isf,lfac,ifac,ldf,percnt,y,wt,table,maxt,  &
        ncells,ndim,idim,icount,iwk,wk,ifail)

!     Display results
      Write (nout,99999) ' TABLE for ', percnt, 'th percentile'
      Write (nout,*)
      ncol = idim(ndim)
      nrow = ncells/ncol
      k = 1
      Do i = 1, nrow
        Write (nout,99998)(table(j),'(',icount(j),')',j=k,k+ncol-1)
        k = k + ncol
      End Do

99999 Format (A,F4.0,A)
99998 Format (1X,6(F8.2,A,I2,A))
    End Program g11bbfe