! G05ZMF Example Program Text ! Mark 24 Release. NAG Copyright 2012. Module g05zmfe_mod ! G05ZMF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. Use nag_library, Only: nag_wp ! .. Implicit None Statement .. Implicit None Contains Subroutine cov1(t,gamma,iuser,ruser) ! .. Implicit None Statement .. Implicit None ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: gamma Real (Kind=nag_wp), Intent (In) :: t ! .. Array Arguments .. Real (Kind=nag_wp), Intent (Inout) :: ruser(*) Integer, Intent (Inout) :: iuser(*) ! .. Local Scalars .. Real (Kind=nag_wp) :: dummy, l, nu ! .. Intrinsic Procedures .. Intrinsic :: abs, exp ! .. Executable Statements .. ! Correlation length in ruser(1) l = ruser(1) ! Exponent in ruser(2) nu = ruser(2) If (t==0.0_nag_wp) Then gamma = 1.0_nag_wp Else dummy = (abs(t)/l)**nu gamma = exp(-dummy) End If Return End Subroutine cov1 End Module g05zmfe_mod Program g05zmfe ! G05ZMF Example Main Program ! .. Use Statements .. Use nag_library, Only: g05zmf, nag_wp Use g05zmfe_mod, Only: cov1 ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: l, nu, rho, var, xmax, xmin Integer :: approx, icorr, icount, ifail, m, & maxm, ns, pad ! .. Local Arrays .. Real (Kind=nag_wp) :: eig(3), ruser(2) Real (Kind=nag_wp), Allocatable :: lam(:), xx(:) Integer :: iuser(0) ! .. Executable Statements .. Write (nout,*) 'G05ZMF Example Program Results' Write (nout,*) ! Get problem specifications from data file Call read_input_data(l,nu,var,xmin,xmax,ns,maxm,icorr,pad) ! Put covariance parameters in communication array ruser(1) = l ruser(2) = nu Allocate (lam(maxm),xx(ns)) ! Get square roots of the eigenvalues of the embedding matrix ifail = 0 Call g05zmf(ns,xmin,xmax,maxm,var,cov1,pad,icorr,lam,xx,m,approx,rho, & icount,eig,iuser,ruser,ifail) ! Output results Call display_results(approx,m,rho,eig,icount,lam) Contains Subroutine read_input_data(l,nu,var,xmin,xmax,ns,maxm,icorr,pad) ! .. Implicit None Statement .. Implicit None ! .. Scalar Arguments .. Real (Kind=nag_wp), Intent (Out) :: l, nu, var, xmax, xmin Integer, Intent (Out) :: icorr, maxm, ns, pad ! .. Executable Statements .. ! Skip heading in data file Read (nin,*) ! Read in l and nu for cov1 function Read (nin,*) l, nu ! 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 g05zmfe