      subroutine cdftdd2(m,n,nn,ncds,naux,iminj,iicontr,inddyy,iloc,
     &                   cdfits,cdfitp,cdfitd,tvec,dmat,dds,ddp,ddd,
     &                   gather)

c  this subroutine written by alain st-amant of the department of
c  pharmaceutical chemistry, university of california, san francisco.
c  all rights reserved.  this is part of the DeFT project.

      implicit real*8(a-h,o-z)

      dimension index(15)

      dimension iminj(*),iicontr(*),inddyy(m,*),iloc(*)

      dimension cdfitp(*),cdfitd(*),tvec(*),dmat(*),dds(n,*),ddp(n,*),
     &          ddd(n,*),gather(n,*)

      data zero/0.0d0/

      do 1001 j=1,10
      do 1001 i=1,nn
 1001 gather(i,j)=zero

      do 1002 j=1,36
      do 1002 i=1,nn
 1002 gather(i,1)=gather(i,1)+dmat(inddyy(iicontr(i),j))*dds(i,j)

      do 1003 k=1,3
      do 1003 j=1,36
      do 1003 i=1,nn
 1003 gather(i,k+1)=gather(i,k+1)
     &             +dmat(inddyy(iicontr(i),j))*ddp(i,3*(j-1)+k)

      do 1004 k=1,6
      do 1004 j=1,36
      do 1004 i=1,nn
 1004 gather(i,k+4)=gather(i,k+4)
     &             +dmat(inddyy(iicontr(i),j))*ddd(i,6*(j-1)+k)

      nnn=0

      do 1005 i=1,nn
      if(iminj(iicontr(i)).eq.0) then
                                       nnn=nnn+1
                                       iloc(nnn)=i
                                 endif
 1005 continue

      index(01)=02
      index(02)=03
      index(03)=04
      index(04)=05
      index(05)=06
      index(06)=09
      index(07)=10
      index(08)=11
      index(09)=12
      index(10)=16
      index(11)=17
      index(12)=18
      index(13)=23
      index(14)=24
      index(15)=30

      do 1006 j=1,15
cfpp$ nodepchk
      do 1006 i=1,nnn
 1006 gather(iloc(i),1)=gather(iloc(i),1)
     &                 -dmat(inddyy(iicontr(iloc(i)),index(j)))
     &                 *dds(iloc(i),index(j))

      do 1007 k=1,3
      do 1007 j=1,15
cfpp$ nodepchk
      do 1007 i=1,nnn
 1007 gather(iloc(i),k+1)=gather(iloc(i),k+1)
     &                   -dmat(inddyy(iicontr(iloc(i)),index(j)))
     &                   *ddp(iloc(i),3*(index(j)-1)+k)

      do 1008 k=1,6
      do 1008 j=1,15
cfpp$ nodepchk
      do 1008 i=1,nnn
 1008 gather(iloc(i),k+4)=gather(iloc(i),k+4)
     &                   -dmat(inddyy(iicontr(iloc(i)),index(j)))
     &                   *ddd(iloc(i),6*(index(j)-1)+k)

      do 1009 i=1,nn
      gather(i,01)=gather(i,01)*cdfits
      gather(i,02)=gather(i,02)*cdfitp(1)
      gather(i,03)=gather(i,03)*cdfitp(2)
      gather(i,04)=gather(i,04)*cdfitp(3)
      gather(i,05)=gather(i,05)*cdfitd(1)
      gather(i,06)=gather(i,06)*cdfitd(2)
      gather(i,07)=gather(i,07)*cdfitd(3)
      gather(i,08)=gather(i,08)*cdfitd(4)
      gather(i,09)=gather(i,09)*cdfitd(5)
 1009 gather(i,10)=gather(i,10)*cdfitd(6)

      nc=ncds+(naux-1)*10

      do 1010 i=1,nn
      do 1010 j=1,10
 1010 tvec(nc+j)=tvec(nc+j)+gather(i,j)

 2001 continue

      return
      end
