!   G05ZMF Example Program Text

!   Mark 30.3 Release. nAG Copyright 2024.

    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
!     .. Accessibility Statements ..
      Private
      Public                           :: cov1
    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 g05zmfe_mod, Only: cov1
      Use nag_library, Only: g05zmf, nag_wp
!     .. 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