      SUBROUTINE EDITOR
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, 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
      COMMON /SYMTRY/ ISYM(10,NUMATM)
      COMMON / PATH / ICPATH, NPATH, PATH( 30)
      CHARACTER*1 NULL, SEPRAT
      CHARACTER*6 ATSYMB
      COMMON /ATSYMB/ ATSYMB( 200)
      CHARACTER*80 STRREP, STRNEW, STRWRK, COMAND, DUMMY, UPCASE
      CHARACTER*80 KEYWRD,KOMENT,TITLE
      COMMON /KEYS/ KEYWRD,KOMENT,TITLE
      COMMON /COMM/ COMAND
      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
      DIMENSION IVAL( NUMATM)
*
*  THIS FUNCTIONS IS USED INTERNALLY 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 )
**
**
C
* WE NEED TO FINE THE VALUE OF THE SYMBOL 'DD'
*
      INTDD = 0
      DO 1 I = 1, 200
         IF ( ATSYMB( I) .EQ. 'DD' ) THEN
            INTDD = I
         ENDIF
 1    CONTINUE
      IF ( INTDD .EQ. 0 )
     .       CALL DEBUGR( 'In EDIT, error finding symbol DD.')
      IF ( NATOMS .LT. 0 ) NATOMS = 0
      LINALL=.TRUE.
      AMODE=.FALSE.
      INTRNL = .TRUE.
      NULL=CHAR(0)
      LCLDBG=DEBUG
* FIRST, IF THERE ARE ANY ATOMS, WE FIGURE OUT IF ANY ALREADY EXCEED
*        THE RECCOMMENDED VALENCY.  WE DO THIS SO AS NOT TO AGGRAVATE
*        THE HAPLESS USER LATER IF S/HE DOES ANY REAL EDITING.
      IF ( NATOMS .GT. 0) THEN
         CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
         DO 3 J=1,NATOMS
            IF ( IE( J) .GE. 99 ) GOTO 3
            IVAL(J)=0
            NBOND=0
            SSEP1=VANRAD(IE(J))
            DO 2 I=1,NATOMS
               IF ( IE( I) .GE. 99 ) GOTO 2
               IF ( I .EQ. J) GO TO 2
               DIST=ATDIST(J,I)
               SSEP=(SSEP1+VANRAD(IE(I)))*BSCALE
               IF ( DIST .LE. SSEP) NBOND=NBOND+1
               IF ( NBOND .GT. MAXVAL(IE(J))) IVAL(J)=NBOND
 2          CONTINUE
 3       CONTINUE
      ENDIF
      OLTYPE = ISTYPE
      ISTYPE = 1
      IF ( OLTYPE .NE. ISTYPE ) THEN
         CALL PLOT(0,0,8)
         CALL UPROMP
     .       ('Draw:EDIT:  I must re-draw the display before editing.')
         CALL UPROMP
     .       ('            Shall I continue? (Yes/no) ')
         READ (5, '(A)', END=10) COMAND
         CALL LCLEAN( COMAND, COMAND, .TRUE.)
         IF ( COMAND(1:1) .NE. ' ' .AND. COMAND(1:1) .NE. 'Y') RETURN
         CALL SETLAB
         CALL PICTUR
         REDRAW = .FALSE.
      ENDIF
 10   CONTINUE
C?      CALL PLOT(0,0,8)
      CALL UPROMP( ' Draw:EDIT> ')
      READ ( *, '( A )', END=10 ) COMAND
      CALL LCLEAN(COMAND,COMAND, .TRUE.)
      IF (COMAND(:1) .EQ. 'H' .OR. COMAND(:1) .EQ. '?') THEN
          AMODE=.FALSE.
          COMAND = 'DRAW EDIT'
          CALL HELP ( COMAND )
      ELSEIF (COMAND(:2) .EQ. 'PI' .OR. COMAND(1:2) .EQ. 'RE') THEN
          CALL SETLAB
          CALL PICTUR
          REDRAW = .FALSE.
      ELSEIF (COMAND(:1) .EQ. 'U' ) THEN
