!   G02HMF Example Program Text
!   Mark 30.2 Release. NAG Copyright 2024.

    Module g02hmfe_mod

!     G02HMF 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,w)

!       u function

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
        Real (Kind=nag_wp), Intent (Out) :: u, w
!       .. 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
        If (t/=0.0_nag_wp) Then
          t2 = t*t
          If (t2>cu) Then
            u = cu/t2
          End If
        End If
!       w function
        cw = ruser(2)
        If (t>cw) Then
          w = cw/t
        Else
          w = 1.0_nag_wp
        End If
      End Subroutine ucv
    End Module g02hmfe_mod
    Program g02hmfe

!     G02HMF Example Main Program

!     .. Use Statements ..
      Use g02hmfe_mod, Only: iset, nin, nout, ucv
      Use nag_library, Only: g02hmf, 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,*) 'G02HMF 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 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 g02hmf(ucv,ruser,indm,n,m,x,ldx,cov,a,wt,theta,bl,bd,maxit,nitmon,  &
        tol,nit,wk,ifail)

!     Display results
      Write (nout,99999) 'G02HMF 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 g02hmfe