Program g01lbfe ! G01LBF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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,*) ! 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,*) ! 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