!   G05ZSF Example Program Text

!   Mark 25 Release. NAG Copyright 2014.

    Program g05zsfe

!     G05ZSF Example Main Program

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

!     Get problem specifications from data file
      Call read_input_data(icov2,np,params,norm,var,xmin,xmax,ymin,ymax,ns, &
        maxm,icorr,pad,s)

      Allocate (lam(maxm(1)*maxm(2)),xx(ns(1)),yy(ns(2)))

!     Get square roots of the eigenvalues of the embedding matrix
      ifail = 0
      Call g05zrf(ns,xmin,xmax,ymin,ymax,maxm,var,icov2,norm,np,params,pad, &
        icorr,lam,xx,yy,m,approx,rho,icount,eig,ifail)

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

!     Initialize state array
      Call initialize_state(state)

      Allocate (z(ns(1)*ns(2),s))

!     Compute s random field realisations
      ifail = 0
      Call g05zsf(ns,s,m,lam,rho,state,z,ifail)

      Call display_realizations(ns,s,xx,yy,z)

    Contains
      Subroutine read_input_data(icov2,np,params,norm,var,xmin,xmax,ymin,ymax, &
        ns,maxm,icorr,pad,s)

!       .. Implicit None Statement ..
        Implicit None
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (Out)     :: var, xmax, xmin, ymax, ymin
        Integer, Intent (Out)                :: icorr, icov2, norm, np, pad, s
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out)     :: params(npmax)
        Integer, Intent (Out)                :: maxm(2), ns(2)
!       .. Executable Statements ..
!       Skip heading in data file
        Read (nin,*)

!       Read in covariance function number
        Read (nin,*) icov2

!       Read in number of parameters 
        Read (nin,*) np

!       Read in parameters 
        If (np>0) Then
          Read (nin,*) params(1:np)
        End If

!       Read in choice of norm to use
        Read (nin,*) norm

!       Read in variance of random field
        Read (nin,*) var

!       Read in domain endpoints
        Read (nin,*) xmin, xmax
        Read (nin,*) ymin, ymax

!       Read in number of sample points
        Read (nin,*) ns(1:2)

!       Read in maximum size of embedding matrix
        Read (nin,*) maxm(1:2)

!       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
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In)      :: eig(3)
        Integer, Intent (In)                 :: m(2)
!       .. Executable Statements ..
!       Display size of embedding matrix
        Write (nout,*)
        Write (nout,99999) 'Size of embedding matrix = ', m(1)*m(2)

!       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,xx,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)                 :: s
!       .. Array Arguments ..
        Integer, Intent (In)                 :: ns(2)
        Real (Kind=nag_wp), Intent (In)      :: xx(ns(1)), yy(ns(2)),          &
                                                z(ns(1)*ns(2),s)
!       .. Local Scalars ..
        Integer                              :: i, ifail, j, nn
        Character (61)                       :: title
!       .. Local Arrays ..
        Character (1)                        :: clabs(0)
        Character (12), Allocatable          :: rlabs(:)
!       .. Executable Statements ..
        nn = ns(1)*ns(2)
        Allocate (rlabs(nn))

!       Set row labels to grid points (column label is realization number).
        Do j = 1, ns(2)
          Do i = 1, ns(1)
            If (i==1) Then
              Write (rlabs((j-1)*ns(1)+i),99999) xx(i), yy(j)
            Else
              Write (rlabs((j-1)*ns(1)+i),99998) xx(i)
            End If
          End Do
        End Do

!       Display random field results
        title = 'Random field realisations (x,y coordinates first):'
        Write (nout,*)
        ifail = 0
        Call x04cbf(matrix,unit,nn,s,z,nn,form,title,charlab,rlabs,intlab, &
          clabs,ncols,indent,ifail)

99999   Format (2F6.1)
99998   Format (F6.1,5X,'.')

      End Subroutine display_realizations


    End Program g05zsfe