Program g01affe

!     G01AFF Example Program Text

!     Mark 27.0 Release. NAG Copyright 2019.

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