      SUBROUTINE SETBON( USER )
      INCLUDE 'SIZES'
      IMPLICIT REAL (A-H,O-Z)
      INTEGER*2 ATBOND
      CHARACTER*80 TITLE,COMAND
      CHARACTER*6 ATSYMB
      INTEGER TBONDS
      REAL DENMAT, BONDS, VANRAD
      DIMENSION EVEC( 3, 3)
      LOGICAL ERROR, MODATA, REDRAW, USER
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /ATOMS/ CO( 3, NUMATM), IE( NUMATM), NATOMS, ATCHG( NUMATM)
      COMMON /INTCOR/ XNDOGM(3, NUMATM),INTFRE(3, NUMATM)
      COMMON /GEOM/ COOLD(3, NUMATM),NA( NUMATM),NB( NUMATM),NC( NUMATM)
      COMMON /ATSYMB/ ATSYMB( 200)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /ORBITS/ EVAL(100),ORBS(100,100)
      COMMON /DENSTY/ DENMAT( MPACK ), BONDS( MPACK )
      COMMON /COMM/ COMAND
      COMMON /EDIT/ MODATA, REDRAW
      COMMON /VANRAD/ VANRAD(200)
      DATA TBONDS /-99/
************
* LOCAL FUNCTION DEFINITION
      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)
************
*
* IF THE LOGICAL 'USER' IS TRUE, WE WILL ASK THE USER FOR HIS OPINION
*
      IF ( USER ) THEN
         CALL UPROMP('Do you want to alter BOND SELECTION or '//
     .               'COVALENT RADII (B or C) [B] ? ')
         READ ( *, '(A)', END=399 ) COMAND
         CALL LCLEAN( COMAND, COMAND, .TRUE.)
         IF ( COMAND( 1: 1) .EQ. 'C') THEN
            CALL UPROMP( 'COVALENT RADIUS of which atom type? ')
            READ ( *, '(A)', END=399 ) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IRAD = NUMELE( COMAND(1: INDEX( COMAND,' ')-1) )
            IF ( IRAD .LE. 0 ) THEN
               WRITE (*, *) 'I do not recognize that atomic symbol.'
            ELSE
               WRITE ( *, '( '' What new radius do you want, '',
     .        ''the default is '',F4.2,'' Angstroms ?'')') VANRAD( IRAD)
               READ (*, '(A)') COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE.)
               RADIUS = READA( COMAND, 1, ERROR)
               IF ( .NOT. ERROR .AND. COMAND(1:1).NE.' ') THEN
                  IF ( RADIUS .LT. 0.0D0 ) THEN
                     CALL DEBUGR( 'This will draw NO BONDS.')
                     RADIUS = 0.0D0
                  ELSEIF ( RADIUS .GT. 4.0 ) THEN
                     CALL DEBUGR( 
     .                   'That choice will draw excessive bonds.')
                  ENDIF
                  VANRAD( IRAD) = RADIUS
                  WRITE ( *, '('' OK, all '',A,'' now have radius '',
     .              F4.2,'' Angstroms.'')') ATSYMB( IRAD), VANRAD( IRAD)
                  COMAND = ' '
               ENDIF
            ENDIF
         ELSE
            IF ( TBONDS .EQ. 0 ) THEN
               CALL DEBUGR('I am using your manual selection of bonds.')
            ELSEIF ( TBONDS .GT. 0 ) THEN
               WRITE (*,*) 'I am using the bond order data from the '//
     .                   'input file.'
            ELSE
               CALL DEBUGR('I am using covalent radii to select bonds.')
               WRITE (*,'('' The SCALE FACTOR is '',F5.3 )') BSCALE
            ENDIF
   1        CALL UPROMP('What bond selection method do you want '//
     .               '(BONDORDER, RADII, or MANUAL)? ')
            READ ( *, '(A)', END=9000 ) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( COMAND( 1: 1) .EQ. ' ') THEN
               CALL DEBUGR( 'No change in bonding.')
               REDRAW = .FALSE.
               RETURN
            ELSEIF( COMAND( 1: 1) .EQ. 'B' ) THEN
               IF ( BONDS ( 1 ) .GT. 1.0D-3 ) THEN
                  IF ( TBONDS .NE. 1 ) REDRAW = .TRUE.
                  TBONDS = 1
               ELSE
                  WRITE (*,*) 'Your input file did not contain ',
     .                     'bond selection information.'
               ENDIF
               CALL POPARG( COMAND, COMAND)
            ELSEIF( COMAND( 1: 1) .EQ. 'R' ) THEN
