Program g01wafe

!     G01WAF Example Program Text

!     Mark 30.3 Release. nAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: g01waf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Integer                          :: i, ierr, ifail, iwt, lrcomm, lrsd,   &
                                          m, nb, nsummaries, offset, pn
      Logical                          :: want_sd
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: rcomm(:), rmean(:), rsd(:), wt(:),   &
                                          x(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: allocated, max, min
!     .. Executable Statements ..
      Write (nout,*) 'G01WAF Example Program Results'
      Write (nout,*)

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

!     Read in the problem type
      Read (nin,*) iwt, m

!     Read in a flag indicating whether we want the standard deviations
      Read (nin,*) want_sd

!     Initial handling of weights
      Select Case (iwt)
      Case (1)
!       Weights will be read in with the data
      Case (2)
!       Each observation in the rolling window has its own weight
        Allocate (wt(m))
        Read (nin,*) wt(1:m)
      Case Default
!       No weights need supplying
        Allocate (wt(0))
      End Select

      lrcomm = 2*m + 20
      Allocate (rcomm(lrcomm))

!     Print some titles
      If (want_sd) Then
        Write (nout,99997) '                              Standard'
        Write (nout,99997) ' Interval         Mean        Deviation'
        Write (nout,99997) '---------------------------------------'
      Else
        Write (nout,99997) ' Interval         Mean  '
        Write (nout,99997) '------------------------'
      End If

!     Loop over each block of data
      pn = 0
blk_lp: Do
!       Read in the number of observations in this block
        Read (nin,*,Iostat=ierr) nb
        If (ierr/=0) Then
          Exit blk_lp
        End If
!       Reallocate X to the required size
        If (allocated(x)) Then
          Deallocate (x)
        End If
        Allocate (x(nb))

!       Read in the data for this block
        Read (nin,*) x(1:nb)

        If (iwt==1) Then
!         User supplied weights are present

!         Reallocate WT to the required size
          If (allocated(wt)) Then
            Deallocate (wt)
          End If
          Allocate (wt(nb))

!         Read in the weights for this block
          Read (nin,*) wt(1:nb)
        End If

!       Calculate the number of summaries we can produce
        nsummaries = max(0,nb+min(0,pn-m+1))
        If (want_sd) Then
          lrsd = nsummaries
        Else
          lrsd = 0
        End If

!       Reallocate the output arrays
        If (allocated(rmean)) Then
          Deallocate (rmean)
        End If
        Allocate (rmean(nsummaries))

        If (allocated(rsd)) Then
          Deallocate (rsd)
        End If
        Allocate (rsd(lrsd))

!       Calculate summary statistics for this block of data
        ifail = 0
        Call g01waf(m,nb,x,iwt,wt,pn,rmean,rsd,lrsd,rcomm,lrcomm,ifail)

!       Number of results printed so far
        offset = max(0,pn-nb-m+1)

!       Display the results for this block of data
        If (want_sd) Then
          Do i = 1, nsummaries
            Write (nout,99998) '[', i + offset, ',', i + m - 1 + offset, ']',  &
              rmean(i), rsd(i)
          End Do
        Else
          Do i = 1, nsummaries
            Write (nout,99998) '[', i + offset, ',', i + m - 1 + offset, ']',  &
              rmean(i)
          End Do
        End If
      End Do blk_lp

      Write (nout,*)
      Write (nout,99999) 'Total number of observations : ', pn
      Write (nout,99999) 'Length of window             : ', m

99999 Format (1X,A,I5)
99998 Format (1X,A,2(I3,A),2(4X,F10.1))
99997 Format (1X,A)
    End Program g01wafe