! G05ZNF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Program g05znfe ! G05ZNF Example Main Program ! .. Use Statements .. Use nag_library, Only: g05znf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6, npmax = 4 ! .. Local Scalars .. Real (Kind=nag_wp) :: rho, var, xmax, xmin Integer :: approx, icorr, icount, icov1, & ifail, m, maxm, np, ns, pad ! .. Local Arrays .. Real (Kind=nag_wp) :: eig(3), params(npmax) Real (Kind=nag_wp), Allocatable :: lam(:), xx(:) ! .. Executable Statements .. Write (nout,*) 'G05ZNF Example Program Results' Write (nout,*) ! Get problem specifications from data file Call read_input_data(icov1,np,params,var,xmin,xmax,ns,maxm,icorr,pad) Allocate (lam(maxm),xx(ns)) ! Get square roots of the eigenvalues of the embedding matrix ifail = 0 Call g05znf(ns,xmin,xmax,maxm,var,icov1,np,params,pad,icorr,lam,xx,m, & approx,rho,icount,eig,ifail) ! Output results Call display_results(approx,m,rho,eig,icount,lam) Contains Subroutine read_input_data(icov1,np,params,var,xmin,xmax,ns,maxm,icorr, & pad) ! .. Implicit None Statement .. Implicit None ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: var, xmax, xmin Integer, Intent (Out) :: icorr, icov1, maxm, np, ns, pad ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Out) :: params(npmax) ! .. Executable Statements .. ! Skip heading in data file Read (nin,*) ! Read in covariance function number Read (nin,*) icov1 ! Read in number of parameters Read (nin,*) np ! Read in parameters If (np>0) Then Read (nin,*) params(1:np) End If ! Read in variance of random field Read (nin,*) var ! Read in domain endpoints Read (nin,*) xmin, xmax ! Read in number of sample points Read (nin,*) ns ! Read in maximum size of embedding matrix Read (nin,*) maxm ! Read in choice of scaling in case of approximation Read (nin,*) icorr ! Read in choice of padding Read (nin,*) pad Return End Subroutine read_input_data Subroutine display_results(approx,m,rho,eig,icount,lam) ! .. Implicit None Statement .. Implicit None ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (In) :: rho Integer, Intent (In) :: approx, icount, m ! .. Array Arguments .. Real (Kind=nag_wp), Intent (In) :: eig(3), lam(m) ! .. Executable Statements .. ! Display size of embedding matrix Write (nout,*) Write (nout,99999) 'Size of embedding matrix = ', m ! Display approximation information if approximation used Write (nout,*) If (approx==1) Then Write (nout,*) 'Approximation required' Write (nout,*) Write (nout,99998) 'RHO = ', rho Write (nout,99997) 'EIG = ', eig(1:3) Write (nout,99999) 'ICOUNT = ', icount Else Write (nout,*) 'Approximation not required' End If ! Display square roots of the eigenvalues of the embedding matrix Write (nout,*) Write (nout,*) 'Square roots of eigenvalues of embedding matrix:' Write (nout,*) Write (nout,99996) lam(1:m) Return 99999 Format (1X,A,I7) 99998 Format (1X,A,F10.5) 99997 Format (1X,A,3(F10.5,1X)) 99996 Format (1X,4F10.5) End Subroutine display_results End Program g05znfe