*  USE COVALENT RADII TO SELECT BONDS
               IF ( TBONDS .NE. -1 ) REDRAW = .TRUE.
               TBONDS = -1
               WRITE ( *,'('' The current SCALE FACTOR is '',
     .                 F5.3)') BSCALE
               CALL UPROMP('I normally use a value of 1.400'//
     .              ' What value do you want? ')
               READ (*, '(A)', END=9000 ) COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE.)
               ZSCALE = READA( COMAND, 1, ERROR)
               IF ( ERROR .OR. (ZSCALE .LT. 0.0D0) ) THEN
                  CALL DEBUGR( 'No change to SCALE FACTOR.')
               ELSE
                  BSCALE = ZSCALE
               ENDIF
               CALL POPARG( COMAND, COMAND)
            ELSEIF( COMAND( 1: 1) .EQ. 'M' ) THEN
               IF ( TBONDS .NE. 0 ) REDRAW = .TRUE.
               TBONDS = 0
               CALL POPARG( COMAND, COMAND)
            ELSE
               CALL DEBUGR( 'I didn''t recognize that.')
               GOTO 1
            ENDIF
         ENDIF
      ELSE
         REDRAW = .TRUE.
         IF ( TBONDS .EQ. -99 ) THEN
            IF ( BONDS ( 1 ) .GT. 1.0D-3 ) THEN
               TBONDS = 1
               CALL DEBUGR('Now using Bondorder information.')
            ELSE
               TBONDS = -1
               CALL DEBUGR('Now using covalent radii for bonding.')
            ENDIF
         ENDIF
      ENDIF
*
*  NOW TO ACTUALLY PROCESS THE BONDING STYLE
*
      IF ( TBONDS .GT. 0 ) THEN
*  USING BOND ORDER MATRIX
         NBDS = 0
         K = 0
         DO 110 I = 1, NATOMS
            IF ( IE( I ) .EQ. 99 ) GOTO 110
            DO 100 J = 1, I
               IF ( IE( J ) .EQ. 99 ) GOTO 100
               K = K + 1
               IF ( I .EQ. J) GOTO 100
               IF ( BONDS( K ) .LT. 5.0D-1 ) THEN
                  ATBOND( I, J ) = 0
                  ATBOND( J, I ) = 0
               ELSE
                  ATBOND( I, J ) = 1
                  ATBOND( J, I ) = 1
                  NBDS = NBDS + 1
               ENDIF                        
  100    CONTINUE
  110    CONTINUE
         WRITE (*,*) 'NR BONDS VIA BONDORDER: NBDS =', NBDS
      ELSEIF( TBONDS .LT. 0 ) THEN
*  USING COVALENT RADII
         DO 200 I= 1, NATOMS
            DO 202 J= 1, NATOMS
               IF(I.EQ.J) GOTO 202
               DIST = ATDIST( I, J )
               RADII = VANRAD( IE ( I)) + VANRAD( IE ( J))
               IF ( DIST .LE. RADII*BSCALE ) THEN
                  ATBOND( I, J) = 1
               ELSE
                  ATBOND( I, J) = 0
               ENDIF
  202    CONTINUE
  200    CONTINUE
      ELSEIF ( USER ) THEN

            CALL DEBUGR('You want MANUAL selection of bonds.')
  300       CALL UPROMP('Enter a pair of atoms (negative unbonds): ')
            READ ( *, '(A)', END=399 ) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( COMAND( 1: 1) .EQ. ' ') GOTO 399
            I = READA( COMAND, 1, ERROR )
            IF ( ERROR .OR. I.EQ.0 ) THEN
               CALL DEBUGR('I couldn''t understand the first part.')
               GOTO 300
            ENDIF
            CALL POPARG( COMAND, COMAND)
            IF ( COMAND(1:1) .NE.'*') THEN
              J = READA( COMAND, 1, ERROR )
              IF ( ERROR .OR. J.EQ.0 ) THEN
                 CALL DEBUGR('I couldn''t understand the second part.')
                 GOTO 300
              ENDIF
              IF ( I .LT. 0 .OR. J .LT. 0 ) THEN
                 ATBOND( ABS( I), ABS( J)) = 0
                 ATBOND( ABS( J), ABS( I)) = 0
              ELSEIF( I.GT.0 .AND. J.GT.0 ) THEN
                 ATBOND( I, J) = 1
                 ATBOND( J, I) = 1
              ELSE
                 CALL DEBUGR('ERROR ON ONE OF THE NUMBERS.')
              ENDIF
            ELSE
              IF(I.GT.0) THEN
                CALL DEBUGR('WILDCARD (*) ONLY ALLOWED FOR REMOVAL.')
                GOTO 300
              ENDIF
              DO 350 J=1, NATOMS
                 ATBOND( ABS( I), J) = 0
                 ATBOND( J, ABS( I)) = 0
 350          CONTINUE
            ENDIF
            REDRAW = .TRUE.
            GOTO 300
          ENDIF
 399      CONTINUE
 9000 RETURN
      END
