SUBROUTINE TDBL2(NTIME,M,Z,PD,PB,XD,XB,DF,MD,T)
      IMPLICIT DOUBLE PRECISION (A-Z)
      INTEGER IDIM
      PARAMETER (IDIM=50)
      INTEGER I,N1,NTIME,J,NCELLS,DF,MD
      LOGICAL POOLD
      DIMENSION M(IDIM),Z(IDIM),PB(IDIM),XD(IDIM),XB(IDIM),A(6),
     , T(9,IDIM)
      DATA A/6*.0D0/
      RHOD(I)=PD   /(.1D1-(.1D1-PD   )*XD(I))
      RHOB(I)=PB(I)/(.1D1-(.1D1-PB(I))*XB(I))
C
C         SUBROUTINE COMPUTES COMPONENT L2(I) FOR THE TEST BETWEEN
C         ModelS D2 AND B2 (WITH POOLING).
C
      NCELLS=0
      N1=NTIME-1
      POOLD=.FALSE.
      DO 40 I=2,N1
        A(1)=A(1)+M(I)
        A(2)=A(2)+Z(I)
        A(3)=A(3)+(M(I)+Z(I))*RHOD(I)
        A(4)=A(4)+(M(I)+Z(I))*(.1D1-RHOD(I))
        A(5)=A(5)+(M(I)+Z(I))*RHOB(I)
        A(6)=A(6)+(M(I)+Z(I))*(.1D1-RHOB(I))
        IF(A(3).LT..2D1.OR.A(4).LT..2D1.OR.
     .     A(5).LT..2D1.OR.A(6).LT..2D1)GO TO 30
        IF(I.NE.NTIME-2)GO TO 10
        IF(RHOD(N1)*(M(N1)+Z(N1)).LT..2D1.OR.
     .    (.1D1-RHOD(N1))*(M(N1)+Z(N1)).LT..2D1.OR.
     .     RHOB(N1)*(M(N1)+Z(N1)).LT..2D1.OR.
     .    (.1D1-RHOB(N1))*(M(N1)+Z(N1)).LT..2D1)GO TO 30
   10   NCELLS=NCELLS+1
        IF(POOLD)T(MD,I)=(A(1)+A(2))*(A(5)-A(3))**2/A(3)/A(4)
        IF(.NOT.POOLD)T(MD,I)=(M(I)+Z(I))*(RHOB(I)-RHOD(I))**2/
     /                                      RHOD(I)/(.1D1-RHOD(I))
        IF(T(MD,I).GE..0D0)GO TO 15
        T(MD,I)=.0D0
        GO TO 30
   15   POOLD=.FALSE.
        T(MD,IDIM)=T(MD,IDIM)+T(MD,I)
        DO 20 J=1,6
   20     A(J)=.0D0
        GO TO 40
   30   POOLD=.TRUE.
   40   CONTINUE
      DF=DF-(NTIME-2-NCELLS)
      RETURN
      END