      SUBROUTINE EDITAD( INTRNL )
C
C         Notice of Public Domain nature of this Program
C
C      'This computer program is a work of the United States 
C       Government and as such is not subject to protection by 
C       copyright (17 U.S.C. # 105.)  Any person who fraudulently 
C       places a copyright notice or does any other act contrary 
C       to the provisions of 17 U.S. Code 506(c) shall be subject 
C       to the penalties provided therein.  This notice shall not 
C       be altered or removed from this software and is to be on 
C       all reproductions.'
C
      INCLUDE 'SIZES'
      IMPLICIT REAL (A-H,O-Z)
      REAL CART, DENMAT, BONDS, VANRAD
      INTEGER*2 ATBOND
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      LOGICAL ERROR,MODATA,INTRNL,LCLDBG,LINALL,AMODE,EDMADE, REDRAW
      COMMON /ATOMS/ CO(3, NUMATM),IE( NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /GEOM/ COOLD(3, NUMATM),NA( NUMATM),NB( NUMATM),NC( NUMATM)
      COMMON /INTCOR/ XNDOGM(3, NUMATM),INTFRE(3, NUMATM)
      COMMON /EDIT/ MODATA, REDRAW
      CHARACTER*6 ATSYMB, CHAR7*1
      COMMON /ATSYMB/ ATSYMB( 200)
      CHARACTER COMAND*80, ICCC*2
      COMMON /VALNCE/ MAXVAL(200)
      COMMON /VANRAD/ VANRAD(200)
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM),
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /LINES/ CART(2, NUMATM),LIST( NUMATM), LATOMS, LINALL
      COMMON /DENSTY/ DENMAT( MPACK ), BONDS( MPACK )
      DIMENSION IVAL( NUMATM)
*
*   LOGICAL INTRNL INDICATES MODE OF ADDING NEW ATOMS
*            .TRUE.   ==>   INTERNAL COORDINATES
*           .FALSE.   ==>   CARTESIAN COORDINATES
*
*  HERE IS AFUNCTION USED INTERNAL TO THIS ROUTINE
*
      ATDIST( I, J) = SQRT( (CO(1,I)-CO(1,J))**2 
     .   + (CO(2,I)-CO(2,J))**2 + (CO(3,I)-CO(3,J))**2 )
**
**                               
      CHAR7 = CHAR(7)
      ICCC = 'CC'
      IF ( INTRNL ) ICCC = 'IC'
 50   IIATOM=NATOMS+1
 51   CONTINUE
      CALL PLOT (0,0,8)
      WRITE( COMAND,'(A2,'' of atom '', I4,'':'')') ICCC, IIATOM
      CALL UPROMP( COMAND( 1: INDEX( COMAND, ':')) )
      READ ( *, '( A )', END=9000 ) COMAND
      CALL LCLEAN(COMAND, COMAND, .TRUE.)
      IF ( COMAND(:1) .EQ. 'Q') RETURN
      IF ( COMAND(:1) .EQ. ' ') RETURN
      CALL GETIC(COMAND,IT,B,IB,A,IA,D,ID,MA,MB,MC,ERROR)
      IF ( MA.GE.IIATOM .OR. (MA.LT.1 .AND. IIATOM.GT.1)) THEN
         ERROR=.TRUE.
         WRITE (*,*) CHAR7//'ERROR IN NA.'
      ENDIF
      IF ( MB.GE.IIATOM .OR. (MB.LT.1 .AND. IIATOM.GT.2)) THEN
         ERROR=.TRUE.
         WRITE (*,*) CHAR7//'ERROR IN NB.'
      ENDIF
      IF ( MC.GE.IIATOM .OR. (MC.LT.1 .AND. IIATOM.GT.3)) THEN
         ERROR=.TRUE.
         WRITE (*,*) CHAR7//'ERROR IN NC.'
      ENDIF
      IF ( MA.EQ.MB .AND. IIATOM.GT.1) THEN
         ERROR = .TRUE.
         WRITE (*,*) CHAR7//'ERROR - NA AND NB ARE EQUAL.'
      ENDIF
      IF ( MA.EQ.MC .AND. IIATOM.GT.1) THEN
         ERROR=.TRUE.
         WRITE (*,*) CHAR7//'ERROR - NA AND NC ARE EQUAL.'
      ENDIF
      IF ( MB.EQ.MC .AND. IIATOM.GT.2) THEN
         ERROR=.TRUE.
         WRITE (*,*) CHAR7//'ERROR - NB AND NC ARE EQUAL.'
      ENDIF
      IF (ERROR) THEN
          WRITE (*,*) CHAR7//'DATA ERROR.'
          IF ( IT .LT. 1 .OR. IT .GT. 200 ) THEN
             WRITE (*,1050) IIATOM, '??????',B,IB,A,IA,D,ID,MA,MB,MC
          ELSE
             WRITE (*,1050) IIATOM, ATSYMB(IT),B,IB,A,IA,D,ID,MA,MB,MC
          ENDIF
 1050     FORMAT ( 1X, I4, ':', A6, 1X, F12.4, 1X, I2, 1X, 
     .   2( F8.3, 1X, I2, 1X), 3(1X,I4))
          CALL DEBUGR('Please try again from the start',
     .                         ' of that last line.')
          ERROR=.FALSE.
          GO TO 51
       ENDIF
       NATOMS=NATOMS+1
       IE(NATOMS)=IT
          IF (NATOMS .EQ. 1) THEN
             INTFRE(1,NATOMS)=0
          ELSE
             INTFRE(1,NATOMS)=IB
          ENDIF
          IF (NATOMS .LE. 2) THEN
             INTFRE(2,NATOMS)=0
          ELSE
             INTFRE(2,NATOMS)=IA
          ENDIF
          IF (NATOMS .LE. 3) THEN
             INTFRE(3,NATOMS)=0
          ELSE
             INTFRE(3,NATOMS)=ID
          ENDIF
          NA(NATOMS)=MA
          NB(NATOMS)=MB
          NC(NATOMS)=MC
       IF ( INTRNL ) THEN
          XNDOGM(1,NATOMS)=B
          XNDOGM(2,NATOMS)=A
          XNDOGM(3,NATOMS)=D
          TEMPXX=CO(1,1)
          TEMPYY=CO(2,1)
          TEMPZZ=CO(3,1)
          CALL GMETRY(NUATOM,NATOMS,IE,XNDOGM,NA,NB,NC,CO,ERROR)
          CALL TOTROT(TEMPXX,TEMPYY,TEMPZZ)
       ELSE
          CO(1,NATOMS)=B
          CO(2,NATOMS)=A
          CO(3,NATOMS)=D
          CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
       ENDIF
       BONDS( 1 ) = 0
       CALL SETBON( .FALSE. )
       DO 54 J=1,NATOMS
          IF ( IE( J) .GE. 99 ) GOTO 54
          NBOND=0
          SSEP1=VANRAD(IE(J))
          DO 52 I=1,NATOMS
             IF ( IE( I) .GE. 99 ) GOTO 52
             IF ( I .EQ. J) GO TO 52
C?             DIST=ATDIST(J,I)
C?             SSEP=(SSEP1+VANRAD(IE(I)))*BSCALE
C?             IF ( DIST .LE. SSEP) NBOND=NBOND+1
             IF ( ATBOND( J, I) .GT. 0 ) NBOND = NBOND+1
  52      CONTINUE
          IF ( NBOND .GT. MAXVAL(IE(J)) .AND. NBOND .GT. IVAL(J) ) THEN
             IVAL(J)=NBOND
             WRITE (*,1007) CHAR7,J,NBOND
1007         FORMAT ( 1X,A,'ATOM ',I4,' has ',I2,' BONDS:' )
             COMAND = '     '
             IIT = 1
             DO 53 I=1,NATOMS
                IF ( IE( I) .GE. 99) GOTO 53
                IF ( I .EQ. J) GOTO 53
                DIST=ATDIST(J,I)
C?                SSEP=(SSEP1+VANRAD(IE(I)))*BSCALE
C?                IF (DIST .LE. SSEP) THEN
                IF ( ATBOND( J, I) .GT. 0 ) THEN
                   WRITE (COMAND(IIT:),1006) I,DIST
 1006              FORMAT ( ' To: ',I3,' by ',F6.4,'; ' )
                   IIT = INDEX( COMAND(IIT:), ';') + IIT
                   IF ( IIT .GE. 60) THEN
                      WRITE (*,*) COMAND(:IIT)
                      IIT = 1
                   ENDIF
                ENDIF
  53         CONTINUE
             IF ( IIT .GT. 1) WRITE (*,*) COMAND(:IIT)
          ENDIF
  54      CONTINUE
          IF ( NATOMS .GT. 3) THEN
             CALL SETLAB
             CALL LDRAW(NATOMS)
          ELSE
             CALL SETLAB
             CALL PICTUR
          ENDIF
          REDRAW = .TRUE.
          MODATA=.TRUE.
          GO TO 50
 9000 CONTINUE
      CONTINUE
      END