* UPDATE PICTURE
          CALL SETLAB
          CALL PICTUR
          REDRAW = .FALSE.
      ELSEIF( COMAND(1:1) .EQ. 'S' ) THEN
* EDITING SYMMETRY
      IF ( ISYM(1,1) .GT. 0 ) THEN
         DO 45 J= 1, NUMATM
            IF ( ISYM( 1,J) .LE. 0 ) GOTO 46
            DO 40 I= 10, 1, -1
               IF ( ISYM(I, J) .NE. 0 ) GOTO 42
  40        CONTINUE
            I = 1
  42        WRITE ( DUMMY, '(20(I4,'','') )') (ISYM(K,J),K=1,I)
  45     CONTINUE
  46     WRITE ( *, '(A)') DUMMY
      ENDIF
        CALL DEBUGR( 'SORRY, I can''t handle symmetry editing yet.')
      ELSEIF ( COMAND(1:2) .EQ. 'PA' ) THEN
* EDITING REACTION PATH VALUES
        IF ( NPATH .GT. 0) THEN
          II = 1
          DO 80 I= 1, NPATH
            WRITE ( DUMMY( II: ), '( F7.2, '','')') PATH( I)
            CALL LCLEAN( DUMMY, DUMMY, .FALSE.)
            II = LLENG( DUMMY )
  80      CONTINUE
          WRITE (*, '(A)') DUMMY( 1: II)
          CALL DEBUGR( 'SORRY, I can''t handle path editing yet.')
        ELSE
          CALL DEBUGR( 'This file does NOT have PATH information.')
        ENDIF
      ELSEIF ( COMAND(1:1) .EQ. 'E' ) THEN
        COMAND = COMAND( 2: )
        CALL LCLEAN( COMAND, COMAND, .TRUE.)
        IF (COMAND(1:1) .EQ. ' ') THEN
          CALL UPROMP(' Which line of text (1,2,3) [1] ? ')
          READ (*, '(A)', END=10) COMAND
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          IF ( COMAND(1:1) .EQ. ' ') COMAND = '1'
        ENDIF
        IF ( COMAND(1:1) .EQ. '1' .OR. COMAND(1:1) .EQ. 'K') THEN
          ITEMP = 1
          STRWRK = KEYWRD
        ELSEIF ( COMAND(1:1) .EQ. '2' .OR. COMAND(1:1) .EQ. 'C') THEN
          ITEMP = 2
          STRWRK = KOMENT
        ELSEIF ( COMAND(1:1) .EQ. '3' .OR. COMAND(1:1) .EQ. 'T') THEN
          ITEMP = 3
          STRWRK = TITLE
        ELSE
          CALL DEBUGR( 'I can only handle the three TEXT lines')
          COMAND = ' '
          GOTO 10
        ENDIF
        WRITE (*, *) STRWRK(1:79)
        CALL UPROMP( 'Your request (Sub, Replace) ? ')
        READ (*, '(A)', END=10) COMAND
        IF ( COMAND(1:1) .EQ. '?' ) THEN
          COMAND = 'DRAW EDIT EDIT'
          CALL HELP( COMAND )
          COMAND = ' '
          GOTO 10
        ELSEIF ( COMAND(1:1).EQ.'S' .OR. COMAND(1:1).EQ.'s') THEN
          IS1 = 2
  30      CONTINUE
          SEPRAT = COMAND(IS1:IS1)
          IF ( SEPRAT .EQ. ' ' ) THEN
            IS1 = IS1 + 1
            IF(IS1.LT.5) GOTO 30
            CALL DEBUGR('Improper format, no space after S.')
            GOTO 10
          ENDIF
          STRREP = COMAND( IS1+1: )
          IS1 = INDEX( STRREP, SEPRAT)
          IF ( IS1 .EQ. 0 ) THEN
            WRITE (*,*) 'Improper format, I could not find',
     .                      ' the second delimiter '//SEPRAT
            GOTO 10
          ENDIF
          STRNEW = STRREP( IS1+1: )
          IS1 = IS1 - 1
          STRREP = STRREP( 1: IS1 )
          IS2 = INDEX( STRWRK, STRREP(1:IS1) )
          IF ( IS2 .EQ. 0 ) THEN
            DUMMY = UPCASE( STRREP)
            STRREP = DUMMY
            IS2 = INDEX( STRWRK, STRREP(1:IS1) )
            IF ( IS2 .EQ. 0 ) THEN
              WRITE (*,*) 'Sorry, i can''t find the string to '//
     .                      'change:'//STRREP(1:IS1)
              GOTO 10
            ENDIF
          ENDIF
          IS3 = INDEX( STRNEW, SEPRAT)
          IF ( IS3 .EQ. 0 ) THEN
            IS3 = LLENG( STRNEW)+1
          ENDIF
          IS3 = IS3 - 1
          IF ( IS3 .GT. 0 ) THEN
            STRNEW = STRNEW( 1: IS3)
            WRITE (*,*) 'READY TO REPLACE '//STRREP(1:IS1)//
     .           ' WITH '//STRNEW(1:IS3)
            IF ( IS2 .GT. 1 ) THEN
              STRWRK = STRWRK( 1: IS2-1)//
     .                STRNEW(1:IS3)//STRWRK( IS2+IS1: )
            ELSE
              STRWRK = STRNEW(1:IS3)//STRWRK( IS2+IS1: )
            ENDIF
          ELSE
            WRITE (*,*) 'REMOVING '//STRREP(1:IS1)
            STRWRK = STRWRK( 1: IS2-1)//STRWRK( IS2+IS1: )
          ENDIF
         ELSEIF ( COMAND(1:1).EQ.'R' .OR. COMAND(1:1).EQ.'r') THEN
             CALL DEBUGR('Ok, enter REPLACEMENT line below this one.')
             READ (*, '(A)', END=10 ) COMAND
             STRWRK = COMAND
             COMAND = ' '
          ELSEIF ( COMAND(1:1) .NE. ' ') THEN
             COMAND = ' '
             CALL DEBUGR('I only understand two actions: R and S')
             GOTO 10
          ENDIF
          CALL DEBUGR( STRWRK(1:79) )
          IF ( ITEMP .EQ. 1) KEYWRD = STRWRK
          IF ( ITEMP .EQ. 2) KOMENT = STRWRK
          IF ( ITEMP .EQ. 3) TITLE  = STRWRK
          MODATA = .TRUE.
      ELSEIF ( COMAND(1:2) .EQ. 'PL' ) THEN
