Program g08cgfe ! G08CGF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g01aef, g08cgf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: chisq, p, xmax, xmin Integer :: iclass, ifail, n, nclass, ndf, npar, & npest Character (1) :: dist ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: cb(:), chisqi(:), eval(:), prob(:), & x(:) Real (Kind=nag_wp) :: par(2) Integer, Allocatable :: ifreq(:) ! .. Executable Statements .. Write (nout,*) 'G08CGF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in problem size Read (nin,*) n ! Read in class information Read (nin,*) nclass, iclass Allocate (x(n),cb(nclass),ifreq(nclass),prob(nclass),eval(nclass), & chisqi(nclass)) ! Read in data Read (nin,*) x(1:n) ! Read in the class boundaries, if supplied If (iclass==1) Then Read (nin,*) cb(1:(nclass-1)) End If ! Read in information on the distribution to test against Read (nin,*) dist, npest Select Case (dist) Case ('A','a') npar = 0 Case ('E','e','C','c') npar = 1 Case Default npar = 2 End Select ! Read in the distribution parameters or probabilities If (npar==0) Then Read (nin,*) prob(1:nclass) Else Read (nin,*) par(1:npar) End If ! Produce frequency table for data ifail = 0 Call g01aef(n,nclass,x,iclass,cb,ifreq,xmin,xmax,ifail) ! Perform chi-squared test ifail = -1 Call g08cgf(nclass,ifreq,cb,dist,par,npest,prob,chisq,p,ndf,eval,chisqi, & ifail) If (ifail/=0) Then If (ifail<=9) Then Go To 100 End If End If ! Display results Write (nout,99999) 'Chi-squared test statistic = ', chisq Write (nout,99998) 'Degrees of freedom. = ', ndf Write (nout,99999) 'Significance level = ', p Write (nout,*) Write (nout,*) 'The contributions to the test statistic are :-' Write (nout,99997) chisqi(1:nclass) 100 Continue 99999 Format (1X,A,F10.4) 99998 Format (1X,A,I5) 99997 Format (1X,F10.4) End Program g08cgfe