!   G02HMF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: iset = 1, nin = 5, nout = 6
    CONTAINS
!dec$ attributes offload : mic :: ucv
       SUBROUTINE ucv(t,ruser,u,w)

!         u function

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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
!dec$ attributes offload : mic :: ucv
       END SUBROUTINE ucv
    END MODULE g02hmfe_mod
    PROGRAM g02hmfe

!      G02HMF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : g02hmf, nag_wp, x04abf, x04ccf
       USE g02hmfe_mod, ONLY : iset, nin, nout, ucv
!      .. 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