* TO PLACE AN ATOM (COORDINATES WILL BE COMPUTED)
          CALL UPROMP ('What atom type ?')
          READ (*,'(A)') COMAND
          CALL LCLEAN( COMAND, COMAND, .TRUE. )
          ITEMP = NUMELE( COMAND(1: LLENG( COMAND) ) )
          CALL UPROMP( 'Is the new atom BETWEEN or PERPENDICULAR? ')
          READ (*,'(A)') COMAND
          CALL LCLEAN( COMAND, COMAND, .TRUE. )
          IF ( COMAND(1:1) .EQ. 'B' ) THEN
             CALL UPROMP( 'What atom(s) bracket this new one ? ')
             READ (*,'(A)') COMAND
             CALL LCLEAN( COMAND, COMAND, .TRUE. )
             IAVG = 0
             XNEW = 0.0D0
             YNEW = 0.0D0
             ZNEW = 0.0D0
 5000        ITEMP1 = READA( COMAND, 1, ERROR )
             IF ( .NOT.ERROR .AND. ITEMP1.GT.1 .AND. 
     .                          ITEMP1.LT.NATOMS ) THEN
                XNEW = XNEW + CO( 1, ITEMP1)
                YNEW = YNEW + CO( 2, ITEMP1)
                ZNEW = ZNEW + CO( 3, ITEMP1)
                IAVG = IAVG + 1
                COMAND = COMAND( INDEX( COMAND, ' '): )
                CALL LCLEAN( COMAND, COMAND, .TRUE.)
                GOTO 5000
             ENDIF
             WRITE (*,*) 'IAVG=',IAVG
          ELSEIF( COMAND(1:1) .EQ. 'P') THEN
