Program g11bafe

!     G11BAF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

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

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

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

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

!     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 MAXT
      maxt = 1
      Do i = 1, nfac
        If (isf(i)>0) Then
          maxt = maxt*lfac(i)
        End If
      End Do

      Select Case (stat)
      Case ('A','a')
        lauxt = maxt
      Case ('V','v')
        lauxt = 2*maxt
      Case Default
        lauxt = 0
      End Select

      Allocate (table(maxt),icount(maxt),auxt(lauxt))

!     Compute table
      ifail = 0
      Call g11baf(stat,'I',weight,n,nfac,isf,lfac,ifac,ldf,y,wt,table,maxt,    &
        ncells,ndim,idim,icount,auxt,iwk,ifail)

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

99999 Format (1X,6(F8.2,A,I2,A))
    End Program g11bafe