PROGRAM EATEN
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (N0=900)
      REAL*8 PP(N0,3,3),JJ(N0,3,3),PV(N0,3,3),I0(N0,3,3)
c
      WRITE(*,*)' ZERO-OUT ATOM CONTRIBUTIONS IN FILE.TEN'
      OPEN(15,FILE='FILE.TEN',STATUS='OLD')
      READ (15,*)NOAT
      DO 10 L=1,NOAT
      DO 10 J=1,3
10    READ (15,*) (PP(L,J,I),I=1,3)
      DO 220 L=1,NOAT
      DO 220 J=1,3
 220  READ (15,*) (I0(L,J,I),I=1,3)
      DO 230 L=1,NOAT
      DO 230 J=1,3
230   READ (15,*) (JJ(L,J,I),I=1,3)
      DO 100 L=1,NOAT
      DO 100 J=1,3
100   READ (15,*) (PV(L,J,I),I=1,3)
      CLOSE(15)
      WRITE(*,*)' Dipole derivatives read in,',NOAT,' atoms.'
      WRITE(*,*)
999   write(6,*)'Atom to zero-out (negative to end):'
      read(5,*)L
      if(L.gt.0)then
       DO 140 i=1,3
       DO 140 j=1,3
       I0 (L,i,j) = 0.0d0
       JJ (L,i,j) = 0.0d0
       PV (L,i,j) = 0.0d0
140    PP (L,i,j) = 0.0d0
       goto 999
      endif
      CALL WRITETEN(N0,PP,I0,JJ,PV,NOAT)
      stop
      end
        
      SUBROUTINE WRITETEN(N0,P,A,AJ,PV,NAT)
      IMPLICIT INTEGER*4 (I-N) 
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION P(N0,3,3),A(N0,3,3),PV(N0,3,3),AJ(N0,3,3)
      OPEN(15,FILE='FILE.TEN')
      WRITE(15,1500) NAT,NAT-6,0
1500  FORMAT(3I5)
      DO 10 L=1,NAT
      DO 10 J=1,3
10    WRITE(15,1501) (P(L,J,I),I=1,3),L
1501  FORMAT(3F14.8,I5)
      DO 221 L=1,NAT                                                 
      DO 221 J=1,3                                                    
221   WRITE(15,1501) (A(L,J,I),I=1,3),L
      DO 230 L=1,NAT                                                 
      DO 230 J=1,3                                                    
230   WRITE(15,1501) (AJ(L,J,I),I=1,3),L
      DO 100 L=1,NAT
      DO 100 J=1,3
100   WRITE(15,1501) (PV(L,J,I),I=1,3),L
      WRITE(*,*)' Dipole derivatives written into FILE.TEN'
      CLOSE(15)
      RETURN
      END
C