Program g07gafe
! G07GAF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
! .. Use Statements ..
Use nag_library, Only: g07gaf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: mean, var
Integer :: i, ifail, ldiff, n, niout, p
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: diff(:), llamb(:), y(:)
Integer, Allocatable :: iout(:)
! .. Executable Statements ..
Write (nout,*) 'G07GAF Example Program Results'
Write (nout,*)
! Skip heading in data file
Read (nin,*)
! Read in the problem size
Read (nin,*) n, p, ldiff
Allocate (y(n),iout(n),diff(ldiff),llamb(ldiff))
! Read in data
Read (nin,*) y(1:n)
! Let routine calculate mean and variance
mean = 0.0E0_nag_wp
var = 0.0E0_nag_wp
! Get a list of potential outliers
ifail = 0
Call g07gaf(n,p,y,mean,var,iout,niout,ldiff,diff,llamb,ifail)
! Display results
Write (nout,*) 'Number of potential outliers:', niout
If (ldiff>0) Then
Write (nout,*) ' No. Index Value Diff ln(lambda^2)'
Else
Write (nout,*) ' No. Index Value'
End If
Do i = 1, niout
If (i>ldiff) Then
Write (nout,99999) i, iout(i), y(iout(i))
Else
Write (nout,99998) i, iout(i), y(iout(i)), diff(i), llamb(i)
End If
End Do
99999 Format (1X,I4,2X,I4,1X,F10.2)
99998 Format (1X,I4,2X,I4,3(1X,F10.2))
End Program g07gafe