!   G05ZTF Example Program Text

!   Mark 27.1 Release. NAG Copyright 2020.

Program g05ztfe

!     G05ZTF Example Main Program

!     .. Use Statements ..
Use nag_library, Only: g05znf, g05ztf, nag_wp
!     .. Implicit None Statement ..
Implicit None
!     .. Parameters ..
Integer, Parameter               :: lenst = 17, nin = 5, nout = 6,       &
npmax = 4
!     .. Local Scalars ..
Real (Kind=nag_wp)               :: h, rho, var, xmax, xmin
Integer                          :: approx, icorr, icount, icov1, ifail, &
m, maxm, np, ns, pad, s
!     .. Local Arrays ..
Real (Kind=nag_wp)               :: eig(3), params(npmax)
Real (Kind=nag_wp), Allocatable  :: lam(:), xx(:), yy(:), z(:,:)
Integer                          :: state(lenst)
!     .. Executable Statements ..
Write (nout,*) 'G05ZTF Example Program Results'
Write (nout,*)
Flush (nout)

!     Set fixed problem specifications for simulating fractional Brownian
!     motion.
icov1 = 14
np = 2
xmin = 0.0_nag_wp
var = 1.0_nag_wp

!     Get other problem specifications from data file

Allocate (lam(maxm),xx(ns))

!     Get square roots of the eigenvalues of the embedding matrix
ifail = 0
approx,rho,icount,eig,ifail)

Call display_embedding_results(approx,m,rho,eig,icount)

!     Initialize state array
Call initialize_state(state)

Allocate (yy(ns+1),z(ns+1,s))

!     Computes fractional Brownian motion realizations.
h = params(1)
ifail = 0
Call g05ztf(ns,s,m,xmax,h,lam,rho,state,z,yy,ifail)

Call display_realizations(ns,s,yy,z)

Contains

!       .. Implicit None Statement ..
Implicit None
!       .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (Out) :: xmax
Integer, Intent (Out)          :: icorr, maxm, ns, pad, s
!       .. Array Arguments ..
Real (Kind=nag_wp), Intent (Out) :: params(npmax)
!       .. Intrinsic Procedures ..
Intrinsic                      :: real
!       .. Executable Statements ..
!       Skip heading in data file

!       Read in the Hurst parameter, H

!       Read in number of sample points

params(2) = xmax/(real(ns,kind=nag_wp))

!       Read in maximum size of embedding matrix

!       Read in choice of scaling in case of approximation

!       Read in number of realization samples to be generated

Return

Subroutine display_embedding_results(approx,m,rho,eig,icount)

!       .. 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)
!       .. 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

Return

99999   Format (1X,A,I7)
99998   Format (1X,A,F10.5)
99997   Format (1X,A,3(F10.5,1X))

End Subroutine display_embedding_results

Subroutine initialize_state(state)

!       .. Use Statements ..
Use nag_library, Only: g05kff
!       .. Implicit None Statement ..
Implicit None
!       .. Parameters ..
Integer, Parameter             :: genid = 1, inseed = 14965,           &
lseed = 1, subid = 1
!       .. Array Arguments ..
Integer, Intent (Out)          :: state(lenst)
!       .. Local Scalars ..
Integer                        :: ifail, lstate
!       .. Local Arrays ..
Integer                        :: seed(lseed)
!       .. Executable Statements ..
!       Initialize the generator to a repeatable sequence
lstate = lenst
seed(1) = inseed
ifail = 0
Call g05kff(genid,subid,seed,lseed,state,lstate,ifail)

End Subroutine initialize_state

Subroutine display_realizations(ns,s,yy,z)

!       .. Use Statements ..
Use nag_library, Only: x04cbf
!       .. Implicit None Statement ..
Implicit None
!       .. Parameters ..
Integer, Parameter             :: indent = 0, ncols = 80
Character (1), Parameter       :: charlab = 'C', intlab = 'I',         &
matrix = 'G', unit = 'n'
Character (5), Parameter       :: form = 'F10.5'
!       .. Scalar Arguments ..
Integer, Intent (In)           :: ns, s
!       .. Array Arguments ..
Real (Kind=nag_wp), Intent (In) :: yy(ns+1), z(ns+1,s)
!       .. Local Scalars ..
Integer                        :: i, ifail
Character (61)                 :: title
!       .. Local Arrays ..
Character (1)                  :: clabs(0)
Character (6), Allocatable     :: rlabs(:)
!       .. Executable Statements ..
Allocate (rlabs(ns+1))

!       Set row labels to mesh points (column label is realization number).
Do i = 1, ns + 1
Write (rlabs(i),99999) yy(i)
End Do

!       Display random field results
title =                                                                &
'Fractional Brownian motion realizations (x coordinate first):'
Write (nout,*)
Flush (nout)
ifail = 0
Call x04cbf(matrix,unit,ns+1,s,z,ns+1,form,title,charlab,rlabs,intlab, &
clabs,ncols,indent,ifail)

99999   Format (F6.1)

End Subroutine display_realizations

End Program g05ztfe