* PERPENDICULAR TO THE PLANE
*  FIRST THE EQUATION OF THE PLANE:  A X  + B Y  + C Z  + D = 0
             CALL UPROMP( 'Enter three atoms to define it: ')
             READ (*,'(A)') COMAND
             CALL LCLEAN( COMAND, COMAND, .TRUE. )
             I1 = READA( COMAND, 1, ERROR)
             COMAND = COMAND( INDEX( COMAND, ' '): )
             CALL LCLEAN( COMAND, COMAND, .TRUE.)
             I2 = READA( COMAND, 1, ERROR)
             COMAND = COMAND( INDEX( COMAND, ' '): )
             CALL LCLEAN( COMAND, COMAND, .TRUE.)
             I3 = READA( COMAND, 1, ERROR)
             DET1 = ( CO(2,I2)- CO(2,I1) ) * ( CO(3,I3)- CO(3,I1)) -
     .              ( CO(3,I2)- CO(3,I1) ) * ( CO(2,I3)- CO(2,I1))

             DET2 = ( CO(3,I2)- CO(3,I1) ) * ( CO(1,I3)- CO(1,I1)) -
     .              ( CO(1,I2)- CO(1,I1) ) * ( CO(3,I3)- CO(3,I1))

             DET3 = ( CO(1,I2)- CO(1,I1) ) * ( CO(2,I3)- CO(2,I1)) -
     .              ( CO(2,I2)- CO(2,I1) ) * ( CO(1,I3)- CO(1,I1))

             PLANEA = DET1
             PLANEB = DET2
             PLANEC = DET3
             PLANED = -DET1*CO(1,I1) - DET2*CO(2,I1) - DET3*CO(3,I1)

             WRITE (*,'('' EQUATION OF PLANE: '',F9.3,''X  '',
     .           F9.3,''Y  '',F9.3,''Z  '',F9.3)')
     .           PLANEA, PLANEB, PLANEC, PLANED
