Program g01affe ! G01AFF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: g01aff, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: chis Integer :: ifail, im, in, j, k, ldnob, ldpred, & m, m1, m2, n, n1, n2, ndf, npos, num ! .. Local Arrays .. Real (Kind=nag_wp) :: p(21) Real (Kind=nag_wp), Allocatable :: pred(:,:) Integer, Allocatable :: nobs(:,:) ! .. Executable Statements .. Write (nout,*) 'G01AFF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read in the problem size (where N and M are the number of ! rows and columns in the two way table NOBS) Read (nin,*) im, in, num ! M and N as supplied to G01AFF must be 1 more than the number ! of rows and columns of data in NOBS m = im + 1 n = in + 1 ldnob = m ldpred = m Allocate (nobs(ldnob,n),pred(ldpred,n)) ! Read in data Read (nin,*)(nobs(j,1:in),j=1,im) Write (nout,*) 'Data as input -' Write (nout,99992) 'Number of rows', im Write (nout,99992) 'Number of columns', in Write (nout,99992) 'NUM =', num, & ' (NUM = 1 means table reduced in size if necessary)' ! Perform the analysis ifail = 0 Call g01aff(ldnob,ldpred,m,n,nobs,num,pred,chis,p,npos,ndf,m1,n1,ifail) ! Display results If (num==0) Then m2 = m - 1 n2 = n - 1 If (m1/=m2) Then Write (nout,99992) 'No. of rows reduced from ', m2, ' to ', m1 End If If (n1/=n2) Then Write (nout,99992) 'No. of cols reduced from ', n2, ' to ', n1 End If Write (nout,*) Write (nout,*) 'Table of observed and expected frequencies' Write (nout,*) Write (nout,*) ' Column' Write (nout,99991)(k,k=1,n1) Write (nout,*) 'Row' Do j = 1, m1 Write (nout,99999) j, nobs(j,1:n1) Write (nout,99998) pred(j,1:n1) Write (nout,99994) 'Row total = ', nobs(j,n) End Do Write (nout,*) Write (nout,*) 'Column' Write (nout,99993) 'totals', nobs(m,1:n1) Write (nout,99994) 'Grand total = ', nobs(m,n) Write (nout,*) Write (nout,99997) 'Chi-squared = ', chis, ' D.F. = ', ndf Else Write (nout,*) 'Fisher''s exact test for 2*2 table' Write (nout,*) Write (nout,*) 'Table of observed frequencies' Write (nout,*) Write (nout,*) ' Column' Write (nout,*) ' 1 2' Write (nout,*) 'Row' Do j = 1, 2 Write (nout,99999) j, nobs(j,1:2) Write (nout,99994) 'Row total = ', nobs(j,n) End Do Write (nout,*) Write (nout,*) 'Column' Write (nout,99993) 'totals', nobs(m,1:2) Write (nout,99994) 'Grand total = ', nobs(m,n) Write (nout,*) Write (nout,99996) 'This table corresponds to element ', npos, & ' in vector P below' Write (nout,*) Write (nout,*) 'Vector P' Write (nout,*) Write (nout,*) ' I P(I)' Write (nout,99995)(j,p(j),j=1,num) End If 99999 Format (1X,I2,4X,10I6) 99998 Format (8X,12F6.0) 99997 Format (1X,A,F10.3,A,I3) 99996 Format (1X,A,I4,A) 99995 Format (1X,I2,F9.4) 99994 Format (49X,A,I7) 99993 Format (1X,A,10I6) 99992 Format (1X,A,I3,A,I3) 99991 Format (7X,10I6) End Program g01affe