!   G07DCF Example Program Text
!   Mark 30.3 Release. nAG Copyright 2024.

    Module g07dcfe_mod

!     G07DCF 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                           :: hampels_psi, hubers_chi
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: dchi = 1.5_nag_wp
      Real (Kind=nag_wp), Parameter    :: h1 = 1.5_nag_wp
      Real (Kind=nag_wp), Parameter    :: h2 = 3.0_nag_wp
      Real (Kind=nag_wp), Parameter    :: h3 = 4.5_nag_wp
      Real (Kind=nag_wp), Parameter    :: zero = 0.0_nag_wp
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Function hampels_psi(t)
!       Hampel's Piecewise Linear Function.

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: hampels_psi
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: abst
!       .. Intrinsic Procedures ..
        Intrinsic                      :: abs, min
!       .. Executable Statements ..
        abst = abs(t)
        If (abst<h3) Then
          If (abst<=h2) Then
            hampels_psi = min(h1,abst)
          Else
            hampels_psi = h1*(h3-abst)/(h3-h2)
          End If
          If (t<zero) Then
            hampels_psi = -hampels_psi
          End If
        Else
          hampels_psi = zero
        End If
        Return
      End Function hampels_psi
      Function hubers_chi(t)
!       Huber's CHI function.

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: hubers_chi
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: t
!       .. Local Scalars ..
        Real (Kind=nag_wp)             :: abst, ps
!       .. Intrinsic Procedures ..
        Intrinsic                      :: abs, min
!       .. Executable Statements ..
        abst = abs(t)
        ps = min(dchi,abst)
        hubers_chi = ps*ps/2.0E0_nag_wp
        Return
      End Function hubers_chi
    End Module g07dcfe_mod
    Program g07dcfe

!     G07DCF Example Main Program

!     .. Use Statements ..
      Use g07dcfe_mod, Only: hampels_psi, hubers_chi, nin, nout
      Use nag_library, Only: g07dcf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: beta, sigma, sigsav, thesav, theta,  &
                                          tol
      Integer                          :: ifail, isigma, maxit, n, nit
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rs(:), wrk(:), x(:)
!     .. Executable Statements ..
      Write (nout,*) 'G07DCF Example Program Results'
      Write (nout,*)

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

!     Read in the problem size and control parameters
      Read (nin,*) n, beta, maxit

      Allocate (x(n),wrk(n),rs(n))

!     Read in data
      Read (nin,*) x(1:n)

!     Display titles
      Write (nout,*) '          Input parameters     Output parameters'
      Write (nout,*) 'ISIGMA   SIGMA   THETA   TOL    SIGMA  THETA'

d_lp: Do
        Read (nin,*,Iostat=ifail) isigma, sigma, theta, tol
        If (ifail/=0) Then
          Exit d_lp
        End If

!       Save input parameters
        sigsav = sigma
        thesav = theta

!       Compute M-estimates
        ifail = 0
        Call g07dcf(hubers_chi,hampels_psi,isigma,n,x,beta,theta,sigma,maxit,  &
          tol,rs,nit,wrk,ifail)

!       Display results
        Write (nout,99999) isigma, sigsav, thesav, tol, sigma, theta
      End Do d_lp

99999 Format (1X,I3,3X,2F8.4,F7.4,1X,2F8.4)
    End Program g07dcfe