* NOW FOR THE POINT AT THE PROPER DISTANCE
*  FIRST THE Y-COORDINATE (BECAUSE I CHOOSE IT FIRST)
             DIST = 2.0
             YNEW = DIST * SQRT( PLANEA*PLANEA + PLANEB*PLANEB +
     .              PLANEC*PLANEC)
             YNEW = YNEW + (PLANEA*PLANEA+PLANEC*PLANEC)*CO(2,I2)/PLANEB
     .                   - PLANEA*CO(1,I2)
     .                   - PLANEC*CO(3,I2)
             YNEW = YNEW*PLANEB / 
     .                   ( PLANEA*PLANEA+PLANEB*PLANEB+PLANEC*PLANEC)
             XNEW = PLANEA*(YNEW-CO(2,I2))/PLANEB + CO(1,I2)
             ZNEW = PLANEC*(YNEW-CO(2,I2))/PLANEB + CO(3,I2)
             IAVG = 1
          ELSE
             CALL DEBUGR('NOT A VALID CHOICE')
          ENDIF
          IF ( IAVG .GT. 0 ) THEN
             CALL UPROMP( 'What connectivity (ie, NA, NB, NC)  ')
             READ (*,'(A)') COMAND
             CALL LCLEAN( COMAND, COMAND, .TRUE. )
             NA( NATOMS+1) = READA( COMAND, 1, ERROR)
             COMAND = COMAND( INDEX( COMAND, ' '): )
             CALL LCLEAN( COMAND, COMAND, .TRUE.)
             NB( NATOMS+1) = READA( COMAND, 1, ERROR)
             COMAND = COMAND( INDEX( COMAND, ' '): )
             CALL LCLEAN( COMAND, COMAND, .TRUE.)
             NC( NATOMS+1) = READA( COMAND, 1, ERROR)
             NATOMS = NATOMS + 1
             CO( 1, NATOMS) = XNEW/IAVG
             CO( 2, NATOMS) = YNEW/IAVG
             CO( 3, NATOMS) = ZNEW/IAVG
             IE( NATOMS) = ITEMP
             CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
             CALL TOTROT(TEMPXX,TEMPYY,TEMPZZ)
             CALL SETLAB
             CALL LDRAW( NATOMS)
          ELSE
             CALL DEBUGR('NO UPDATE.')
          ENDIF
      ELSEIF (COMAND(:2) .EQ. 'IN') THEN
          CALL POPARG( COMAND, COMAND)
          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)
          CALL INFO
      ELSEIF (COMAND(:5) .EQ. 'DEBUG') THEN
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          IF (DEBUG ) THEN
             DEBUG=.FALSE.
             CALL DEBUGR( 'Debug off.' )
          ELSE
             DEBUG=.TRUE.
             CALL DEBUGR( 'Debug on.' )
          ENDIF
      ELSEIF (COMAND(:1) .EQ. 'F' ) THEN
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          CALL DEBUGR('USE SPECIFIC FILE NAMES FOR OUTPUT & PLOT.')
      ELSEIF (COMAND(:1) .EQ. 'Q') THEN
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          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)
*  FIRST WE CHECK FOR ANY EDITED OUT (TYPE=DD) ATOMS
          K = 0
          LASTAT = 1
 90       DO 92 I= LASTAT, NATOMS-K
             IF ( ATSYMB(IE(I)) .EQ. 'DD') THEN
               LASTAT = I
               DO 95 II = I+1, NATOMS
                  CO( 1, II-1) = CO( 1, II)
                  CO( 2, II-1) = CO( 2, II)
                  CO( 3, II-1) = CO( 3, II)
                  IE( II-1 ) = IE( II )
                  INTFRE( 1, II-1) = INTFRE( 1, II)
                  INTFRE( 2, II-1) = INTFRE( 2, II)
                  INTFRE( 3, II-1) = INTFRE( 3, II)
                  IF ( NA(II) .GE. I) THEN
                     NA( II-1 ) = NA(II)-1
                  ELSE 
                     NA( II-1 ) = NA( II )
                  ENDIF
                  IF ( NB(II) .GE. I) THEN
                     NB( II-1 ) = NB(II) - 1
                  ELSE
                     NB( II-1 ) = NB( II)
                  ENDIF
                  IF ( NC(II) .GE. I) THEN
                     NC( II-1 ) = NC(II) - 1
                  ELSE
                     NC( II-1) = NC( II)
                  ENDIF
 95            CONTINUE
               K = K + 1
               GOTO 90
             ENDIF
 92       CONTINUE
          IF ( K .GT. 0 ) THEN
             WRITE ( DUMMY, '(''I have removed'',I3,'' atoms.'')') K
             CALL LCLEAN( DUMMY, DUMMY, .TRUE.)
             CALL DEBUGR( DUMMY(1: 25) )
             NATOMS = NATOMS - K
             TEMPXX=CO(1,1)
             TEMPYY=CO(2,1)
             TEMPZZ=CO(3,1)
             CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
             CALL TOTROT(TEMPXX,TEMPYY,TEMPZZ)
             CALL SETLAB
          ENDIF
          ISTYPE = OLTYPE
          DEBUG=LCLDBG
          LINALL=.FALSE.
          RETURN
      ELSEIF ((COMAND(:1).GE.'0'.AND.COMAND(:1).LE.'9') .OR.
     .          (AMODE.AND.COMAND(:1).EQ.' ') ) THEN
          EDMADE=.FALSE.
          IA = READA(COMAND,1,ERROR)
          IF (AMODE.AND.ERROR) THEN
             IA=IAOLD+1
          ENDIF
          IF (IA .GT. NATOMS ) THEN
             WRITE (*,*) 'Reference number too big',NATOMS,'is max.'
             AMODE=.FALSE.
             GO TO 10
          ELSE
             AMODE=.TRUE.
             IAOLD=IA
             CALL EDITCH( INTRNL )
          ENDIF
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
      ELSEIF ( COMAND( 1: 2) .EQ. 'M ' ) THEN
          CALL DEBUGR('AMBIGUOUS REQUEST, USE MORE CHARACTERS.')
          COMAND = ' '
          GOTO 10
      ELSEIF ( COMAND( 1: 2) .EQ. 'ME' .OR.
     .          COMAND( 1: 2) .EQ. 'MR' ) THEN
          CALL EDITMR( INTRNL )
          COMAND = ' '
          GOTO 10
      ELSEIF ( COMAND( 1: 2) .EQ. 'MO') THEN
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          IF ( COMAND( :1) .EQ. ' ') THEN
             IF ( INTRNL ) THEN
                CALL DEBUGR('CURRENT MODE: INTERNAL.')
             ELSE
                CALL DEBUGR('CURRENT MODE: CARTESIAN.')
             ENDIF
             CALL UPROMP( 'Draw: Edit: MODE> Internal or Cartesian ? ')
             READ ( *, '( A )' ) COMAND
             CALL LCLEAN( COMAND, COMAND, .TRUE.)
          ENDIF
          IF ( COMAND( :1) .EQ. 'I') THEN
             INTRNL = .TRUE.
             CALL DEBUGR('MODE INTERNAL.')
          ELSEIF ( COMAND( :1) .EQ. 'C') THEN
             INTRNL = .FALSE.
             CALL DEBUGR('MODE CARTESIAN.')
          ELSEIF ( COMAND( :1) .NE. ' ') THEN
             CALL DEBUGR('ALLOWED RESPONSES: INTERNAL or CARTESAIN.')
          ENDIF
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
      ELSEIF (COMAND(:1) .EQ. '-') THEN
          AMODE=.FALSE.
          COMAND = COMAND(2:)
          IF ( COMAND(1:1) .EQ. ' ') THEN
             IIATOM = NATOMS
          ELSE
             IIATOM = READA( COMAND, 1, ERROR)
             IF (ERROR) THEN
                CALL DEBUGR('INPUT ERROR')
                COMAND = ' '
                GOTO 10
             ENDIF
          ENDIF
          IF (IIATOM .GT. NATOMS .OR. IIATOM .LT. 1 ) THEN
            WRITE ( COMAND, '( ''Invalid number: '', I4)' ) IIATOM
            CALL DEBUGR( COMAND(:20) )
          ELSE
            IF ( IIATOM .EQ. NATOMS ) THEN
               CALL LDRAW( -IIATOM )
  56           NATOMS=NATOMS-1
               IF ( IE( NATOMS) .EQ. INTDD) GOTO 56
               CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
            ELSE
