NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program g01lbfe

!     G01LBF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g01lbf, nag_wp, x04caf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Integer                          :: i, ifail, ilog, iuld, k, ldsig, ldx, &
                                          n, rank
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: pdf(:), sig(:,:), x(:,:), xmu(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: repeat
!     .. Executable Statements ..
      Write (nout,*) 'G01LBF Example Program Results'
      Write (nout,*)
      Flush (nout)

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

!     Read in the problem size and how the covariance matrix is stored
!     and whether the log PDF is required
      Read (nin,*) k, n, iuld, ilog

!     Allocate arrays
      ldx = n
      Allocate (x(ldx,k),xmu(n),pdf(k))

!     Read in and echo the vector of means
      Read (nin,*) xmu(1:n)
      Write (nout,*) 'Vector of Means: '
      Write (nout,99999) xmu(1:n)
      Write (nout,*)
      Flush (nout)

!     Read in and echo the covariance matrix
      If (iuld==3) Then
!       Covariance matrix is diagonal
        ldsig = 1
        Allocate (sig(ldsig,n))
        Read (nin,*) sig(1,1:n)

        Write (nout,*) 'Diagonal Elements of Covariance Matrix: '
        Write (nout,99999) sig(1,1:n)

      Else
!       Read in an upper or lower triangular matrix
        ldsig = n
        Allocate (sig(ldsig,n))
        If (iuld==1 .Or. iuld==4) Then
!         Lower triangular matrix
          Read (nin,*)(sig(i,1:i),i=1,n)

          If (iuld==1) Then
            Call x04caf('Lower','Nonunit',n,n,sig,ldsig,'Covariance Matrix:',  &
              ifail)
          Else
            Call x04caf('Lower','Nonunit',n,n,sig,ldsig,                       &
              'Lower Triangular Cholesky Factor of Covariance Matrix:',ifail)
          End If
        Else
!         Upper triangular matrix
          Read (nin,*)(sig(i,i:n),i=1,n)

          If (iuld==2) Then
            Call x04caf('Upper','Nonunit',n,n,sig,ldsig,'Covariance Matrix:',  &
              ifail)
          Else
            Call x04caf('Upper','Nonunit',n,n,sig,ldsig,                       &
              'Upper Triangular Cholesky Factor of Covariance Matrix:',ifail)
          End If
        End If
      End If

!     Read in the points at which to evaluate the PDF
      Read (nin,*)(x(1:n,i),i=1,k)

!     Evaluate the PDF
      ifail = 0
      Call g01lbf(ilog,k,n,x,ldx,xmu,iuld,sig,ldsig,pdf,rank,ifail)

!     Display results
      Write (nout,*)
      Write (nout,*) 'Rank of the covariance matrix: ', rank
      Write (nout,*)
      If (ilog==1) Then
        Write (nout,*) '     log(PDF)                  X'
      Else
        Write (nout,*) '       PDF                     X'
      End If
      Write (nout,*) '  ', repeat('-',48)
      Do i = 1, k
        Write (nout,99998) pdf(i), x(1:n,i)
      End Do

99999 Format (1X,100(F8.4,1X))
99998 Format (1X,1P,E13.4,0P,10(1X,F8.4))
    End Program g01lbfe