      SUBROUTINE EXPDDP(DDP,NCOORD,ITRANS,NUCIND)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      INTEGER DIRPRD
C
      DIMENSION DDP(3,NCOORD),ITRANS(NUCIND-1,3)
C
      COMMON/SYMINF/NSTART,NIRREP,IRREPA(255,2),DIRPRD(8,8) 
      COMMON/PERT/NTPERT,NPERT(8),IPERT(8),IXPERT,IYPERT,IZPERT,
     &            IXYPERT,IXZPERT,IYZPERT,ITRANSX,ITRANSY,
     &            ITRANSZ,NUCIND1
C
      IOFF=0
C
      DO 1000 IRREP=1,NIRREP
C
       N=NPERT(IRREP)
       IF(IXPERT.EQ.IRREP) N=N+1
       IF(IYPERT.EQ.IRREP) N=N+1
       IF(IZPERT.EQ.IRREP) N=N+1
C
       IF(IRREP.EQ.IXPERT) THEN
        IX=ITRANSX+IOFF
        DDP(1,IX)=0
        DDP(2,IX)=0
        DDP(3,IX)=0
        DO 100 INUC=1,NUCIND-1
         IX2=ITRANS(INUC,1)+IOFF
         DDP(1,IX)=DDP(1,IX)-DDP(1,IX2)
         DDP(2,IX)=DDP(2,IX)-DDP(2,IX2)
         DDP(3,IX)=DDP(3,IX)-DDP(3,IX2)
100     CONTINUE
       ENDIF
C
       IF(IRREP.EQ.IYPERT) THEN
        IY=ITRANSY+IOFF
        DDP(1,IY)=0
        DDP(2,IY)=0
        DDP(3,IY)=0
        DO 200 INUC=1,NUCIND-1
         IY2=ITRANS(INUC,2)+IOFF
         DDP(1,IY)=DDP(1,IY)-DDP(1,IY2)
         DDP(2,IY)=DDP(2,IY)-DDP(2,IY2)
         DDP(3,IY)=DDP(3,IY)-DDP(3,IY2)
200     CONTINUE
       ENDIF
C
       IF(IRREP.EQ.IZPERT) THEN
        IZ=ITRANSZ+IOFF
        DDP(1,IZ)=0
        DDP(2,IZ)=0
        DDP(3,IZ)=0
        DO 300 INUC=1,NUCIND-1
         IZ2=ITRANS(INUC,3)+IOFF
         DDP(1,IZ)=DDP(1,IZ)-DDP(1,IZ2)
         DDP(2,IZ)=DDP(2,IZ)-DDP(2,IZ2)
         DDP(3,IZ)=DDP(3,IZ)-DDP(3,IZ2)
300     CONTINUE
       ENDIF
C
       IOFF=IOFF+N
C
1000  CONTINUE
C
      RETURN
      END
