!   G02HLF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    Module g02hlfe_mod

!     G02HLF 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                           :: ucv
!     .. Parameters ..
      Integer, Parameter, Public       :: iset = 1, nin = 5, nout = 6
    Contains
      Subroutine ucv(t,ruser,u,ud,w,wd)

!       u function and derivative

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
        Real (Kind=nag_wp), Intent (Out) :: u, ud, w, wd
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Inout) :: ruser(*)
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: cu, cw, t2
!       .. Executable Statements ..
        cu = ruser(1)
        u = 1.0_nag_wp
        ud = 0.0_nag_wp
        If (t/=0.0_nag_wp) Then
          t2 = t*t
          If (t2>cu) Then
            u = cu/t2
            ud = -2.0_nag_wp*u/t
          End If
        End If
!       w function and derivative
        cw = ruser(2)
        If (t>cw) Then
          w = cw/t
          wd = -w/t
        Else
          w = 1.0_nag_wp
          wd = 0.0_nag_wp
        End If
      End Subroutine ucv
    End Module g02hlfe_mod
    Program g02hlfe

!     G02HLF Example Main Program

!     .. Use Statements ..
      Use g02hlfe_mod, Only: iset, nin, nout, ucv
      Use nag_library, Only: g02hlf, nag_wp, x04abf, x04ccf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: bd, bl, tol
      Integer                          :: i, ifail, indm, la, lcov, ldx,       &
                                          lruser, m, maxit, n, nadv, nit,      &
                                          nitmon
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: a(:), cov(:), ruser(:), theta(:),    &
                                          wk(:), wt(:), x(:,:)
!     .. Executable Statements ..
      Write (nout,*) 'G02HLF Example Program Results'
      Write (nout,*)

!     Skip heading in data file
      Read (nin,*)

!     Read in the problem size
      Read (nin,*) n, m

      ldx = n
      lruser = 2
      la = (m+1)*m/2
      lcov = la
      Allocate (x(ldx,m),ruser(lruser),cov(lcov),a(la),wt(n),theta(m),wk(2*m))

!     Read in the data
      Read (nin,*)(x(i,1:m),i=1,n)

!     Read in the initial value of A
      Read (nin,*) a(1:la)

!     Read in the initial value of THETA
      Read (nin,*) theta(1:m)

!     Read in the values of the parameters of the ucv functions
      Read (nin,*) ruser(1:lruser)

!     Read in the control parameters
      Read (nin,*) indm, nitmon, bl, bd, maxit, tol

!     Set the advisory channel to NOUT for monitoring information
      If (nitmon/=0) Then
        nadv = nout
        Call x04abf(iset,nadv)
      End If

!     Compute robust estimate of variance / covariance matrix
      ifail = 0
      Call g02hlf(ucv,ruser,indm,n,m,x,ldx,cov,a,wt,theta,bl,bd,maxit,nitmon,  &
        tol,nit,wk,ifail)

!     Display results
      Write (nout,99999) 'G02HLF required ', nit, ' iterations to converge'
      Write (nout,*)
      Flush (nout)
      ifail = 0
      Call x04ccf('Upper','Non-Unit',m,cov,'Robust covariance matrix',ifail)
      Write (nout,*)
      Write (nout,*) 'Robust estimates of THETA'
      Write (nout,99998) theta(1:m)

99999 Format (1X,A,I0,A)
99998 Format (1X,F10.3)
    End Program g02hlfe