*     G01AFF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NMAX, MMAX, IA, IO
      PARAMETER        (NMAX=8,MMAX=8,IA=MMAX,IO=NMAX)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION CHI
      INTEGER          I, IFAIL, J, K, M, M1, M2, N, N1, N2, NDF, NPOS,
     +                 NPROB, NUM
*     .. Local Arrays ..
      DOUBLE PRECISION O(MMAX,NMAX), P(21)
      INTEGER          NA(MMAX,NMAX)
*     .. External Subroutines ..
      EXTERNAL         G01AFF
*     .. Executable Statements ..
      WRITE (NOUT,*) 'G01AFF Example Program Results'
*     Skip heading in data file
      READ (NIN,*)
      READ (NIN,*) NPROB
      DO 80 I = 1, NPROB
         READ (NIN,*) M, N, NUM
         IF (M.GE.1 .AND. M.LE.MMAX-1 .AND. N.GE.1 .AND. N.LE.NMAX-1)
     +       THEN
            WRITE (NOUT,*)
            WRITE (NOUT,99999) 'Problem ', I
            DO 20 J = 1, M
               READ (NIN,*) (NA(J,K),K=1,N)
   20       CONTINUE
            WRITE (NOUT,*) 'Data as input -'
            WRITE (NOUT,99991) 'Number of rows', M
            WRITE (NOUT,99991) 'Number of columns', N
            WRITE (NOUT,99991) 'NUM =', NUM,
     +        ' (NUM = 1 means table reduced in size if necessary)'
            IFAIL = 1
            M = M + 1
            N = N + 1
*
            CALL G01AFF(IA,IO,M,N,NA,NUM,O,CHI,P,NPOS,NDF,M1,N1,IFAIL)
*
            WRITE (NOUT,*)
            IF (IFAIL.NE.0) THEN
               WRITE (NOUT,99999)
     +           'Unsuccessful call of G01AFF. IFAIL = ', IFAIL
            ELSE
               IF (NUM.EQ.0) THEN
                  WRITE (NOUT,*) 'Successful call of G01AFF'
                  M2 = M - 1
                  N2 = N - 1
                  IF (M1.NE.M2) THEN
                     WRITE (NOUT,99991) 'No. of rows reduced from ', M2,
     +                 ' to ', M1
                  END IF
                  IF (N1.NE.N2) THEN
                     WRITE (NOUT,99991) '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,99990) (K,K=1,N1)
                  WRITE (NOUT,*) 'Row'
                  DO 40 J = 1, M1
                     WRITE (NOUT,99998) J, (NA(J,K),K=1,N1)
                     WRITE (NOUT,99997) (O(J,K),K=1,N1)
                     WRITE (NOUT,99993) 'Row total = ', NA(J,N)
   40             CONTINUE
                  WRITE (NOUT,*)
                  WRITE (NOUT,*) 'Column'
                  WRITE (NOUT,99992) 'totals', (NA(M,K),K=1,N1)
                  WRITE (NOUT,99993) 'Grand total = ', NA(M,N)
                  WRITE (NOUT,*)
                  WRITE (NOUT,99996) 'Chi-squared = ', CHI,
     +              '   D.F. = ', NDF
               ELSE
                  WRITE (NOUT,*)
                  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 60 J = 1, 2
                     WRITE (NOUT,99998) J, (NA(J,K),K=1,2)
                     WRITE (NOUT,99993) 'Row total = ', NA(J,N)
   60             CONTINUE
                  WRITE (NOUT,*)
                  WRITE (NOUT,*) 'Column'
                  WRITE (NOUT,99992) 'totals', (NA(M,K),K=1,2)
                  WRITE (NOUT,99993) 'Grand total = ', NA(M,N)
                  WRITE (NOUT,*)
                  WRITE (NOUT,99995)
     +              '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,99994) (J,P(J),J=1,NUM)
               END IF
            END IF
         ELSE
            STOP
         END IF
   80 CONTINUE
      STOP
*
99999 FORMAT (1X,A,I4)
99998 FORMAT (1X,I2,4X,10I6)
99997 FORMAT (8X,12F6.0)
99996 FORMAT (1X,A,F10.3,A,I3)
99995 FORMAT (1X,A,I4,A)
99994 FORMAT (1X,I2,F9.4)
99993 FORMAT (49X,A,I7)
99992 FORMAT (1X,A,10I6)
99991 FORMAT (1X,A,I3,A,I3)
99990 FORMAT (7X,10I6)
      END