SUBROUTINE POOL(E,OBS)
C             POOLS 2X3 OR 2X4 CONTINGENCY TABLE
C        9 DIFFERENT WAYS OF POOLING ARE POSSIBLE FROM A 2X4 TABLE. EACH
C        OF THESE WAYS IS TRIED TO SEE IF THERE IS A WAY TO ONLY REDUCE
C        THE NUMBER OF COLUMNS BY 1.
C
      DOUBLE PRECISION E(2,4),OBS(2,4),EE(2,5),EMIN
      INTEGER II(9),JJ(9),KK(9)
      DATA II/1,1,1,2,2,3,1,1,2/,JJ/2,3,4,3,4,4,2,2,3/,KK/6*5,3,4,4/
      DATA EE/10*.0D0/
C         FIRST, SEE IF ANY POOLING IS NECESSARY
      IF(EMIN(E).GT..2D1)RETURN
C         NOW, FOR EACH WAY OF POOLING, POOL & CHECK IF ALL EXPECTED
C         VALUES ARE > 2.

      DO 10 IWAY=1,9
C          MAKE A WORKING COPY OF E.
         DO 5 I=1,4
           EE(1,I)=E(1,I)
    5      EE(2,I)=E(2,I)
        I=II(IWAY)
        J=JJ(IWAY)
        K=KK(IWAY)
C?????  IF(J.EQ.4.OR.IWAY.GT.4)GO TO 10
C                POOL COLS I & J (& K IF IWAY>6)
        EE(1,I)=EE(1,I)+EE(1,J)+EE(1,K)
        EE(2,I)=EE(2,I)+EE(2,J)+EE(2,K)
        EE(1,J)=.0D0
        EE(2,J)=.0D0
        EE(1,K)=.0D0
        EE(2,K)=.0D0
        IF(EMIN(EE).GE..2D1)GO TO 20
   10   CONTINUE
C           AT THIS POINT, POOLING DOESN'T HELP...SO RETURN
      RETURN
C           POOL EXP & OBS TABLES
   20 E(1,I)=E(1,I)+E(1,J)
      E(2,I)=E(2,I)+E(2,J)
      OBS(1,I)=OBS(1,I)+OBS(1,J)
      OBS(2,I)=OBS(2,I)+OBS(2,J)
      E(1,J)=.0D0
      E(2,J)=.0D0
      OBS(1,J)=.0D0
      OBS(2,J)=.0D0
      IF(IWAY.GT.6)THEN
        E(1,I)=E(1,I)+E(1,K)
        E(2,I)=E(2,I)+E(2,K)
        OBS(1,I)=OBS(1,I)+OBS(1,K)
        OBS(2,I)=OBS(2,I)+OBS(2,K)
        E(1,K)=.0D0
        E(2,K)=.0D0
        OBS(1,K)=.0D0
        OBS(2,K)=.0D0
        ENDIF
      RETURN
      END
      FUNCTION EMIN(EE)
C      FINDS THE MINIMUN NON-ZERO VALUE IN A 2X4 CONTINGENCY TABLE
      DOUBLE PRECISION EE(2,5),EMIN
      EMIN=.1D55
      DO 5 I=1,4
        IF(EE(1,I).LT.EMIN.AND.EE(1,I).GT..0D0)EMIN=EE(1,I)
        IF(EE(2,I).LT.EMIN.AND.EE(2,I).GT..0D0)EMIN=EE(2,I)
    5   CONTINUE
      RETURN
      END
      FUNCTION XSQRT(X)
      DOUBLE PRECISION X,XSQRT
      IF(X.LT..0D0)THEN
        WRITE(7,*)'********************************'
        WRITE(7,*)'*** Error: SQRT argument < 0 ***'
        WRITE(7,*)'*** NOTE: Result set to zero ***'
        WRITE(7,*)'********************************'
        XSQRT=.0D0
      ELSE
        XSQRT=DSQRT(X)
      ENDIF
      RETURN
      END