      SUBROUTINE UPDDP(DDP,DDP2,SCR1,NCOORD,NIRREP,UPDATE)
C
CEND
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      LOGICAL UPDATE
C
      DIMENSION DDP(3,NCOORD),DDP2(3,NCOORD),SCR1(1)
C
      COMMON/MACHSP/IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
C
      DATA AZERO,ONE/0.D0,1.D0/
C
      IF(NIRREP.NE.1) THEN
C
       CALL ZERO(DDP2,NCOORD*3)
       CALL TRADIP(DDP,DDP2,SCR1,NCOORD)
c YAU : old
c      CALL ICOPY(IINTFP*3*NCOORD,DDP2,1,DDP,1)
c YAU : new
       CALL DCOPY(3*NCOORD,DDP2,1,DDP,1)
c YAU : end
C
      ENDIF
C
      IF(UPDATE) THEN
       OPEN(UNIT=82,FILE='DIPDER',STATUS='OLD',FORM='FORMATTED')
       DO 2000 IFIELD=1,3
        READ(82,3000) IJUNK
        DO 2000 IATOM=1,NCOORD/3
         READ(82,3001) AZERO,DDP2(IFIELD,3*IATOM-2),
     &                 DDP2(IFIELD,3*IATOM-1),DDP2(IFIELD,3*IATOM)
2000   CONTINUE
C
3000   FORMAT(I5)
3001   FORMAT(4F20.10)
C
       CALL SAXPY(NCOORD*3,ONE,DDP2,1,DDP,1)
C
      ELSE
C
       OPEN(UNIT=82,FILE='DIPDER',STATUS='UNKNOWN',FORM='FORMATTED')
C
      ENDIF
C
      REWIND(82)
C
      DO 2100 IFIELD=1,3
       WRITE(82,3000) IFIELD
       DO 2100 IATOM=1,NCOORD/3
        WRITE(82,3001) SCR1(IATOM),DDP(IFIELD,3*IATOM-2),
     &                 DDP(IFIELD,3*IATOM-1),DDP(IFIELD,3*IATOM)
2100  CONTINUE
C
      CLOSE(UNIT=82,STATUS='KEEP')
C
      RETURN
      END
