Program g01wafe
! G01WAF Example Program Text
! Mark 29.2 Release. NAG Copyright 2023.
! .. 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