C***********************************************************
C   THIS SUBROUTINE COMPUTES THE CHI-SQUARE GOODNESS OF FIT TEST TO THE
C   MODEL BEING USED.  THE ONLY COMPLICATION HERE IS THAT OF POOLING
C   CELLS WITH SMALL EXPECTATIONS.  NOT ALL PATTERNS OF EXPECTATIONS CAN
C   BE ANTICIPATED.  THE ONLY POOLING THIS ROUTINE DOES IS IN BOTH
C   TAILS TO ASSURE THE CELL EXPECTATIONS THERE ARE GREATER THAN 2.0.
C   THE USER CAN ALWAYS DO POOLING BY HAND IF IT IS NEEDED.
C
C   NOTATION
C   ECELL     AN ARRAY THAT INITIALLY HOLDS THE EXPECTED CELL VALUES
C             EVALUATED AT THE MLE OF THE PARAMETERS. THESE ARE
C             MULTIPLIED BY XN TO GIVE THE EXPECTATIONS.
C   IDF       DEGREES OF FREEDOM
C   ML        AN INTEGER SUCH THAT CELLS 1,...,ML ARE POOLED
C             INTO ONE CELL AS NECESSARY TO INSURE AN EXPECTATION
C             GREATER THAN 2.0.
C   MU        AN INTEGER SUCH THAT CELLS MU,...,K,ARE POOLED INTO
C             ONE CELL TO INSURE AN EXPECTATION GREATER THAN 2.0.
C   CHVALU    A CHI-SQUARE TEST STATISTIC VALUE WITH IDF DEGREES
C             OF FREEDOM
C
C     SUBROUTINES CALLED: CHI
C***********************************************************
      SUBROUTINE TEST (F,ECELL,K,NPAR,XN,CUT,TRUNC,P)
C***********************************************************************
C     DECLARATIONS
C***********************************************************************
      REAL F(*), ECELL(*), CUT(*)
      LOGICAL TRUNC
C
C   DETERMINE MAXIMUM DEGREES OF FREEDOM
C
      IDF=K-1-NPAR
      DO 10 I=1,K
   10 ECELL(I)=XN*ECELL(I)
C
C   WRITE COLUMN HEADINGS, THEN COMPUTE AND PRINT DATA.
C
      CHVALU=0.0
      WRITE (6,140)
      WRITE (6,210)
      DO 20 I=1,K
      ZZ=ECELL(I)
      QQ=F(I)-ZZ
      RR=0.00001
      IF (RR.LT.ZZ) RR=ZZ
      QQ=QQ*QQ/RR
      CHVALU=CHVALU+QQ
      IF (I.EQ.1) WRITE (6,150) I,CUT(1),F(1),ECELL(1),QQ
      I1=I-1
      IF ((I.LT.K).AND.(I.GT.1)) WRITE (6,160) I,CUT(I1),CUT(I),F(I)
     1 ,ECELL(I),QQ
      IF ((I.EQ.K).AND.TRUNC) WRITE (6,160) I,CUT(I1),CUT(I),F(I),ECELL
     1 (I),QQ
      IF ((I.EQ.K).AND.(.NOT.TRUNC)) WRITE (6,230) I,CUT(I1),F(I),ECELL
     1 (I),QQ
      IF (ZZ.LT.0.0) WRITE (6,240)
   20 CONTINUE
      WRITE (6,210)
      IF (IDF.LT.1) WRITE (6,130)
      IF (IDF.LT.1) RETURN
      CALL CHI (IDF,CHVALU,P)
      WRITE (6,170) CHVALU,IDF
      P=1.0-P
      WRITE (6,180) P
      WRITE (6,220)
C
C   CHECK IF POOLING IS POSSIBLE OR NECESSARY
C
      IF (IDF.EQ.1) RETURN
      SUM=0.0
      DO 30 I=1,K
      SUM=SUM+ECELL(I)
      IF (SUM.GT.2.0) GO TO 40
   30 CONTINUE
      RETURN
   40 ML=I
      SUM=0.0
      DO 50 I=1,K
      J=K-I+1
      SUM=SUM+ECELL(J)
      IF (SUM.GT.2.0) GO TO 60
   50 CONTINUE
      RETURN
   60 MU=J
      IF ((ML.EQ.1).AND.(MU.EQ.K)) RETURN
