SUBROUTINE SETLAB
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
*
* SETS CHARACTER VECTOR ATLABS FOR PROPER LABELS
*   THE VECTOR IS ALSO SET IN DISPLAY
*   AND IS READ BY EACH DISPLAY PACKAGE: LINE (STICK), NAGOYA, ORTEP
*
* THE INDETIFIER FOR EACH ATOM IS TERMINATED BY """
*   FOR A MASKED ATOM, THE LABEL WILL CONTAIN ONLY """.
*
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      INTEGER*2 ATBOND
      CHARACTER*80 COMAND
      CHARACTER*6 ATSYMB, ATLABS
      COMMON /ATSYMB/ ATSYMB( 200)
      COMMON /LABELS/ ATLABS(NUMATM)
      COMMON /ATOMS/ CO(3, NUMATM),IE( NUMATM), NATOMS, ATCHG( NUMATM)
      COMMON /GEOM/ COOLD(3, NUMATM),NA( NUMATM),NB( NUMATM),NC( NUMATM)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
C  DEBUGGING NOTES
C       DEBUG  - GENERAL DEBUG LOGICAL
*       DEBUGL - DEBUG FOR LINE DRAWING
*       DEBUGN - DEBUG FOR NAGOYA
*       DEBUGO - DEBUG FOR ORTEP
C       DEBUGP - DEBUG FLAG FOR PLOTTING SUBROUTINES
C
      DO 10 I= 1, NATOMS
         ATLABS(I) = ' "'
 10   CONTINUE
C
      IF ( LATYPE .EQ. 0 ) THEN
C MASKED LABELS
        DO 20 I= 1, NATOMS
          IF (IREM(IE(I)) .NE. 0 ) THEN
            ATLABS(I) = ' "'
          ELSEIF ( IMASK(I)   .NE. 0 ) THEN
            ATLABS(I) = ' "'
          ELSE
            ATLABS(I) = ' "'
          ENDIF
  20    CONTINUE
      ELSEIF ( LATYPE .EQ. 1) THEN
C ATOM NUMBERS
         DO 30 I= 1, NATOMS
            IF (IREM(IE(I)) .NE. 0 ) THEN
               ATLABS(I) = ' "'
            ELSEIF ( IMASK(I)   .NE. 0 ) THEN
               ATLABS(I) = ' "'
            ELSE
               WRITE ( COMAND,'(I5,''"'')') I
               CALL LCLEAN( COMAND, COMAND, .TRUE. )
               ATLABS( I ) = COMAND( 1: 6 )
            ENDIF
  30     CONTINUE
      ELSEIF( LATYPE .EQ. 2 ) THEN
C ATOMIC SYMBOLS
        DO 40 I= 1, NATOMS
          IF (IREM(IE(I)) .NE. 0 ) THEN
            ATLABS(I) = ' "'
          ELSEIF ( IMASK(I)   .NE. 0 ) THEN
            ATLABS(I) = ' "'
          ELSEIF ( IE(I) .EQ. 6 ) THEN
            ATLABS(I) = ' "'
          ELSE
            ATLABS(I) = ATSYMB( IE(I))
            ITEMP = INDEX( ATLABS(I)( 1: 6 ), ' ')
            IF ( ITEMP .GT. 0 ) ATLABS(I)(ITEMP:ITEMP) = '"'
          ENDIF
  40    CONTINUE
      ELSEIF ( LATYPE .EQ. 3 ) THEN
C ATOMIC SYMBOL + ATOM NUMBER
         DO 50 I= 1, NATOMS
            IF (IREM(IE(I)) .NE. 0 ) THEN
               ATLABS(I) = ' "'
            ELSEIF ( IMASK(I)   .NE. 0 ) THEN
               ATLABS(I) = ' "'
            ELSE
               ATLABS(I) = ATSYMB(IE(I))
               ITEMP = INDEX( ATLABS(I), ' ')
               IF ( ITEMP .GT. 3) ITEMP = 3
               IF ( I .LT. 10 ) THEN
                  WRITE (ATLABS(I)(ITEMP:), '( I1, ''"'')' ) I
               ELSEIF ( I.LT. 100) THEN
                  WRITE (ATLABS(I)(ITEMP:), '( I2, ''"'')' ) I
               ELSE
                  WRITE (ATLABS(I)(ITEMP:), '( I3, ''"'')' ) I
               ENDIF
            ENDIF
  50     CONTINUE
      ELSEIF ( LATYPE .EQ. 4 ) THEN
C USER DEFINED SYMBOLS
C?         CALL PLOT( 0, 0, 8)
         DO 60 I= 1, NATOMS
            IF (IREM(IE(I)) .NE. 0 ) THEN
               ATLABS(I) = ' "'
            ELSEIF ( IMASK(I)   .NE. 0 ) THEN
               ATLABS(I) = ' "'
            ELSE
               WRITE ( COMAND, '('' FOR ATOM '',I3,'' (TYPE IS '',
     .            A6,'') YOUR SYMBOL ? '')') I, ATSYMB(IE(I))
               CALL UPROMP( COMAND )
               READ ( *, '(A)') ATLABS( I)
               ITEMP = INDEX( ATLABS(I)( 1: 6 ), ' ')
               IF( ITEMP.EQ.0) ITEMP=6
               ITEMP = MIN( 6, ITEMP )
               ATLABS(I)(ITEMP:ITEMP) = '"'
            ENDIF
  60     CONTINUE
         
C?         CALL PLOT( 0, 0, 9)
         RETURN
      ELSE
         CALL DEBUGR( 'IN SETLAB, INVALID LATYPE')
      ENDIF
      IF ( DEBUG ) THEN
         DO 1000 I= 1, NATOMS
            CALL DEBUGR( ATLABS(I) )
 1000    CONTINUE
      ENDIF
      RETURN
      END