    PROGRAM g01affe

!      G01AFF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. 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