* WE SEARCH FOR ANY ATOMS WHICH DIRECTLY REFER TO ATOM "IIATOM"
               DO 58 I = IIATOM+1, NATOMS
                  IF( NA(I) .EQ. IIATOM .OR. NB(I) .EQ. IIATOM
     .                .OR. NC(I) .EQ. IIATOM) THEN
                     WRITE (COMAND,'('' ATOM '',I4,
     .                   '' is referenced to atom '',I4,
     .                   ''.  Uncouple them to proceed.'')')
     .                   IIATOM, I
                     CALL DEBUGR( COMAND(:70) )
                     COMAND = ' '
                     GOTO 10
                  ENDIF
  58           CONTINUE
               CALL LDRAW(-IIATOM)
               IE(IIATOM) = INTDD
             ENDIF
             WRITE ( COMAND, '( ''Atom '', I4,'' removed.'')' ) 
     .                               IIATOM
             CALL DEBUGR( COMAND( :18) )
             REDRAW = .TRUE.
             MODATA = .TRUE.
          ENDIF
          CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. '+' ) THEN
          AMODE=.FALSE.
          COMAND = COMAND( 2: )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          IF ( COMAND(1:1) .EQ. ' ') THEN
             CALL EDITAD( INTRNL )
          ELSE
             CALL EDITIN( INTRNL )
          ENDIF
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
      ELSEIF (COMAND(:2) .EQ. 'DU' ) THEN
