*     G01AFF Example Program Text
*     Mark 14 Revised. NAG Copyright 1989.
*     .. Parameters ..
      INTEGER          NMAX, MMAX, LDNOB, LDPRED
      PARAMETER        (NMAX=8,MMAX=8,LDNOB=MMAX,LDPRED=NMAX)
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
*     .. Local Scalars ..
      DOUBLE PRECISION CHIS
      INTEGER          I, IFAIL, J, K, M, M1, M2, N, N1, N2, NDF, NPOS,
     +                 NPROB, NUM
*     .. Local Arrays ..
      DOUBLE PRECISION P(21), PRED(MMAX,NMAX)
      INTEGER          NOBS(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,*) (NOBS(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(LDNOB,LDPRED,M,N,NOBS,NUM,PRED,CHIS,P,NPOS,NDF,
     +                  M1,N1,IFAIL)
*
            IF (IFAIL.EQ.0) THEN
               WRITE (NOUT,*)
               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, (NOBS(J,K),K=1,N1)
                     WRITE (NOUT,99997) (PRED(J,K),K=1,N1)
                     WRITE (NOUT,99993) 'Row total = ', NOBS(J,N)
   40             CONTINUE
                  WRITE (NOUT,*)
                  WRITE (NOUT,*) 'Column'
                  WRITE (NOUT,99992) 'totals', (NOBS(M,K),K=1,N1)
                  WRITE (NOUT,99993) 'Grand total = ', NOBS(M,N)
                  WRITE (NOUT,*)
                  WRITE (NOUT,99996) 'Chi-squared = ', CHIS,
     +              '   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, (NOBS(J,K),K=1,2)
                     WRITE (NOUT,99993) 'Row total = ', NOBS(J,N)
   60             CONTINUE
                  WRITE (NOUT,*)
                  WRITE (NOUT,*) 'Column'
                  WRITE (NOUT,99992) 'totals', (NOBS(M,K),K=1,2)
                  WRITE (NOUT,99993) 'Grand total = ', NOBS(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
            ELSE
               WRITE (NOUT,99989) IFAIL
               GO TO 100
            END IF
         ELSE
            GO TO 100
         END IF
   80 CONTINUE
  100 CONTINUE
*
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)
99989 FORMAT (1X,/1X,' ** G01AFF returned with IFAIL = ',I5)
      END