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

    Module g02hffe_mod

!     G02HFF 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                           :: psi, psp
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: tc = 1.5_nag_wp
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Function psi(t)

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: psi
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
!       .. Intrinsic Procedures ..
        Intrinsic                      :: abs
!       .. Executable Statements ..
        If (t<=-tc) Then
          psi = -tc
        Else If (abs(t)<tc) Then
          psi = t
        Else
          psi = tc
        End If
        Return
      End Function psi

      Function psp(t)

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: psp
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
!       .. Intrinsic Procedures ..
        Intrinsic                      :: abs
!       .. Executable Statements ..
        psp = 0.0_nag_wp
        If (abs(t)<tc) Then
          psp = 1.0_nag_wp
        End If
        Return
      End Function psp
    End Module g02hffe_mod
    Program g02hffe

!     G02HFF Example Main Program

!     .. Use Statements ..
      Use g02hffe_mod, Only: nin, nout, psi, psp
      Use nag_library, Only: g02hff, nag_wp, x04cbf
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: sigma
      Integer                          :: i, ifail, indc, indw, ldc, ldx, m, n
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: c(:,:), rs(:), wgt(:), wk(:), x(:,:)
      Character (0)                    :: clabs(1), rlabs(1)
!     .. Executable Statements ..
      Write (nout,*) 'G02HFF Example Program Results'
      Write (nout,*)
      Flush (nout)

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

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

      ldx = n
      ldc = m
      Allocate (x(ldx,m),wgt(n),rs(n),wk(m*(n+m+1)+2*n),c(ldc,m))

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

!     Read in SIGMA
      Read (nin,*) sigma

!     Read in weights and residuals
      Read (nin,*)(wgt(i),rs(i),i=1,n)

!     Read in control parameters
      Read (nin,*) indw, indc

!     Estimate variance-covariance matrix
      ifail = 0
      Call g02hff(psi,psp,indw,indc,sigma,n,m,x,ldx,rs,wgt,c,ldc,wk,ifail)

!     Display results
      ifail = 0
      Call x04cbf('General',' ',m,m,c,ldc,'F8.4','Covariance matrix','I',      &
        rlabs,'I',clabs,80,0,ifail)

    End Program g02hffe