* add dummy atom between two existing atoms
          AMODE=.FALSE.
          COMAND=COMAND(INDEX(COMAND,' ')+1:)
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          IF (COMAND(:1) .EQ. ' ') THEN
             CALL UPROMP( 'Dummy atom between which two atoms ?')
             READ (*, '( A )' ) COMAND
             CALL LCLEAN (COMAND, COMAND, .TRUE.)
          ENDIF
          IPT1 = READA (COMAND, 1, ERROR)
          IF (ERROR) THEN
             CALL DEBUGR('Error in first atom number.')
             GO TO 10
          ENDIF
          IF (IPT1 .LE. 0 .OR. IPT1 .GT. NATOMS) THEN
             CALL DEBUGR('First atom number out of range.')
             GO TO 10
          ENDIF
          IS = INDEX (COMAND,' ')
          DO 60 ISS= IS, 80
             IF (COMAND(ISS:ISS) .NE. ' ') GO TO 65
 60       CONTINUE
          CALL DEBUGR('Second atom number not found.')
          GO TO 10
 65       IPT2 = READA (COMAND,ISS,ERROR)
          IF (ERROR) THEN
             CALL DEBUGR('Error in second atom number.')
             GO TO 10
          ENDIF
          IF (IPT2 .LE. 0 .OR. IPT2 .GT. NATOMS) THEN
             CALL DEBUGR('Second atom number out of range.')
             GO TO 10
          ENDIF
          IF (IPT1.EQ.IPT2) THEN
             CALL DEBUGR('The two atoms must be different.')
             GOTO 10
          ENDIF
          IF ( IPT1 .GT. IPT2) THEN
             ISS = IPT2
             IPT2 = IPT1
             IPT1 = ISS
          ENDIF
c          IF ( NA(IPT2) .NE. IPT1) THEN
c             WRITE (*,1060) IPT1,IPT2
c1060         FORMAT ( 1X, 'Atoms ',I3,' and ',I3,' are not',
c     .                  ' connected.')
c             GO TO 10
c          ENDIF
          DO 66 I=NATOMS+1,IPT2,-1
             IE(I+1) = IE(I)
             CO(1,I+1) = CO(1,I)
             INTFRE(1,I+1) = INTFRE(1,I)
             CO(2,I+1) = CO(2,I)
             INTFRE(2,I+1) = INTFRE(2,I)
             CO(3,I+1) = CO(3,I)
             INTFRE(3,I+1) = INTFRE(3,I)
             IF (NA(I) .GE. IPT2) THEN
               NA(I+1)=NA(I)+1
             ELSE
               NA(I+1) = NA(I)
             ENDIF
             IF (NB(I) .GE. IPT2) THEN
               NB(I+1)=NB(I)+1
             ELSE
               NB(I+1) = NB(I)
             ENDIF
             IF (NC(I) .GE. IPT2) THEN
               NC(I+1)=NC(I)+1
             ELSE
               NC(I+1) = NC(I)
             ENDIF
 66       CONTINUE
          IE(IPT2) = 99
          CO(1,IPT2) = (CO(1,IPT1) + CO(1,IPT2+1))/2
          CO(2,IPT2) = (CO(2,IPT1) + CO(2,IPT2+1))/2
          CO(3,IPT2) = (CO(3,IPT1) + CO(3,IPT2+1))/2
          NA(IPT2)=NA(IPT2+1)
          NB(IPT2)=NB(IPT2+1)
          NC(IPT2)=NC(IPT2+1)
          IF ( IPT2 .LT. 4 ) THEN
              IF ( IPT2 .LT. 3) THEN
                 NB( IPT2+1) = 2
              ELSE
                 NC( IPT2+1) = 3
              ENDIF
          ENDIF
          NATOMS = NATOMS + 1
          CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
          CALL SETLAB
          REDRAW = .TRUE.
          MODATA = .TRUE.
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
      ELSE
          COMAND = COMAND( INDEX( COMAND, ' '): )
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          CALL DEBUGR('SORRY, NOT DONE YET.')
      ENDIF
      GO TO 10
      END
