PROGRAM EA
      IMPLICIT INTEGER*4 (I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      PARAMETER (MX=550)
      DIMENSION FF(3*MX,3*MX)
      CHARACTER*40 FILENAME
      WRITE(6,3000)
3000  FORMAT(/,
     1       ' Removes selected atom from the force field',/,/,
     3       '           By Petr Bour, Calgary  1995',/,/)
      WRITE(*,*)' How many atoms in the molecule ?'
      READ(*,*)NAT
      N=3*NAT
      WRITE(*,*)' Full filename with the force field:'
      READ(*,'(A)')FILENAME
      OPEN(2,FILE=FILENAME,STATUS='OLD')
      CALL READFF(MX,NAT,FF)
      CLOSE(2)
      WRITE(*,*)' How many atoms to discard ?'
      READ(*,*)NAD
      DO 1 IR=1,NAD
      WRITE(*,*)' Number of atom ',IR,' :'
      READ(*,*)IA
      DO 1 I=3*(IA-1)+1,3*(IA-1)+3
      DO 1 J=1,N
      FF(I,J)=0.0 
      FF(J,I)=0.0 
1     CONTINUE
      OPEN(2,FILE='FILE.FC')
      CALL WRITEFF(MX,NAT,FF)
      CLOSE(2)
      WRITE(6,*)' File FILE.FC written '
      STOP
      END

      SUBROUTINE READFF(N0,NA,FCAR)
      IMPLICIT INTEGER*4 (I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION FCAR(3*N0,3*N0)
      NAT3=3*NA
      N=NAT3
C     Read in the lower triangle of FF,
C     written in parts as      n1,n1
C                               .      .
C                              ln,n1   .     ln,ln
C                               .      .      .
C                               .      .      .        n3,n3
C                               .      .      .         .
C                               n,n1   .      .         n,n3
      N1=1
1     N3=N1+4
      IF(N3.GT.N)N3=N
      DO 130 LN=N1,N
130   READ(2,17)(FCAR(LN,J),J=N1,MIN(LN,N3))
      N1=N1+5
      IF(N3.LT.N)GOTO 1
17    FORMAT(4X,5D14.6)
C
      DO 31 I=1,N
      DO 31 J=I,N
   31 FCAR(I,J)=FCAR(J,I)
      RETURN
      END

      SUBROUTINE WRITEFF(MX,NA,FCAR)
      IMPLICIT INTEGER*4 (I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION FCAR(3*MX,3*MX)
      N=NA*3
      N1=1
1     N3=N1+4
      IF(N3.GT.N)N3=N
      DO 130 LN=N1,N
130   WRITE(2,17)LN,(FCAR(LN,J),J=N1,MIN(LN,N3))
      N1=N1+5
      IF(N3.LT.N)GOTO 1
17    FORMAT(I4,5D14.6)
      RETURN
      END