Program g01aafe

!     G01AAF Example Program Text

!     Mark 25 Release. NAG Copyright 2014.

!     .. Use Statements ..
      Use nag_library, Only: g01aaf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: s2, s3, s4, wtsum, xmax, xmean, xmin
      Integer                          :: ifail, iwt, n
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: wt(:), wtin(:), x(:)
!     .. Executable Statements ..
      Write (nout,*) 'G01AAF Example Program Results'
      Write (nout,*)

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

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

      Allocate (wt(n),wtin(n),x(n))

!     Read in data
      Read (nin,*) x(1:n)
      If (iwt==1) Then
        Read (nin,*) wtin(1:n)
        wt(1:n) = wtin(1:n)
      End If

!     Display data
      Write (nout,99999) 'Number of cases ', n
      Write (nout,*) 'Data as input -'
      Write (nout,99998) x(1:n)
      If (iwt==1) Then
        Write (nout,*) 'Weights as input -'
        Write (nout,99998) wtin(1:n)
      End If
      Write (nout,*)

!     Calculate summary statistics
      ifail = -1
      Call g01aaf(n,x,iwt,wt,xmean,s2,s3,s4,xmin,xmax,wtsum,ifail)
      If (ifail/=0) Then
        If (ifail/=2) Then
          Go To 100
        End If
      End If

!     Display results
      Write (nout,99999) 'No. of valid cases    ', iwt
      Write (nout,99997) 'Mean          ', xmean
      Write (nout,99997) 'Minimum       ', xmin
      Write (nout,99997) 'Maximum       ', xmax
      Write (nout,99997) 'Sum of weights', wtsum

      If (ifail==0) Then
        Write (nout,99997) 'Std devn      ', s2
        Write (nout,99997) 'Skewness      ', s3
        Write (nout,99997) 'Kurtosis      ', s4
      Else
        Write (nout,*) 'Std devn and coeffts of skewness'
        Write (nout,*) 'and kurtosis not defined'
      End If

100   Continue

99999 Format (1X,A,I5)
99998 Format (1X,5F12.1)
99997 Format (1X,A,F13.1)
    End Program g01aafe