C
C   CHECK DEGREES OF FREEDOM IF POOLING IS DONE.  IF IDF WOULD
C   BE GREATER THAN ZERO DO THE POOLING. OTHERWISE FORGET IT.
C
      IDF=IDF-ML+1-K+MU
      IF (IDF.GT.0) GO TO 70
      WRITE (6,190)
      RETURN
C
C   DO THE TEST WITH POOLING
C
   70 IF (ML.LT.2) GO TO 90
      MM=ML-1
      DO 80 I=1,MM
      F(ML)=F(ML)+F(I)
   80 ECELL(ML)=ECELL(ML)+ECELL(I)
   90 IF (MU.EQ.K) GO TO 110
      MM=MU+1
      DO 100 I=MM,K
      F(MU)=F(MU)+F(I)
  100 ECELL(MU)=ECELL(MU)+ECELL(I)
  110 WRITE (6,200)
      WRITE (6,140)
      WRITE (6,210)
      CHVALU=0.0
      DO 120 I=ML,MU
      QQ=F(I)-ECELL(I)
      QQ=QQ*QQ/ECELL(I)
      CHVALU=CHVALU+QQ
      IF (I.EQ.ML) WRITE (6,150) I,CUT(I),F(I),ECELL(I),QQ
      I1=I-1
      IF ((I.GT.ML).AND.(I.LT.MU)) WRITE (6,160) I,CUT(I1),CUT(I),F(I)
     1 ,ECELL(I),QQ
      IF ((I.EQ.MU).AND.TRUNC) WRITE (6,160) I,CUT(I1),CUT(K),F(I),ECELL
     1 (I),QQ
      IF ((I.EQ.MU).AND.(.NOT.TRUNC)) WRITE (6,230) I,CUT(I1),F(I),ECELL
     1 (I),QQ
  120 CONTINUE
      WRITE (6,210)
      CALL CHI (IDF,CHVALU,P)
      P=1.0-P
      WRITE (6,170) CHVALU,IDF
      WRITE (6,180) P
C
C     FORMAT STATEMENTS
C
      RETURN
  130 FORMAT ('0No Degrees of Freedom for the test. No test possible.')
  140 FORMAT (/2X,'Cell',11X,'Cut',11X,'Observed',3X,'Expected',2X,
     1 'Chi-square'/3X,'i',12X,'Points',10X,3('Values',5X))
  150 FORMAT (2X,I2,6X,'0.00',6X,G10.3,2X,F4.0,6X,F7.2,3X,G10.3)
  160 FORMAT (2X,I2,4X,G10.3,2X,G10.3,2X,F4.0,6X,F7.2,3X,G10.3)
  170 FORMAT (' Total Chi-square value =',G11.4,2X,
     1 'Degrees of Freedom = ',I3)
  180 FORMAT ('0Probability of a greater chi-square value =',F7.5)
  190 FORMAT ('0There is a need for some pooling to achieve a',
     1' reliable chi-square test'/
     2' However, the pooling algorithm built into this program would',
     3' result in no'/
     4' degrees of freedom left.  Therefore pooling is left',
     5' to the user.')
  200 FORMAT (///'0Goodness of Fit Testing with some Pooling')
  210 FORMAT (1X,61(1H-))
  220 FORMAT (///'0The program has limited capability for pooling.',
     1'  The user should'/
     2' judge the necessity for pooling and if necessary, do pooling',
     3' by hand.')
  230 FORMAT (2X,I2,4X,G10.3,2X,'Infinity',4X,F4.0,6X,F7.2,3X,G10.3)
  240 FORMAT (' The expected value for the above cell was negative',
     1' which'/
     2' occurs if the model is not constrained to be strictly',
     3' positive.'/
     4' If this algorithm is not able to find a suitable pooling',
     5' method,'/
     6' try pooling by hand.')
      END