Program g08eafe ! G08EAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g08eaf, nag_wp, x04caf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: chi, df, prob Integer :: i, ifail, ldcov, lwrk, m, maxr, n, & nruns, nsamp, pn Character (1) :: cl ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: cov(:,:), ex(:), wrk(:), x(:) Integer, Allocatable :: ncount(:) ! .. Executable Statements .. Write (nout,*) 'G08EAF Example Program Results' Write (nout,*) ! Skip main heading in data file Read (nin,*) ! Read in number of samples Read (nin,*) nsamp, m, maxr ldcov = maxr lwrk = maxr*(maxr+5)/2 + 1 Allocate (ncount(maxr),cov(ldcov,maxr),ex(maxr),wrk(lwrk),x(1)) If (nsamp==1) Then cl = 'S' Else cl = 'F' End If pn = 0 Do i = 1, nsamp ! Skip run heading in data file Read (nin,*) ! Read in sample size Read (nin,*) n If (n>pn) Then ! Reallocate X if required Deallocate (x) Allocate (x(n)) pn = n End If ! Read in the sample Read (nin,*) x(1:n) ! Process the sample ifail = -1 Call g08eaf(cl,n,x,m,maxr,nruns,ncount,ex,cov,ldcov,chi,df,prob,wrk, & lwrk,ifail) If (ifail/=0 .And. ifail/=10) Then Go To 100 End If ! Adjust CL for intermediate calls If (i5' Write (nout,99998) ncount(1:maxr) Write (nout,*) Write (nout,*) ' Expect' Write (nout,*) & ' 1 2 3 4 5 >5' Write (nout,99997) ex(1:maxr) Write (nout,*) Flush (nout) ifail = 0 Call x04caf('General',' ',maxr,maxr,cov,ldcov,'Covariance matrix',ifail) Write (nout,*) Write (nout,99996) 'Chisq = ', chi Write (nout,99995) 'DF = ', df Write (nout,99996) 'Prob = ', prob 100 Continue 99999 Format (1X,A,I10) 99998 Format (3X,6I9) 99997 Format (3X,6F9.1) 99996 Format (1X,A,F10.4) 99995 Format (1X,A,F7.1) End Program g08eafe