Program g01lbfe
! G01LBF Example Program Text
! Mark 27.0 Release. NAG Copyright 2019.
! .. 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