SUBROUTINE TDA2(NTIME,M,Z,PD,XD,DF,MODB,T)
      IMPLICIT DOUBLE PRECISION (A-Z)
      INTEGER IDIM
      PARAMETER (IDIM=50)
      INTEGER NTIME,N1,I,J,MODB,NCELLS,DF
      DIMENSION M(IDIM),Z(IDIM),PD(1),XD(IDIM),A(4),T(9,IDIM)
C
C         SUBROUTINE COMPUTES COMPONENT L2(I) FOR THE TEST BETWEEN
C         ModelS D AND A (WITH POOLING).
C
      NCELLS=0
      N1=NTIME-1
      DO 10 I=1,4
   10   A(I)=.0D0
      DO 40 I=2,N1
        RHOD=PD(1)/(.1D1-(.1D1-PD(1))*XD(I))
        IF(MODB.EQ.6)RHOD=PD(I)/(.1D1-(.1D1-PD(I))*XD(I))
        A(1)=A(1)+M(I)
        A(2)=A(2)+Z(I)
        A(3)=A(3)+(M(I)+Z(I))*RHOD
        A(4)=A(4)+(M(I)+Z(I))*(.1D1-RHOD)
        IF(A(1).LT..2D1.OR.A(2).LT..2D1.OR.
     .     A(3).LT..2D1.OR.A(4).LT..2D1)GO TO 40
        IF(I.NE.NTIME-2)GO TO 20
        IF(M(N1).LT..2D1.OR.Z(N1).LT..2D1.OR.RHOD*(M(N1)+Z(N1)).LT.
     .   .2D1.OR.(.1D1-RHOD)*(M(N1)+Z(N1)).LT..2D1)GO TO 40
   20   T(MODB,I)=(A(1)+A(2))*(A(1)-A(3))**2 /A(3)/A(4)
        IF(T(MODB,I).GE..0D0)GO TO 25
        T(MODB,I)=.0D0
        GO TO 40
   25   NCELLS=NCELLS+1
        T(MODB,IDIM)=T(MODB,IDIM)+T(MODB,I)
        DO 30 J=1,4
   30     A(J)=.0D0
   40   CONTINUE
      DF=DF-(NTIME-2-NCELLS)
      RETURN
      END