! G05ZTF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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,*) ! 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 Call read_input_data(params,xmax,ns,maxm,icorr,pad,s) 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) Call display_embedding_results(approx,m,rho,eig,icount) ! Initialize state array Call initialize_state(state) Allocate (yy(ns+1),z(ns+1,s)) ! Compute s fractional Brownian Motion realisations. 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 Subroutine read_input_data(params,xmax,ns,maxm,icorr,pad,s) ! .. 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 (nin,*) ! Read in the Hurst parameter, H Read (nin,*) params(1) ! Read in domain endpoint Read (nin,*) xmax ! Read in number of sample points Read (nin,*) ns params(2) = xmax/(real(ns,kind=nag_wp)) ! 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 ! Read in number of realization samples to be generated Read (nin,*) s Return End Subroutine read_input_data 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 realisations (x coordinate first):' Write (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