NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
    Program g01aufe
!     G01AUF Example Program Text

!     Mark 30.0 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g01atf, g01auf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: xkurt, xmax, xmean, xmin, xsd, xskew
      Integer                          :: b, i, ifail, iwt, j, nb, pn
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: mrcomm(:,:), wt(:), x(:)
      Real (Kind=nag_wp)               :: rcomm(20)
!     .. Executable Statements ..
      Write (nout,*) 'G01AUF Example Program Results'
      Write (nout,*)

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

!     Read in the number of block of data we have
      Read (nin,*) b

      Allocate (mrcomm(20,b))

!     Loop over each block of data
      Do i = 1, b
!       Read in the number of observations in this block and the weight flag
        Read (nin,*) nb, iwt

!       Allocate X to the required size
        Allocate (x(nb))

!       Read in the data for this block
        If (iwt==0) Then
          Allocate (wt(0))
          Read (nin,*) x(1:nb)
        Else
          Allocate (wt(nb))
          Read (nin,*)(x(j),wt(j),j=1,nb)
        End If

!       IFAIL = 53, 71 or 72 are warnings and so we don't want to terminate
!       on any nonzero IFAIL. Therefore we set the flag for a quiet exit
        ifail = 1

!       Summarise this block of data
        pn = 0
        Call g01atf(nb,x,iwt,wt,pn,xmean,xsd,xskew,xkurt,xmin,xmax,            &
          mrcomm(1:20,i),ifail)
        If (ifail/=0 .And. ifail/=71 .And. ifail/=72 .And. ifail/=53) Then
          Write (nout,*) 'G01ATF failed with IFAIL = ', ifail
          Exit
        End If

!       Display the results for this block
        Write (nout,99999) 'Summary for block ', i
        If (ifail==53) Then
          Write (nout,*)                                                       &
            'No valid observations supplied. All weights are zero.'
        Else
          Write (nout,99997) pn, 'valid observations'
          Write (nout,99998) '  Mean           ', xmean
          If (ifail==72) Then
            Write (nout,*)                                                     &
              '  Unable to calculate the standard deviation, skewness or ',    &
              'kurtosis'
          Else
            Write (nout,99998) '  Std devn       ', xsd
            If (ifail==71) Then
              Write (nout,*) '  Unable to calculate the skewness or kurtosis'
            Else
              Write (nout,99998) '  Skewness       ', xskew
              Write (nout,99998) '  Kurtosis       ', xkurt
            End If
          End If
          Write (nout,99998) '  Minimum        ', xmin
          Write (nout,99998) '  Maximum        ', xmax
        End If
        Write (nout,*)

        Deallocate (x,wt)
      End Do

      If (ifail==0 .Or. ifail==71 .Or. ifail==72 .Or. ifail==53) Then
!       Combine the summaries across all the blocks
        Call g01auf(b,mrcomm,pn,xmean,xsd,xskew,xkurt,xmin,xmax,rcomm,ifail)

!       Display the combined results
        Write (nout,99999) 'Summary for the combined data'
        If (ifail==53) Then
          Write (nout,*)                                                       &
            'No valid observations supplied. All weights are zero.'
        Else
          Write (nout,99997) pn, 'valid observations'
          Write (nout,99998) '  Mean           ', xmean
          If (ifail==72) Then
            Write (nout,*)                                                     &
              '  Unable to calculate the standard deviation, skewness and ',   &
              'kurtosis'
          Else
            Write (nout,99998) '  Std devn       ', xsd
            If (ifail==71) Then
              Write (nout,*) '  Unable to calculate the skewness and kurtosis'
            Else
              Write (nout,99998) '  Skewness       ', xskew
              Write (nout,99998) '  Kurtosis       ', xkurt
            End If
          End If
          Write (nout,99998) '  Minimum        ', xmin
          Write (nout,99998) '  Maximum        ', xmax
        End If
      End If

99999 Format (1X,A,I0,A)
99998 Format (1X,A,F13.2)
99997 Format (1X,I0,1X,A)
    End Program g01aufe