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