SUBROUTINE LARROW
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 XX, YY, ZZ, SIZE, THETA, CART
      CHARACTER*80 DUMMY
      INTEGER ISYMBL( 4)
      CHARACTER*6 CBCD
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI, LINALL
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /ATOMS/ CO(3,NUMATM),IE(NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /LINES/ CART(2,NUMATM), LIST(NUMATM), LATOMS, LINALL
      DATA ISYMBL( 1) / 128 /
      DATA ISYMBL( 2) / 130 /
      DATA ISYMBL( 3) / 129 /
***********
*  ISYMBL(1) IS ARROW
*  ISYMBL(2) IS X
*  ISYMBL(3) IS CIRCLE
***********
* ROUTINE TO DRAW ARROWS SIZE OF SYMBOL IS SIZE AND ROTATE IS THETA FOR ROTATION
***********
      PI = 2.0D0 * ASIN(1.0D0)
      CONV = PI / 180.0D0
      NATOM0 = 0
      DO 13 I= 1, LATOMS
         LISTI = LIST( I)
         IF ( IE( LISTI) .LT. 200) NATOM0 = NATOM0 + 1
  13  CONTINUE
      NATOM1 = NATOM0
      DO 15 I=1, NATOM0
         LISTI = LIST( I)
         IF ( IE( LISTI) .LT. 99 ) THEN
            NATOM1 = NATOM1 + 1
            XTEMP = CO(1,NATOM1) - CO(1, LISTI)
            YTEMP = CO(2,NATOM1) - CO(2, LISTI)
            ZTEMP = CO(3,NATOM1) - CO(3, LISTI)
            IF ( ABS(XTEMP) .GT. 1.0D-7 ) THEN
               THETA = ATAN( YTEMP/ XTEMP) / CONV
               IF ( XTEMP .LT. 0.0D0) THETA = THETA+180.0D0
            ELSEIF ( YTEMP .GT. 0.0D0) THEN
               THETA = 90.0D0
            ELSE
               THETA = -90.0D0
            ENDIF
            THETA = THETA - 90.0D0
            D2JK = XTEMP**2 + YTEMP**2
            IF ( ZTEMP**2 .GT. D2JK) THEN
               IF ( ZTEMP .LT. 0.0D0) THEN
                  ISYM = 2
               ELSE
                  ISYM = 3
               ENDIF
            ELSE
               ISYM = 1
            ENDIF
            IF ( (D2JK + ZTEMP**2) .GT. 1.0D-4 ) THEN
               SIZE = 0.25D0
               IF ( DEBUGL) WRITE (*,'('' IN LDRAW: THETA= '', E20.10,
     .            ''; DISP='',2F10.7)') THETA, XTEMP, YTEMP
               XX = CART(1,NATOM1)
               YY = CART(2,NATOM1)
              IF (DEBUGL)  WRITE ( DUMMY, '('' LARROW: COORD='', 2F12.7,
     .            ''; VSIZE='', F3.5, ''; ROT='', F7.1 )' )
     .            XX, YY, VSIZE, THETA
               IF ( DEBUGL) CALL DEBUGR( DUMMY )
               N = 1
               CBCD( 1:1) = CHAR( ISYMBL( ISYM))
               CALL LSIM( XX, YY, SIZE, CBCD, THETA, N)
               IF ( ISYM .EQ. 1 ) CALL LLINE( I, NATOM1)
            ENDIF
         ENDIF
  15  CONTINUE
      RETURN
      END
      SUBROUTINE LATOM(IATOM)
      INCLUDE 'SIZES'
      IMPLICIT REAL (A-H,O-Z)
      REAL XX,YY,Z,THETA, CART
      CHARACTER*6 ATSYMB, TSTRNG
      CHARACTER*80 DUMMY
      CHARACTER*6 ATLABS
      COMMON /LABELS/ ATLABS(NUMATM)
      CHARACTER*6 CBCD
      INTEGER*2 ATBOND
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI, LINALL
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /ATSYMB/ ATSYMB( 200)
      COMMON /COLORS/ ICOLAT( 200)
      COMMON /ATOMS/ CO(3,NUMATM),IE(NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /LINES/ CART(2,NUMATM), LIST(NUMATM), LATOMS, LINALL
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
C
      IF (DEBUGL) THEN
         WRITE ( DUMMY,'( '' LATOM: IATOM='',I4,'', LATYPE='',I4)')
     .                       IATOM,LATYPE
         CALL DEBUGR( DUMMY )
      ENDIF

      IF (IATOM .EQ. 0) THEN
        LATOMS = 0
      ELSEIF (IATOM .GT. 0) THEN
*  ADD ATOM TO PICTURE
        DO 10 I=1,LATOMS
          IF (IATOM .EQ. LIST(I)) THEN
            WRITE (DUMMY, '('' LATOM: DUPLICATE IATOM='',I4)') IATOM
            CALL DEBUGR( DUMMY )
            RETURN 
          ENDIF
 10     CONTINUE
        LATOMS = LATOMS + 1
        LIST(LATOMS) = IATOM
        CART(1,LATOMS) = CO(1,IATOM)
        CART(2,LATOMS) = CO(2,IATOM)
        IF ( IE( IATOM) .EQ. 200 ) RETURN
        Z = .15
        THETA = 0.0
        IF (LATYPE .EQ. 0) RETURN
        TSTRNG = ATLABS(IATOM)
        IF (TSTRNG(1:1) .NE. ' ') THEN
          N = INDEX( TSTRNG(1:6), '"') - 1
          IF ( N.GT.0 ) THEN
            CBCD = TSTRNG( 1: N)
*
            IF (DEBUGL) 
     .            CALL DEBUGR('LATOM: ATOM IS '//TSTRNG(:N))
            IF ( N .GT. 0 ) THEN
              XX = CART(1,LATOMS) - .09*N
              YY = CART(2,LATOMS) - .08
            ELSE
              XX = CART(1,LATOMS)
              YY = CART(2,LATOMS)
            ENDIF
            XTEMP = ICOLAT( IE( IATOM) )
            IF( INT( XTEMP) .GT. ISCOLO) XTEMP = 1.0
            IF( INT( XTEMP) .LT. 1) XTEMP = 1.0
            CALL PLOT( XTEMP, 0.0, 99 )
            CALL LSIM( XX, YY, Z, CBCD, THETA, N)
            CALL PLOT( 1.0, 0.0, 99 )
          ENDIF
        ENDIF
*
C REMOVE ATOM FROM PICTURE
      ELSEIF (IATOM .LT. 0) THEN
        Z = .15
        THETA = 0.0
        JATOM = IABS(IATOM)
        DO 60 I=1,LATOMS
          IF (JATOM .EQ. LIST(I)) GO TO 65
   60   CONTINUE
        IF (DEBUGL) THEN
          WRITE ( DUMMY, '('' LATOM: NO MATCH, JATOM='',I4)') JATOM
          CALL DEBUGR( DUMMY )
        ENDIF
        RETURN
  65    CONTINUE
c?         LISTI = LIST(I)
        TSTRNG = ATLABS( JATOM)
        IF (TSTRNG(1:1) .NE. ' ') THEN
          N = INDEX( TSTRNG(1:6), '"') - 1
          IF ( N.GT.0 ) THEN
            CBCD = TSTRNG( 1: N)
*
            IF ( N .GT. 0 ) THEN
              XX = CART( 1, I) - .09*N
              YY = CART( 2, I) - .08
            ELSE
              XX = CART( 1, I)
              YY = CART( 2, I)
            ENDIF
            CALL LPLOT( 0.0, 0.0, 4)
            CALL LSIM( XX, YY, Z, CBCD, THETA, N)
            CALL LPLOT( 0.0, 0.0, 5)
          ENDIF
        ENDIF
        IF (I.LT.LATOMS) THEN
          IF (DEBUGL) CALL DEBUGR( 'LATOM: UPDATING LIST' )
          DO 80 II=1,LATOMS
            NNREF = LIST( II)
            DO 75 NNX= 1, NATOMS
              NNY = LIST( NNX)
              IF (NNY.GT.0) THEN
                ATBOND( NNREF, NNY) = 0
                ATBOND( NNY, NNREF) = 0
              ENDIF
   75       CONTINUE
            IF (II.GT.I) THEN
              LIST(II-1)=LIST(II)
              IF (DEBUGL) THEN
                WRITE ( DUMMY, '( '' LATOM: '', I3, 2F10.6 )' )
     .                   II-1, (CART(J,II-1),J=1,2)
                DUMMY(40:) = ' <--- '
                WRITE ( DUMMY(47:), '( 2F10.6 )' )  (CART(J,II),J=1,2)
                CALL DEBUGR( DUMMY )
              ENDIF
              CART(1,II-1) = CART(1,II)
              CART(2,II-1) = CART(2,II)
            ENDIF
  80      CONTINUE
        ENDIF
        CART(1,LATOMS)=0.
        CART(2,LATOMS)=0.
        LATOMS=LATOMS-1
      ENDIF
      IF (DEBUGL) CALL DEBUGR( 'LATOM: NOW EXITING.')
      RETURN
      END
      SUBROUTINE LBOND(IATOM)
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      REAL X1,Y1,X2,Y2, CART
      CHARACTER*80 DUMMY
      INTEGER*2 ATBOND
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI, LINALL
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /ATOMS/ CO(3,NUMATM),IE(NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /LINES/ CART(2,NUMATM),LIST(NUMATM), LATOMS, LINALL

C  IF IATOM > 0 => ADDING TO DISPLAY
C           = 0 => CLEARING DISPLAY
C           < 0 => REMOVING ATOM FROM DISPLAY
**
**  LOCAL FUNCTION FOR 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 )
**
      IF (DEBUGL) THEN
        WRITE ( DUMMY,'( '' IN LBOND, IATOM='', I4)' ) IATOM
        CALL DEBUGR( DUMMY )
      ENDIF
      MAXBON=9

      IF (IATOM.EQ.0) RETURN
C
C  LOCATE THE SPECIFIC ATOM
C
      JATOM=ABS(IATOM)
      DO 10 I=1,LATOMS
         IF (JATOM .EQ. LIST(I)) GO TO 15
10    CONTINUE
      WRITE ( DUMMY,'('' LBOND: NO MATCH FOR IATOM='',I4)') IATOM
      CALL DEBUGR( DUMMY )
      RETURN
15    LISTI = LIST(I)
C
      IF (IATOM.GT.0) THEN
C  ADD ATOM TO PICTURE
        DO 20 J=1,LATOMS
          IF (J .EQ. I ) GO TO 20
          LISTJ = LIST(J)
          IF ( ATBOND( LISTI, LISTJ ) .GT. 0 ) THEN
C CHECK FOR PREVIOUS BOND
            CALL LLINE( I, J)
          ENDIF
 20     CONTINUE
      ELSEIF (IATOM.LT.0) THEN
C  ERASE BONDS
C ***  LOOP OVER ALL ATOMS
         DO 85 J=1, NATOMS
           LISTJ = LIST( J)
           IF ( ATBOND( LISTJ, LISTI) .NE. 0) THEN
C ***  GET REF NUMBER OF FIRST (,ETC.) BONDED ATOM
             CALL LPLOT( 0.0, 0.0, 4)
             CALL LLINE( I, J)
             CALL LPLOT( 0.0, 0.0, 5)
             IF (DEBUGL) THEN
               WRITE ( DUMMY, '('' LBOND: ERASING BOND FROM'',
     .                I4, '' TO '',I4)' ) I, LISTJ
               CALL DEBUGR( DUMMY )
             ENDIF
           ENDIF
85       CONTINUE
      ENDIF
      IF (DEBUGL) THEN
         CALL DEBUGR ('CONTENTS OF ATBOND(10,500):')
         DO 31 II1=1,NUMATM
            IF ( LIST(II1) .GT. 0 ) THEN
C??               CALL DEBUGR ( DUMMY( :17+5*ITEMP ) )
            ENDIF
  31     CONTINUE
      ENDIF
      RETURN
      END
      SUBROUTINE LDRAW(IOPT)
*
*  LATOM MANAGES THE COMMON DATA AREA 'LINES' IN
*        CONSTRUCTING STICK (OR LINE) DRAWINGS OF
*        MOLECULES.
*
*        THE ROUTINE TAKES ITS DATA FROM THE COMMON
*        'ATOMS' WHICH IS PRELOADED BY DRAW.
*
*        IF IATOM = 0 => WE CLEAR THE PICTURE AND ARRAYS
*                 < 0 => REMOVE A SINGLE ATOM AND BONDS
*                 > 0 => ADD THE NEW ATOM FROM 'ATOMS'
*
      INCLUDE 'SIZES'
      IMPLICIT REAL (A-H,O-Z)
      CHARACTER*6 CBCD
      INTEGER*2 ATBOND
      REAL CART, XX, YY
      CHARACTER*80 FILEIN,FILPLT,FILOUT, LLEGND
      CHARACTER*80 DUMMY
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI, LINALL
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /ATOMS/ CO(3,NUMATM),IE(NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /LINES/ CART(2,NUMATM), LIST(NUMATM), LATOMS, LINALL
      COMMON /LEGEND/ FILEIN,FILOUT,FILPLT, LLEGND
      COMMON /PLOTS/ XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,CMIN,CMAX,SCALE
C?      COMMON /EXMASS/ XMASS(200)
      DIMENSION KBOND( NUMATM)
      DATA NKBOND/0/
C
* SET UP SPECIAL DISPLAY CODE
      ITS2 = ISTYPE / 10
*
      IF (DEBUGL) THEN
         WRITE ( DUMMY, '('' LDRAW: ENTERING WITH IOPT='',I4,
     .                    '', NATOMS='',I4)') IOPT, NATOMS
         CALL DEBUGR( DUMMY )
      ENDIF
*
* TURN GRAPHICS BACK ON
      CALL LPLOT( 0.0, 0.0, 9 )
*
C OPT=0 REQUESTS RESETTING OF PICTURE
C
      IF ( IOPT .EQ. 0) THEN
         NKBOND=0
         CALL LATOM(0)
         CALL LBOND(0)
         DO 10 I=1,NATOMS
            IF ( IMASK( I) .EQ. 0 .AND. IREM( IE( I)) .EQ. 0) THEN
               CALL LATOM(I)
               CALL LBOND(I)
            ELSEIF ( IE( I) .EQ. 200 ) THEN
               CALL LATOM( I)
            ENDIF
10       CONTINUE
         IF ( NATOMS .GT. 1) THEN
            XL=0.1
            YL=0.9
         ENDIF
         IF ( ITS2 .EQ. 4 ) THEN
            CALL LARROW
         ELSEIF ( ISTYPE .NE. 1 ) THEN
            WRITE ( DUMMY, '('' IN LDRAW: BAD ISTYPE='',I4)') ISTYPE
            CALL DEBUGR( DUMMY )
         ENDIF
         IF ( LLEGND.NE. ' ') THEN
C??           XX = 0.05
           XX = 0.50 - LLENG( LLEGND)*0.03/2.0
           IF(XX.LT.0.0) XX=0.0
           YY = 0.90
           SIZE = 0.02
           THETA = 0.0
           N = 1
           DO 33 I=1, LLENG( LLEGND)
              CBCD(1:1) = LLEGND( I:I)
              XX = XX + 0.03
              CALL SIMBOL( XX, YY, SIZE, CBCD, TTHETA, N)
  33       CONTINUE
         ENDIF

C OPT<0 MEANS REMOVE ATOM 'ABS(OPT)' FROM PICTURE
C
* NEXT WE SEE IF THIS ACTION HAS CAUSED ANY
*   PREVIOUSLY DRAWN ATOMS TO MOVE FROM THEIR LAST POSITION
* WE WILL KEEP TRACK OF ANY RE-DRAWN ATOMS IN ARRAY 'KBOND'
*
      ELSEIF (IOPT .LT. 0) THEN
        NKBOND=0
*
* FRIST WE DELETE THE REQUESTED ATOM
        JOPT=ABS(IOPT)
        CALL LBOND(-JOPT)
        CALL LATOM(-JOPT)
        NMOVE = 0
        DO 18 I= 1, LATOMS
          J=LIST(I)
          XJ=CART(1,I)
          YJ=CART(2,I)
          XO=CO(1,J)
          YO=CO(2,J)
          IF ((ABS(XO-XJ).GT.1.D-2).OR.(ABS(YO-YJ).GT.1.D-2) .AND.
     .         ((.NOT.LINALL).AND.((IMASK(J).EQ.0).OR.
     .            (IREM(IE(J)).EQ.0))))    THEN
             NMOVE = NMOVE + 1
          ENDIF
 18     CONTINUE
        IF ( NMOVE .GT. NATOMS/2) THEN
          CALL DEBUGR( 'IT WOULD BE FASTER TO DRAW WHOLE PICTURE.')
        ENDIF
C
        DO 20 I=1,LATOMS
          J=LIST(I)
          IF (DEBUGL) THEN
            WRITE (DUMMY,'('' LDRAW: LIST('',I4,'')='',I4)') I,J
            CALL DEBUGR( DUMMY )
          ENDIF
          XJ=CART(1,I)
          YJ=CART(2,I)
          XO=CO(1,J)
          YO=CO(2,J)
          IF ((ABS(XO-XJ).GT.1.D-2).OR.(ABS(YO-YJ).GT.1.D-2) .AND.
     .            ((.NOT.LINALL).AND.((IMASK(J).EQ.0).OR.
     .               (IREM(IE(J)).EQ.0))))    THEN
            CALL LBOND(-J)
            NKBOND=NKBOND+1
            KBOND(NKBOND)=J
          ENDIF
 20     CONTINUE
        DO 21 I=1,NKBOND
          J=KBOND(I)
          CALL LATOM(-J)
          IF (.NOT.LINALL.AND.(IMASK(J).NE.0.OR.IREM(IE(J)).NE.0))
     .                KBOND(I)=0
 21     CONTINUE
        DO 22 J=1,NKBOND
          IF (KBOND(J) .EQ. 0) GO TO 22
          CALL LATOM(KBOND(J))
          CALL LBOND(KBOND(J))
 22     CONTINUE
C
C OPT>0 MEANS ADD ATOM 'OPT' TO PICTURE
C
      ELSEIF (IOPT .GT. 0) THEN
C
        NKBOND=0
        DO 30 I=1,LATOMS
          J=LIST(I)
          XJ=CART(1,I)
          YJ=CART(2,I)
          XO=CO(1,J)
          YO=CO(2,J)
          IF (ABS(XO-XJ).GT.1.D-2.OR.ABS(YO-YJ).GT.1.D-2 ) THEN
            CALL LBOND(-J)
            CALL LATOM(-J)
            IF (LINALL.OR.((IMASK(J).NE.0).AND.IREM(IE(J)).NE.0)) THEN
              NKBOND=NKBOND+1
              KBOND(NKBOND)=J
            ENDIF
          ELSE
            IF(.NOT.LINALL.AND.((IMASK(J).EQ.0).OR.(IREM(IE(J)).EQ.0)))
     .                    THEN
              CALL LBOND(-J)
              CALL LATOM(-J)
            ENDIF
          ENDIF
 30     CONTINUE
        DO 90 J=1,NKBOND
          CALL LATOM(KBOND(J))
          CALL LBOND(KBOND(J))
  90    CONTINUE
        CALL LATOM(IOPT)
        CALL LBOND(IOPT)
C
      ENDIF
C
      IF (DEBUGL) THEN
         CALL DEBUGR( 'LDRAW: EXITING NOW' )
         CALL DEBUGR( 'LDRAW: CONTENTS OF COMMON/LINES/:')
         CALL DEBUGR( '  I  LIST(I) ' )
         DO 1000 I=1, LATOMS
            WRITE (DUMMY, '( I5, 2X, I5, 3X, 10I5 )' ) I, LIST(I)
            CALL DEBUGR( DUMMY )
 1000    CONTINUE
      ENDIF
      CALL LPLOT( 0.0, 0.0, 8)
      RETURN
      END
      SUBROUTINE OLLINE( I, J)
      IMPLICIT REAL ( A-H, O-Z)
      INCLUDE 'SIZES'
      REAL X1, X2, Y1, Y2, CART
      LOGICAL LINALL
      INTEGER*2 ATBOND
      CHARACTER*6 ATLABS
      COMMON /LABELS/ ATLABS(NUMATM)
      COMMON /LINES/ CART(2,NUMATM), LIST(NUMATM), LATOMS, LINALL
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /ATOMS/ CO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM)
C??      SYMSIZ = 1.5D-1
      SYMSIZ = 0.0D0
      SYMSIZ = 1.0D-4
      SYMSIZ = 1.0D-3
      PI = 3.14159D0
      X1 = CART(1,I)
      Y1 = CART(2,I)
      X2 = CART(1,J)
      Y2 = CART(2,J)
      IF (LATYPE .NE. 0) THEN
        XDIF=X1-X2
        YDIF=Y1-Y2
        LENI = INDEX( ATLABS(I), '"' )-1
        IF ( ATLABS(I)(1:1) .EQ. ' ') LENI = 0
        LENJ = INDEX( ATLABS(J), '"' )-1
        IF ( ATLABS(J)(1:1) .EQ. ' ') LENJ = 0

        IF ( ABS( XDIF) .LT. 1.0D-4) THEN
          IF ( YDIF.LT.0) THEN
            Y1=Y1-SYMSIZ
            Y2=Y2+SYMSIZ/3
          ELSE
            Y1=Y1+SYMSIZ/3
            Y2=Y2-SYMSIZ
          ENDIF
        ELSEIF( XDIF .LT. 0) THEN
          IF ( ABS( YDIF) .GT. 1.0D-4) THEN
            X1=X1+SYMSIZ*LENI * XDIF/YDIF
            X2=X2-SYMSIZ * XDIF/YDIF
          ENDIF
          Y1=Y1+SYMSIZ*LENI * YDIF/XDIF
          Y2=Y2+SYMSIZ * YDIF/XDIF
        ELSEIF( XDIF .GT. 0) THEN
          IF ( ABS( YDIF) .GT. 1.0D-4) THEN
            X1=X1-SYMSIZ * XDIF/YDIF
            X2=X2+SYMSIZ*LENJ * XDIF/YDIF
          ENDIF
          Y1=Y1-SYMSIZ * YDIF/XDIF
          Y2=Y2+SYMSIZ*LENJ * YDIF/XDIF
        ENDIF
      ENDIF
      CALL LPLOT( X1,Y1,2)
      CALL LPLOT( X2,Y2,3)
      RETURN
      END
      SUBROUTINE LLINE( I, J)
      IMPLICIT REAL ( A-H, O-Z)
      INCLUDE 'SIZES'
      REAL X1, X2, Y1, Y2, CART
      LOGICAL LINALL
      INTEGER*2 ATBOND
      CHARACTER*6 ATLABS
      COMMON /LABELS/ ATLABS(NUMATM)
      COMMON /LINES/ CART(2,NUMATM), LIST(NUMATM), LATOMS, LINALL
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /ATOMS/ CO(3,NUMATM), IE(NUMATM), NATOMS, ATCHG( NUMATM)
      SYMSIZ = 1.5D-1
      PI = 3.14159D0
      X1 = CART(1,I)
      Y1 = CART(2,I)
      X2 = CART(1,J)
      Y2 = CART(2,J)
      IF (LATYPE .NE. 0) THEN
        XDIF=X1-X2
        YDIF=Y1-Y2
        LI = LIST( I)
        LENI = INDEX( ATLABS(LI), '"' )-1
        IF ( ATLABS(LI)(1:1) .EQ. ' ') LENI = 0
        LJ = LIST( J)
        LENJ = INDEX( ATLABS(LJ), '"' )-1
        IF ( ATLABS(LJ)(1:1) .EQ. ' ') LENJ = 0
        IF (ABS(YDIF).GT.1D-5 .OR. ABS(XDIF).GT.1D-5) THEN
          THETA1 = ATAN2( YDIF , XDIF )
          IF ( (Y2-Y1) .LT. 0.0D0 ) THETA1=THETA1+PI
          ACSCAL=SYMSIZ*ABS(COS(THETA1))
          ASSCAL=SYMSIZ*ABS(SIN(THETA1))
          IF (XDIF.GT.2*ACSCAL ) THEN
            X1=X1-ACSCAL*LENI
            X2=X2+ACSCAL*LENJ
          ELSEIF (XDIF.LT.-2*ACSCAL ) THEN
            X1=X1+ACSCAL*LENI
            X2=X2-ACSCAL*LENJ
          ENDIF
          IF ( YDIF .GT. 2*ASSCAL ) THEN
            Y1=Y1-ASSCAL*LENI
            Y2=Y2+ASSCAL*LENJ
          ELSEIF (YDIF.LT.-2*ASSCAL ) THEN
            Y1=Y1+ASSCAL*LENI
            Y2=Y2-ASSCAL*LENJ
          ENDIF
        ENDIF
      ENDIF
      CALL LPLOT( X1,Y1,2)
      CALL LPLOT( X2,Y2,3)
      RETURN
      END
      SUBROUTINE LPLOT( X, Y, IND)
C
C  HERE WE SCALE FROM LINE (OR STICK) DRAWING COORDINATES
C    TO COORDINATES THAT RANGE FROM 0.0 TO 1.0
C
      IMPLICIT REAL( A-H, O-Z)
      REAL X, Y
      COMMON /PLOTS/ XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,CMIN,CMAX,SCALE
C
      XTEMP = XMIN
      IF ( XMAX-XMIN .LT. 0.0) XTEMP = -XMIN
      XX = ( X - XTEMP + 0.1) / SCALE
      YY = ( Y - YMIN + 0.1) / SCALE
      CALL PLOT( XX, YY, IND )
      RETURN
      END
      SUBROUTINE LSIM( X, Y, SIZE, CBCD, THETA, N )
C
C  HERE WE SCALE FROM LINE (OR STICK) DRAWING SYMBOLS
C    TO COORDINATES THAT RANGE FROM 0.0 TO 1.0
C
      IMPLICIT REAL ( A-H, O-Z)
      REAL X, Y, SIZE, THETA, XX, YY, SSIZE, TTHETA
      CHARACTER*6 CBCD
      COMMON /PLOTS/ XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,CMIN,CMAX,SCALE
C
      SSIZE = SIZE / SCALE
      TTHETA = THETA
      XTEMP = XMIN
      IF ( XMAX-XMIN .LT. 0.0) XTEMP = -XMIN
      XX = ( X - XTEMP + 0.1 ) / SCALE
      YY = ( Y - YMIN + 0.1 ) / SCALE
      CALL SIMBOL( XX, YY, SSIZE, CBCD, TTHETA, N)
      RETURN
      END