      SUBROUTINE DSPLAY
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)
      CHARACTER*80 COMAND, DUMMY
      CHARACTER*80  FILEIN, FILOUT, FILPLT, LLEGND
      CHARACTER*6 ATSYMB
      DIMENSION EVEC( 3, 3), DISPL( 3), ANGLES( 3)
      INTEGER AUDIN, AUDOUT
      INTEGER*2 ATBOND
      REAL DENMAT, BONDS
      REAL VFREQ, VIBVEC
      LOGICAL ERROR, MODATA, REDRAW, ZOOM1
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      REAL VDIST, XBOUND, YBOUND, BORDER, RETRAC, XCENTR, YCENTR
      REAL SCOR1, SCOR2, REDUCT, BTHICK, XTITLE, YTITLE, THEIT
      COMMON /CORTEP/ VDIST, XBOUND, YBOUND, BORDER, RETRAC, 
     .   IN600, XCENTR, YCENTR, SCOR1, SCOR2, REDUCT, 
     .  NORATM, NORBON, NRBOND, BTHICK, XTITLE, YTITLE, THEIT
*  VDIST :== VIEWING DISTANCE           (INST 301)
* XBOUND :== X-BOUNDARY                 (INST 301)
* YBOUND :== Y-BOUNDARY                 (INST 301)
* BORDER :== SIZE OF BORDER             (INST 301)
* RETRAC :== DIPLACEMENT FOR RETRACE    (INST 303)
* IN600  :== TYPE OF 600 COMMAND        (INST 60X)
* XCENTR :== X-COORD CENTER OF PLOT     (INST 60X)
* YCENTR :== Y-COORD CENTER OF PLOT     (INST 60X)
* SCOR1  :== OVER ALL SCALING           (INST 60X)
* SCOR2  :== SUBSIDIARY SCALING         (INST 60X)
* REDUCT :== OVERALL REDUCTION          (INST 611)
* NORATM :== ATOM SYMBOL SHAPE          (INST 7XX)
* NORBON :== TYPE OF BONDS              (INST 80X)
* NRBOND :== NUMBER OF LINES IN BOND    (INST 80X)
* BTHICK :== BOND THICKNESS             (INST 80X)
* XTITLE :== X-RESET FOR TITLE          (INST 902)
* YTITLE :== Y-RESET FOR TITLE          (INST 902)
* THEIT  :== TITLE HEIGHT               (INST 902)
      COMMON /AUDIT/ AUDIN, AUDOUT
      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 /COLORS/ ICOLAT( 200)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /DEVICE/ ITYPE, ISCRN, KOROFF
      COMMON /OUTPUT/ IPAPER,IPAGE
      COMMON /FORCE/ VFREQ(3*NUMATM), VIBVEC(3*NUMATM,3*NUMATM), IDVECT
      COMMON /FORGEO/ FORORE( 3, NUMATM), IEFOR( NUMATM)
      COMMON /ORBITS/ EVAL(100),ORBS(100,100)
      COMMON /DENSTY/ DENMAT( MPACK ), BONDS( MPACK )
      COMMON /COMM/ COMAND
      COMMON /LEGEND/  FILEIN, FILOUT, FILPLT, LLEGND
      COMMON /EDIT/ MODATA, REDRAW
      COMMON /ALLROT/ ROTPRD( 3, 3)
      COMMON /ATMASS/ ATMASS( NUMATM)
C?      COMMON /EXMASS/ XMASS(200)
      COMMON /PLOTS/ XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,CMIN,CMAX,SCALE
      COMMON /HCPY/ JHDEV
      INTEGER PIXROW, PIXCOL, PIXEL
      COMMON /TERM/ IMAXR, IMAXC, PIXROW, PIXCOL, PIXEL, LCOUNT, INGRAF,
     .              IXL, IXR, IYT, IYB, NCOLOR, MCOLOR( 64 ), ITTRM,
     .              MARGX, MARGY
* VARIABLES IN COMMON TERM:
*  IMAXR = MAX NUMBER OF ROWS
*  IMAXC = MAX NUMBER OF COLUMNS
*  PIXROW = NUMBER OF PIXELS PER ROW
*  PIXCOL = NUMBER OF PIXELS PER COLUMN
*  PIXEL  = LESSER OF PIXROW OR PIXCOL
*  LCOUNT = NUMBER OF LINES CURRENTLY WRITTEN TO DIALOG AREA
*  INGRAF = 0=> HOST TEXT GOES TO MONITOR SPACE\\ 1=> TEXT TO GRAPHICS
*  IXL    = LEFT MOST VALUE OF X
*  IXR    = RIGHT MOST VALUE OF X
*  IYT    = VALUE OF Y AT TOP OF SCREEN
*  IYB    = VALUE OF Y AT BOTTOM OF SCREEN
*  NCOLOR = NUMBER OF COLORS IN MCOLOR MAP
*  MCOLOR = MAP OF COLORS
*  ITTRM  = UNIQUE MODEL NUMBER OF GENERAL TERMINAL TYPE
*  MARGX  = NUMBER OF PIXELS PADDED TO X-COORDINATE
*  MARGY  = NUMBER OF PIXELS PADDED TO Y-COORDINATE
*
*
      DATA ZOOM1 /.TRUE./
***************************************************
*  HERE IS STUFF WE MUST RE-INITIALIZE FOR RE-ENTRY
*
***************************************************

 10   CONTINUE
      IF ( COMAND(1:1) .EQ. ' ' ) THEN
         IF ( AUDIN .EQ. 0 ) THEN
            CALL UPROMP( 'Draw:DISPLAY> ')
            READ ( *, '(A)', END=9000) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
         ELSE
            READ( AUDIN, '(A)', END=9000) COMAND
         ENDIF
      ENDIF
      ITS1 = MOD(ISTYPE,10)
      IF (COMAND(1:1) .EQ.'H' .OR. COMAND(1:1) .EQ. '?') THEN
         COMAND = 'DRAW DISPLAY'
         CALL HELP( COMAND )
         COMAND = ' '
      ELSEIF (COMAND(1:1) .EQ. 'Q' ) THEN
        CALL POPARG( COMAND, COMAND)
        RETURN
      ELSEIF (COMAND(:1) .EQ. '-' ) THEN
        COMAND = COMAND( 2:)
        CALL LCLEAN( COMAND, COMAND, .TRUE.)
        IF ( COMAND( 1: 1 ) .EQ. '-' ) THEN
           CALL POPARG( COMAND, COMAND)
           DO 30 I=1,NUMATM
  30       IMASK(I) = I
           REDRAW = .TRUE.
           CALL DEBUGR( 'All atoms turned off.')
        ELSEIF (COMAND( 1: 1 ).GE.'A' .AND. COMAND( 1: 1).LE.'Z' ) THEN
           I = 1
           IF (COMAND( 2: 2) .NE. ' ') I=2
           JJ = I
           J = NUMELE( COMAND( 1: I) )
              IF ( J .GT. 0 ) THEN
                 IF ( IREM(J) .EQ. 0 ) THEN
                    CALL DEBUGR( 'Ok.')
                    IREM(J) = J
                    DO 501 KK = 1, NATOMS
                       IF ( IE( KK) .EQ. J ) REDRAW = .TRUE.
  501               CONTINUE
                 ELSE
                    WRITE (*,*) 'It was.'
                 ENDIF
              ELSE
                 WRITE (*, '( '' No match for symbol '', A )' ) 
     .                 COMAND(1:I)
              ENDIF
              CALL POPARG( COMAND, COMAND)
           GO TO 10
        ELSEIF (COMAND(1:1).GE.'0' .AND. COMAND( 1:1) .LE. '9') THEN
          NNN = READA(COMAND, 1, ERROR)
          IF (ERROR) THEN
             WRITE (*,*) 'READA error on',COMAND(2:)
             COMAND = ' '
             GO TO 10
          ENDIF
          IF (IMASK(NNN) .NE. 0 ) THEN
             CALL DEBUGR( 'It was.')
          ELSE
             CALL DEBUGR( 'Ok.')
             IMASK(NNN) = NNN
             REDRAW = .TRUE.
          ENDIF
          CALL POPARG( COMAND, COMAND)
          GO TO 10
        ELSE
          WRITE (*,*) 'INV)lID CHARACTER',COMAND(2:2)
          COMAND = ' '
        ENDIF
      ELSEIF (COMAND(1:1) .EQ. '+' ) THEN
        COMAND = COMAND(2:)
        CALL LCLEAN( COMAND, COMAND, .TRUE.)
        IF (COMAND( 1: 1 ) .EQ. '+' ) THEN
           CALL POPARG( COMAND, COMAND)
           DO 40 I = 1, NUMATM
   40      IMASK(I) = 0
           REDRAW = .TRUE.
           CALL DEBUGR( 'All atom numbers allowed.' )
        ELSEIF (COMAND(1:1 ).GE.'A' .AND. COMAND( 1:1) .LE. 'Z' ) THEN
           I = 1
           IF (COMAND( 2: 2 ) .NE. ' ') I=2
           JJ = I
           J = NUMELE( COMAND( 1: I) )
              IF ( J .GT. 0 ) THEN
                 IF (IREM(J) .NE. 0 ) THEN
                    CALL DEBUGR( 'Ok.')
                    IREM(J) = 0
                    DO 500 KK = 1, NATOMS
                       IF ( IE( KK) .EQ. J ) REDRAW = .TRUE.
  500               CONTINUE
                    CALL SETLAB
                 ELSE
                    WRITE (*,*) 'It was.'
                 ENDIF
              ELSE
                 WRITE (*, '( '' No match for symbol '', A )' ) 
     .                 COMAND(1:I)
              ENDIF
              CALL POPARG( COMAND, COMAND)
              GO TO 10
           ELSEIF (COMAND( 1:1 ).GE.'0' .AND. COMAND( 1:1).LE.'9') THEN
              NNN = READA( COMAND, 1, ERROR)
              IF (ERROR) THEN
                 WRITE (*,*) 'READA error on',COMAND(2:)
                 COMAND = ' '
                 GO TO 10
              ENDIF
              IF (IMASK(NNN) .EQ. 0 ) THEN
              WRITE (*,*) 'It was.'
              CALL POPARG( COMAND, COMAND)
              GO TO 10
           ELSE
             CALL DEBUGR( 'Ok.')
             IMASK(NNN) = 0
             REDRAW = .TRUE.
             CALL SETLAB
             CALL POPARG( COMAND, COMAND)
             GO TO 10
           ENDIF
        ELSE
           WRITE (*,*) 'INVALID CHARACTER',COMAND(2:2)
        ENDIF
      ELSEIF ( COMAND(1:1) .EQ. 'Z' ) THEN
*  ZOOM-IN COMMAND
         CALL POPARG( COMAND, COMAND)
         IF ( COMAND(1:1) .EQ. ' ') THEN
            IF ( AUDIN .EQ. 0 ) THEN
               CALL UPROMP( 
     .     'Show by MANUAL, OPTIMIZED, SURFACE, or QUIT? ')
               COMAND = ' '
               READ ( *, '(A)', END=10) COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE.)
               IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
            ELSE
               READ( AUDIN, '(A)', END=10) COMAND
            ENDIF
         ENDIF
         IF ( COMAND(1:1) .EQ. 'Q' ) THEN
            CALL POPARG( COMAND, COMAND)
            ZOOM1 = .TRUE.
            REDRAW = .TRUE.
            DO 238 I= 1, NATOMS
               IMASK( I) = 0
  238       CONTINUE
            CALL DEBUGR( 'Revert to display entire molecule.')
           XMIN = -1.0
           XMAX = 1.0
           CALL MINMAX
         ELSEIF ( COMAND(1:1) .EQ. 'M' ) THEN
            DO 240 I = 1, NATOMS
               IMASK( I) = I
  240       CONTINUE
            REDRAW = .TRUE.
  241       CONTINUE
            CALL POPARG( COMAND, COMAND)
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( AUDIN .EQ. 0 ) THEN
               IF(COMAND(1:1).EQ.' ') THEN
                 CALL UPROMP( 
     . 'What atoms to zoom-in on? (NONE to stop) ')
                 READ ( *, '(A)', END=10) COMAND
                 CALL LCLEAN( COMAND, COMAND, .TRUE.)
                 IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
               ENDIF
            ELSE
               READ( AUDIN, '(A)', END=10) COMAND
            ENDIF
            IF( COMAND(1:1) .EQ. ' ') GOTO 10
            IF( COMAND(1:1) .EQ. 'N') GOTO 10
C?  241    CONTINUE
            ITEMP = READA( COMAND, 1, ERROR)
            IF (ERROR .OR. COMAND(1:1) .EQ. ' ') THEN
               CALL UPROMP( 'ZOOM is set.' )
               COMAND = ' '
               GOTO 10
            ELSE
               IF (ITEMP .LT. NATOMS) THEN
                  IMASK( ITEMP) = 0
                  JTEMP = MAX( INDEX( COMAND, ' '), 1)
                  KTEMP = MAX( INDEX( COMAND, '-'), 1)
                  LTEMP = MAX( INDEX( COMAND, ','), 1)
                  MTEMP = MIN( KTEMP, JTEMP)
                  MTEMP = MIN( MTEMP, LTEMP)
                  COMAND = COMAND( MTEMP: )
                  CALL LCLEAN( COMAND, COMAND, .TRUE.)
                  IF ( COMAND(1:1) .EQ. '-') THEN
                     COMAND(1:1) = ' '
                     CALL LCLEAN( COMAND, COMAND, .TRUE.)
                     JTEMP = READA( COMAND, 1, ERROR)
                     CALL POPARG( COMAND, COMAND)
                     IF ( ERROR) THEN
                        CALL DEBUGR( 'ERROR IN RANGE OF ZOOM.')
                        GOTO 241
                     ELSE
                        DO 244 I=MIN( ITEMP, JTEMP), MAX( ITEMP, JTEMP)
                           IMASK( I) = I
  244                   CONTINUE
                        REDRAW = .TRUE.
                     ENDIF
                  ELSE
                     CALL LCLEAN( COMAND, COMAND, .TRUE.)
                  ENDIF
                  GOTO 241
              ELSE
                  WRITE ( COMAND, '('' ERROR IN ATOM NUMBER '',I4)')
     .                        ITEMP
                  CALL DEBUGR( COMAND )
                  COMAND = ' '
                  GOTO 10
              ENDIF
            ENDIF
         ELSEIF( COMAND(1:1) .EQ. 'O') THEN
            CALL POPARG( COMAND, COMAND)
            IFIRST = 0
            ILAST = 0
*  AUTOMATIC SELECTION OF OPTIMIZED ATOMS
            DO 245 I = 1, NATOMS
               IMASK( I ) = I
               IF ( INTFRE( 1, I) .NE. 0 ) IMASK( I ) = 0
               IF ( INTFRE( 2, I) .NE. 0 ) IMASK( I ) = 0
               IF ( INTFRE( 3, I) .NE. 0 ) IMASK( I ) = 0
               IF ( IMASK( I) .EQ. 0) THEN 
                  IF ( IFIRST .EQ. 0 ) IFIRST = I
                  ILAST = I
               ELSEIF ( IFIRST .GT. 0 ) THEN
                  WRITE (*,'('' Selecting '',I4,'' through '',I4)')
     .               IFIRST, ILAST
                  IFIRST = 0
                  ILAST = 0
               ENDIF
  245       CONTINUE
            REDRAW = .TRUE.
         ELSEIF( COMAND(1:1) .EQ. 'S') THEN
* WANTS TO SELECT A SURFACE (ONLY A RELATIVE X-Y SURFACE IS ALLOWED)
           IF ( ZOOM1 ) THEN
*  we will lock the scale for now
             CALL MINMAX
             XMIN = -XMIN
             XMAX = -XMAX
             ZOOM1 = .FALSE.
           ENDIF
           CALL POPARG( COMAND, COMAND)
           ZTOP = CO( 3, 1)
           ZBOT = CO( 3, 1)
           IZTOP = 1
           IZBOT = 1
           DO 3300 I= 1, NATOMS
             IF ( CO( 3, I ) .GT. ZTOP ) THEN
               ZTOP = CO( 3, I)
               IZTOP = I
             ELSEIF ( CO( 3, I) .LT. ZBOT ) THEN
               ZBOT = CO( 3, I)
               IZBOT = I
             ENDIF
 3300      CONTINUE
           ZRANGE = ZTOP - ZBOT
           IF ( ZRANGE .LE. 1.5 ) THEN
             CALL DEBUGR( 'This molecule is nearly flat.')
             ZRANGE = 1.5
           ELSE
             WRITE (*,'('' Maximum Z: '',F11.4,'' Minimum Z: '',
     .               F11.4)')  ZTOP, ZBOT
             WRITE (*,'('' Slices will be '',F8.2,
     .                  '' Angstroms thick.'')')ZRANGE
           ENDIF
           IF ( COMAND(1:1) .EQ. ' ') THEN
             IF ( AUDIN .EQ. 0 ) THEN
               IF ( IZTOP .LT. 1 ) THEN
                 CALL UPROMP 
     .               (' Enter Z-value, TOP, BOTTOM, or Atom ##: ')
               ELSE
                 CALL UPROMP 
     .              (' Enter Z-value, TOP, BOTTOM, Atom ##, +, or -: ')
               ENDIF
               READ ( *, '(A)', END=10) COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE.)
               IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
             ELSE
               READ( AUDIN, '(A)', END=10) COMAND
             ENDIF
           ENDIF
           IF ( COMAND( 1: 1) .EQ. ' ') THEN
             GOTO 10
           ELSEIF( COMAND( 1: 1) .EQ. 'T' ) THEN
*  WANTS TOP OF MOLECULE
             ZMIDD = ZTOP
           ELSEIF( COMAND( 1: 1) .EQ. 'B') THEN
*  WANTS BOTTOM OF MOLCULES
             ZMIDD = ZBOT
           ELSEIF( COMAND( 1: 1) .EQ. 'A') THEN
*  WANTS SURFACE CONTAINING ATOM ##
             IZATOM = READA( COMAND, 2, ERROR)
             IF ( ERROR ) THEN
               CALL DEBUGR( 'I could not understand that atom.')
               CALL DEBUGR( COMAND(1:10) )
               IZATOM = 1
             ENDIF
             ZMIDD = CO( 3, IZATOM) 
           ELSEIF ( COMAND( 1: 1) .EQ. '+') THEN
*  WANTS TO MOVE UP RELATIVE
             ZMIDD = ZMIDD + ZRANGE / 10.0
           ELSEIF ( COMAND( 1: 1) .EQ. '-') THEN
*  WANTS TO MOVE DOWN RELATIVE
             ZMIDD = ZMIDD - ZRANGE / 10.0
           ELSE
             ZMIDD = READA( COMAND, 1, ERROR)
             IF ( ERROR ) THEN
               COMAND = ' '
               GOTO 10
             ENDIF
           ENDIF
           IF ( ZMIDD .GE. ZTOP ) THEN
             ZMIDD = ZTOP
             CALL DEBUGR( 'At the top; Maximum Positive Z.')
           ELSEIF ( ZMIDD .LE. ZBOT) THEN
             ZMIDD = ZBOT
             CALL DEBUGR( 'At the bottom; Minimum  Z.')
           ENDIF
           ZSTART = ZMIDD + ZRANGE / 10.0
           ZEND = ZMIDD - ZRANGE / 10.0
           WRITE ( *, '('' Secting atoms in the range: '',F11.4,
     .          '' down to'',F11.4,'' Angstroms.'')') ZSTART, ZEND
           CALL UPROMP( ' ATOMS: ' )
           DO 3304 I= 1, NATOMS
             ZTEMP = CO( 3, I)
             IF ( ZTEMP .LE. ZSTART .AND. ZTEMP .GE. ZEND) THEN
               IMASK( I) = 0
               WRITE ( DUMMY, '(''+'',I5)') I
               CALL UPROMP( DUMMY( 1: 7) )
             ELSE
               IMASK( I) = I
             ENDIF
 3304      CONTINUE
           CALL POPARG( COMAND, COMAND)
           REDRAW = .TRUE.
         ELSE
           CALL DEBUGR( 'That was not one of the choices.' )
           CALL POPARG( COMAND, COMAND)
           GOTO 10
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'A' ) THEN
        WRITE ( *, *) 'USE +## or -## to UNMASK or MASK types of atoms.'
        CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. 'B' ) THEN
* ADJUSTMENT TO BONDING
         CALL SETBON( .TRUE. )
         REDRAW = .TRUE.
      ELSEIF (COMAND(:1) .EQ. 'P') THEN
* SELECTION OF PLOTTING DEVICE
        CALL POPARG( COMAND, COMAND)
        JTEMP = ABS(JHDEV)
        IF (JTEMP .EQ. 1 ) THEN
           WRITE (*,*) 'PLOTS SET FOR IDS PAPER TIGER PRINTER.'
        ELSEIF (JTEMP .EQ. 2 ) THEN
           WRITE (*,*) 'PLOTS SET FOR EPSON FX-80 PRINTER.'
        ELSEIF (JTEMP .EQ. 3 ) THEN
           WRITE (*,*) 'PLOTS SET FOR DEC LA50 PRINTER.'
        ELSEIF (JTEMP .EQ. 4 ) THEN
           WRITE (*,*) 'PLOTS SET FOR MPI-99 PRINTER.'
        ELSEIF (JTEMP .EQ. 5) THEN
           WRITE (*,*) 'PLOTTING FOR HP9872 STYLE PLOTTER.'
        ELSEIF (JTEMP .EQ. 6) THEN
           WRITE (*,*) 'PLOTTING FOR CALCOMP M84 PLOTTER.'
        ELSEIF (JTEMP .EQ. 7) THEN
           WRITE (*,*) 'PLOTTING FOR XEROX 2700 II LASER PRINTER.'
        ELSE
           WRITE (*,*) 'PLOTS ARE SET FOR AN UNKNOWN DEVICE'
           WRITE (*,*) 'JHDEV =',JTEMP
        ENDIF
        IF ( AUDIN .EQ. 0 ) THEN
           CALL UPROMP( 'WHAT TYPE OF DEVICE TO PLOT ON ' )
           COMAND = ' '
           READ ( *, '(A)', END= 3000) COMAND
           CALL LCLEAN( COMAND, COMAND,.TRUE.)
           IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
        ELSE
           READ( AUDIN, '(A)', END= 3000) COMAND
        ENDIF
        IF (COMAND(1:2) .EQ. 'HE' .OR. COMAND(1:1) .EQ. '?') THEN
           COMAND = 'DRAW DISPLAY PLOT'
           CALL HELP( COMAND )
        ELSEIF (COMAND(1:1) .EQ. 'T' ) THEN
           JHDEV = -1
           CALL DEBUGR( 'OK NOW SET FOR IDS PAPER TIGER')
        ELSEIF (COMAND(1:1) .EQ. 'E' ) THEN
           JHDEV = -2
           CALL DEBUGR( 'OK NOW SET FOR EPSON FX-80')
        ELSEIF (COMAND(1:1) .EQ. 'L' ) THEN
           JHDEV = -3
           CALL DEBUGR( 'OK NOW SET FOR DEC LA50 PRINTER')
        ELSEIF (COMAND(1:1) .EQ. 'M' ) THEN
           JHDEV = -4
           CALL DEBUGR( 'OK NOW SET FOR MPI-99 PRINTER')
        ELSEIF (COMAND(1:2) .EQ. 'HP' ) THEN
           JHDEV = -5
           CALL DEBUGR( 'OK, I''M SET FOR HP9872 STYLE PLOT.')
        ELSEIF (COMAND(1:1) .EQ. 'C' ) THEN
           JHDEV = -6
           CALL DEBUGR( 'OK, I''M SET FOR CALCOMP M84 PLOTTER.')
        ELSEIF (COMAND(1:1) .EQ. 'X' ) THEN
           JHDEV = -7
           CALL DEBUGR( 'OK, I''M SET FOR XEROX 2700 II PRINTER.')
        ELSEIF (COMAND(1:1) .EQ. ' ' ) THEN
           CONTINUE
        ELSE
           CALL DEBUGR('I DO NOT RECOGNIZE THAT, TRY MORE CHARACTERS')
           CALL DEBUGR(' or get HELP for available printers.')
           CALL DEBUGR('CURRENT PLOTTER NOT CHANGED')
        ENDIF
3000    CONTINUE
        COMAND = ' '
      ELSEIF (COMAND(:1) .EQ. 'D') THEN
        IF ( ABS(DENMAT( 1 )) .LT. 1.0D-5) THEN
           CALL DEBUGR(' NO DENSITY MATRIX AVAILABLE.')
           COMAND = ' '
           GOTO 10
        ENDIF
        IF ( ITS1 .EQ. 2 ) THEN
           CALL DEBUGR('DENSITY DISPLAY NOT AVAILABLE FOR NAMODI.')
        ELSEIF ( ITS1 .EQ. 4) THEN
           CALL DEBUGR('DENSITY DISPLAY NOT AVAILALBE FOR ORTEP.')
        ELSEIF ( ITS1 .EQ. 1) THEN
           CALL DEBUGR('DENSITY DISPLAY NOT AVAILABLE FOR STICKS.')
        ENDIF
        ISTYPE = (ISTYPE - (ISTYPE/10)*10) + 10
      ELSEIF (COMAND(:2) .EQ. 'NA') THEN
        ISTYPE = ISTYPE - MOD( ISTYPE,10) + 2
        CALL DEBUGR('NAMOD')
        IF ( LLEGND.EQ.' ') LLEGND = FILEIN
        REDRAW = .TRUE.
        CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:2) .EQ. 'SC' .OR. COMAND(:2) .EQ. 'SI') THEN
        IF( XMAX-XMIN .GT. 0.0 ) THEN
          CALL DEBUGR( 'Scaling is AUTOMATIC.')
        ELSE
          CALL DEBUGR( 'Scaling is FIXED.')
        ENDIF
        WRITE (*,1060) 'Current size of display:       CRT=',IPAGE,'%'
        WRITE (*,1060) '                         HARD COPY=',IPAPER,'%'
 1060   FORMAT ( 1X, A, I3, A )
        COMAND = ' '
        IF ( AUDIN .EQ. 0 ) THEN
           CALL UPROMP( 'Enter C= or H= and a number from 1 to 100 : ')
           COMAND = ' '
           READ ( *, '(A)', END=10) COMAND
           CALL LCLEAN( COMAND, COMAND,.TRUE.)
           IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
        ELSE
           READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        IF (COMAND(:1) .EQ. 'H') THEN
           ITEMP=READA(COMAND,INDEX(COMAND,'=')+1,ERROR)
           CALL POPARG( COMAND, COMAND)
           IF (ERROR) THEN
              CALL DEBUGR( 'Input conversion error, no change.')
           ELSE
              IPAPER=ITEMP
              WRITE (*,*) 'Current HARD COPY scaling is',IPAPER
           ENDIF
        ELSEIF (COMAND( 1: 1) .EQ. 'C') THEN
           ITEMP = READA( COMAND, INDEX( COMAND, '=')+1, ERROR)
           CALL POPARG( COMAND, COMAND)
           IF (ERROR) THEN
              CALL DEBUGR( 'Input conversion error, no change.')
           ELSE
              IPAGE=ITEMP
              REDRAW = .TRUE.
              WRITE (*,*) 'Current CRT scaling is', IPAGE
           ENDIF
        ELSEIF (COMAND( 1: 1) .EQ. 'A') THEN
           CALL DEBUGR( 'Now using AUTOMATIC Scaling.')
           XMIN = 0.0
           XMAX = 1.0
           CALL MINMAX
           CALL POPARG( COMAND, COMAND)
        ELSEIF (COMAND( 1: 1) .EQ. 'F') THEN
           CALL DEBUGR( 'Scaling now FIXED at current scale.')
           CALL MINMAX
           XMIN = -XMIN
           XMAX = -XMAX
           CALL POPARG( COMAND, COMAND)
        ENDIF
      ELSEIF (COMAND(:2) .EQ. 'ST') THEN
        ISTYPE = ISTYPE - MOD( ISTYPE,10) + 1
        WRITE ( *, *) 'STICK FIGURES'
        REDRAW = .TRUE.
        CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:2) .EQ. 'OR') THEN
* ASK TO DISPLAY ORTEP VIEW
        CALL POPARG( COMAND, COMAND)
        IF ( NATOMS .LT. 2) THEN
           CALL DEBUGR( 'YOU HAVE TOO FEW ATOMS.')
           GOTO 10
        ENDIF
        ISTYPE = ISTYPE - MOD( ISTYPE,10) + 4
        CALL DEBUGR( 'ORTEP')
        IF ( LLEGND.EQ.' ') LLEGND = FILEIN
        REDRAW = .TRUE.
      ELSEIF ( COMAND(1:2) .EQ. 'OP') THEN
* ALTER ORTEP PARAMETERS
        CALL MINMAX
        WRITE (*,'( '' Minimums:  X='',F8.4,'', Y='',F8.4,'', Z='',
     .     F8.4,'', OVERALL='',F8.4)') XMIN, YMIN, ZMIN, CMIN
        WRITE (*,'( '' MAXIMUMS:  X='',F8.4,'', Y='',F8.4,'', Z='',
     .     F8.4,'', OVERALL='',F8.4,'', SCALE='',F8.4)') 
     .     XMAX, YMAX, ZMAX, CMAX, SCALE
        CALL POPARG( COMAND, COMAND)
        CALL DEBUGR( 'ORTEP Parameters...' )
        WRITE (*,'( '' XBOUND,YBOUND:'',2F6.2,''  VDIST:'',F5.2,
     .     '' BORDER  '',F5.2)') XBOUND,YBOUND, VDIST, BORDER
        WRITE (*,'( '' IN600='',I3,''  XCENTR,YCENTR '',2F6.2,
     .     '' SCOR1,2='',2F6.3)') IN600, XCENTR, YCENTR, SCOR1, SCOR2
        WRITE (*, '('' ATOM TYPES:'',I2,'' RETRACE:'',F5.4)')
     .     NORATM, RETRAC
        WRITE (*, '( '' BOND TYPE:'',I3,'' USING '',I3,'' LINES'',
     .    '' WITH TOTAL THICKNESS '',F5.4)') NORBON, NRBOND, BTHICK
        IF ( AUDIN .EQ. 0 ) THEN
          IF ( COMAND(1:1) .EQ. ' ') CALL UPROMP( 
     .          'Which parameter to change? ')
          READ ( *, '(A)', END=10) COMAND
          CALL LCLEAN( COMAND, COMAND,.TRUE.)
          IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
        ELSE
          READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        IF ( COMAND(1:3) .EQ. 'XBO') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          XBOUND = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:3) .EQ. 'YBO') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          YBOUND = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:1) .EQ. 'B') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          BORDER = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:1) .EQ. 'V') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          VDIST = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:3) .EQ. 'IN6') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          IN600 = INT( TEMP)
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:2) .EQ. 'XC') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          XCENTR = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:2) .EQ. 'YC') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          YCENTR = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:5) .EQ. 'SCOR1') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          SCOR1 = TEMP
          CALL POPARG( COMAND, COMAND)
        ELSEIF ( COMAND(1:5) .EQ. 'SCOR2') THEN
          CALL POPARG( COMAND, COMAND)
          TEMP = READA( COMAND, 1, ERROR)
          SCOR2 = TEMP
        ELSE
          COMAND = ' '
        ENDIF
      ELSEIF (COMAND(:1) .EQ. 'L') THEN
*  REQUEST TO SET LABEL TYPE
        CALL POPARG( COMAND, COMAND)
        IF ( COMAND(1:1) .EQ. ' ' ) THEN
           IF (LATYPE .EQ. 0) THEN
             CALL DEBUGR( 'Labels are currently MASKED.')
           ELSEIF (LATYPE .EQ. 1) THEN
             CALL DEBUGR( 'Current labels are ATOM NUMBERS.')
           ELSEIF ( LATYPE .EQ. 2 ) THEN
             CALL DEBUGR( 'I am using ATOMIC SYMBOLS as labels.')
           ELSEIF ( LATYPE .EQ. 3 ) THEN
             CALL DEBUGR( 'Labels are SYMBOLS and ATOM NUMBERS.')
           ELSEIF ( LATYPE .EQ. 4 ) THEN
             CALL DEBUGR( 'Labels are USER DEFINED.')
           ELSE
             WRITE (*,*) 'UNKNOWN LABEL TYPE, LATYPE=',LATYPE
           ENDIF
           IF ( AUDIN .EQ. 0 ) THEN
              IF ( COMAND(1:1) .EQ. ' ') CALL UPROMP( 
     .          'What do you want: Mask, Numbers, Symbols,'//
     .          ' Both, User-defined ')
              READ ( *, '(A)', END=10) COMAND
              CALL LCLEAN( COMAND, COMAND,.TRUE.)
              IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
           ELSE
              READ( AUDIN, '(A)', END=10) COMAND
           ENDIF
        ENDIF
        IF (COMAND(:1) .EQ. 'M') THEN
          IF ( LATYPE .NE. 0 ) THEN
             LATYPE = 0
             REDRAW = .TRUE.
          ENDIF
        ELSEIF (COMAND(:1) .EQ. 'N') THEN
          IF ( LATYPE .NE. 1 ) THEN
             LATYPE = +1
             REDRAW = .TRUE.
          ENDIF
        ELSEIF (COMAND(:1) .EQ. 'S') THEN
          IF ( LATYPE .NE. -1 ) THEN
             LATYPE = 2
             REDRAW = .TRUE.
          ENDIF
        ELSEIF (COMAND(:1) .EQ. 'B') THEN
          IF ( LATYPE .NE. -1 ) THEN
             LATYPE = 3
             REDRAW = .TRUE.
          ENDIF
        ELSEIF (COMAND(:1) .EQ. 'U') THEN
          IF ( LATYPE .NE. -1 ) THEN
             LATYPE = 4
             REDRAW = .TRUE.
          ENDIF
        ELSE
          WRITE (*,*) 'NO CHANGE.'
        ENDIF
        CALL POPARG( COMAND, COMAND)
        IF ( REDRAW ) CALL SETLAB
      ELSEIF (COMAND( 1: 2) .EQ. 'MO') THEN
        IF ( ABS( EVAL(1)) .LT. 1.0D-2) THEN
           WRITE (*,'('' NO MOLECULAR ORBITALS AVAILABLE.'')')
           COMAND = ' '
           GOTO 10
        ENDIF
        IF ( ITS1 .EQ. 2 ) THEN
           WRITE (*,*) 'MO DISPLAY NOT AVAILABLE FOR NAMOD.'
        ELSEIF ( ITS1 .EQ. 4) THEN
           WRITE (*,*) 'MO DISPLAY NOT AVAILALBE FOR ORTEP.'
        ELSEIF ( ITS1 .EQ. 1) THEN
           WRITE (*,*) 'MO DISPLAY NOT AVAILABLE FOR STICKS.'
        ENDIF
        ISTYPE = (ISTYPE - (ISTYPE/10)*10) + 20
        IF ( AUDIN .EQ. 0 ) THEN
           CALL UPROMP( 'Which MO number (default is HOMO) ')
           COMAND = ' '
           READ ( *, '(A)', END=10) COMAND
           CALL LCLEAN( COMAND, COMAND,.TRUE.)
           IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
        ELSE
           READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        IF ( COMAND(:4) .EQ. 'HOMO') THEN
           MO = 6
        ELSEIF ( COMAND(:4) .EQ. 'LUMO') THEN
           MO = 7
        ELSE
           MO = READA( COMAND, 1, ERROR)
        ENDIF
        WRITE (*,*) 'SORRY, MO CODE IS NOT DONE YET.'
      ELSEIF (COMAND(1:1) .EQ. 'V') THEN
* TO DISPLAY VIBRATIONS FROM FILE
        CALL POPARG( COMAND, COMAND)
        IF ( ABS( VFREQ(1) ) .LT. 1.0D-2) THEN
           CALL DEBUGR( 'NO VIBRATION INFORMATION AVAILABLE.')
           COMAND = ' '
           GOTO 10
        ENDIF
        IF ( ITS1 .EQ. 2 ) THEN
           CALL DEBUGR('N.MODE DISPLAY NOT AVAILABLE FOR NAMODI.')
           CALL POPARG( COMAND, COMAND)
           GOTO 10
        ELSEIF ( ITS1 .EQ. 4) THEN
           CALL DEBUGR( 'N.MODE DISPLAY NOT AVAILALBE FOR ORTEP.')
           CALL POPARG( COMAND, COMAND)
           GOTO 10
        ENDIF
        REDRAW = .TRUE.
        NATOM1 = 0
        DO 14 I= 1, NATOMS
           IF ( IE( I) .LT. 99 ) NATOM1 = NATOM1 + 1
  14    CONTINUE
        IF ( AUDIN .EQ. 0 ) THEN
           IF ( COMAND( :1).EQ.' ') THEN
              CALL UPROMP('Which Normal mode '//
     .              '( [+1], 0 stops, -# reverses phase) ? ' )
              READ ( *, '(A)', END=10) COMAND
              CALL LCLEAN( COMAND, COMAND,.TRUE.)
              IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
           ENDIF
        ELSE
           READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        IDVECT = READA( COMAND, 1, ERROR)
        CALL POPARG( COMAND, COMAND)
        IPHASE = 1
        IF ( IDVECT .LT. 0 ) THEN
           IPHASE = -1
           IDVECT = -IDVECT
        ENDIF
        IF (ERROR) THEN
           IDVECT = 1
        ELSEIF (IDVECT .EQ. 0) THEN
*  TURN OFF THE NORMAL MODE DISPLAY
           ISTYPE = ITS1
           ITEMP = 0
           DO 70 I=1, NATOMS
              IF ( IE( I) .EQ. 200 ) GOTO 70
              ITEMP = ITEMP + 1
 70        CONTINUE
           NATOMS = ITEMP
           CALL DEBUGR( ' Stop NORMAL MODE display.' )
           GOTO 10
        ELSEIF ( IDVECT .GT. 3* NATOM1 ) THEN
           WRITE (*, '( 1X, ''MAXIMUM EIGENFUNCTION NUMBER IS '',I5)')
     .           3*NATOM1
           GOTO 10
        ENDIF
        ISTYPE = (ISTYPE - (ISTYPE/10)*10) + 40
        IREM( 99) = 99
        IREM( 200) = 200
        IB = 0
        NATOM1 = NATOMS
        NATOMS = 0
* LOOP THRU ATOMS TO SET WEIGHTS AND RESET NUMBER OF ATOMS
        DO 416 IA=1,NATOM1
           IB = IB + 1
           IF ( IE( IA) .LT. 200 ) NATOMS = NATOMS + 1
  416   CONTINUE

        CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
        CALL GMETRY( NUATOM, NATOMS, IE, XNDOGM, NA, NB, NC, CO, ERROR)
        CALL ORIENT( CO, IE, FORORE, IEFOR, DISPL, ANGLES )

        WRITE ( DUMMY, '('' MODE '', I5,'' WITH PHASE '',I2 )') 
     .           IDVECT, IPHASE
        CALL DEBUGR( DUMMY( 1: 26) )
        VSCALE = 0.5D0 * IPHASE
        ITEMP = 0
        NATOM1 = NATOMS
        DO 400 I= 1, NATOMS
          IF ( IE( I) .LT. 99 ) THEN
            IF ( DEBUG ) THEN
              WRITE ( DUMMY, '('' COORDS: '',3F9.6,
     .           ''; COMPTS: '',3F9.6)') (CO( J,I), J= 1,3),
     .           ( VIBVEC( ITEMP+J, IDVECT), J=1,3)
              CALL DEBUGR( DUMMY(1: 79) )
            ENDIF
            NATOM1 = NATOM1 + 1
            DO 401 J= 1, 3
  401       CO( J, NATOM1 ) = CO( J,I)+VIBVEC( ITEMP+J, IDVECT)*VSCALE
            IE( NATOM1) = 200
            NA( NATOM1) = I
            NB( NATOM1) = NA( I)
            NC( NATOM1) = NB( I)

C?            IF ( I .GT. 1) THEN
C?              NB( NATOM1 ) = NA( I)
C?              IF ( I .GT. 2) THEN
C?                NC( NATOM1) = NB( I)
C?              ELSEIF( NATOM1.GT.3) THEN
C?                NC( NATOM1) = 3
C?              ENDIF
C?            ENDIF

            IF( I.EQ.1) THEN
              IF( NATOM1.EQ.3) THEN
                NB( NATOM1) = 2
              ELSEIF( NATOM1.GT.3) THEN
                NB( NATOM1) = 2
                NC( NATOM1) = 3
              ENDIF
            ELSEIF( I.EQ.2) THEN
              IF( NATOM1.GT.3) NC( NATOM1) = 3
            ENDIF

            LOOPER = 0
  402       CONTINUE
            ITMP1 = NA( NATOM1)
            ITMP2 = NB( NATOM1)
            ITMP3 = NC( NATOM1)
            IF ( ITMP3 .LT. 1 ) ITMP3 = ITMP1
            CALL BANGLE( ITMP1, ITMP2, ITMP3, ANGLE, CO)
            IF ( ABS( ANGLE-180.0D0) .LT. 1.0D-2) THEN
              LOOPER = LOOPER + 1
              IF ( ITMP1.NE.1 .AND. ITMP2.NE.1 .AND. ITMP3.NE.1) THEN
                NC( NATOM1) = 1
                GOTO 402
              ELSEIF(ITMP1.NE.1 .AND. ITMP2.NE.1 .AND. ITMP3.NE.1) THEN
                NB( NATOM1) = 2
                GOTO 402
              ENDIF
              WRITE ( DUMMY, '('' DISPLAY: Could not rectify dihedral'',
     .   '' on atom '', I4, ''.'')' ) NATOM1
              CALL DEBUGR( DUMMY(1:60) )
            ENDIF
            IMASK( NATOM1) = 1
            ITEMP = ITEMP + 3
          ENDIF
  400   CONTINUE
        NATOMS = NATOM1
* NOW RE-CAST TRASNFORM GEOM WITH VIBRATIONS BACK TO "NORMAL" INTERNALS
c?        CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
c?        CALL GMETRY( NUATOM, NATOMS, IE, XNDOGM, NA, NB, NC, CO, ERROR)
      ELSEIF ( COMAND( 1: 1) .EQ. 'T' ) THEN
*  SETTING TITLE FOR DRAWING
        CALL POPARG( COMAND, COMAND)
        IF ( AUDIN .EQ. 0 ) THEN
           IF ( COMAND( 1:1) .EQ. ' ') THEN
              IF(LLEGND.EQ.' ') THEN
                WRITE ( *, *) ' What TITLE do you want? '
              ELSE
                WRITE(*,*) ' What TITLE do you want?  The default is:'
              ENDIF
              WRITE ( *, *) LLEGND( 1: MAX( 1, LLENG( LLEGND) ) )
              CALL UPROMP( ' New title: ')
              COMAND = ' '
              READ ( *, '(A)', END= 450) COMAND
              IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
           ENDIF
        ELSE
           READ( AUDIN, '(A)', END= 450) COMAND
        ENDIF
 450    IF ( LLENG( COMAND ) .LT. 1 ) THEN
            CALL UPROMP( 'Do you want to remove the title ? ')
            READ ( *, '(A)', END=450) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF( COMAND( 1: 1) .EQ. 'Y') THEN
              LLEGND = ' '
              CALL DEBUGR( 'Title removed.' )
            ELSE
              CALL DEBUGR( 'Title unchanged.' )
            ENDIF
        ELSE
           LLEGND = COMAND
        ENDIF
        COMAND = ' '
      ELSEIF (COMAND( 1: 1) .EQ. 'C') THEN
* TO SET NUMBER OF COORDINATES ON SCREEN
        CALL POPARG( COMAND, COMAND)
        IF ( AUDIN .EQ. 0 ) THEN
           IF ( COMAND( 1:1 ) .EQ. ' ') THEN
              WRITE ( *, '( 1X, ''Displaying '', I3, '' cartesian '',
     .          ''coordinates starting with atom '',I4,''.'')') 
     .            ISCRN, KOROFF
              CALL UPROMP( 'How many lines do you want ? ' )
              COMAND = ' '
              READ ( *, '(A)', END=10) COMAND
              CALL LCLEAN( COMAND, COMAND,.TRUE.)
              IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
           ENDIF
        ELSE
           READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        ITEMP1 = READA( COMAND, 1, ERROR)
        CALL POPARG( COMAND, COMAND)
        IF ( ERROR ) ITEMP1 = -1

        IF ( AUDIN .EQ. 0 ) THEN
           IF ( COMAND( 1:1 ) .EQ. ' ') THEN
             WRITE( DUMMY, 
     1   '('' Which coordinate should I start with ['',I3,'' ]'')')
     1         KOROFF
             CALL UPROMP( DUMMY(1: INDEX( DUMMY, ']')+1 ) )
             READ ( *, '(A)', END=10) COMAND
             CALL LCLEAN( COMAND, COMAND,.TRUE.)
             IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
           ENDIF
        ELSE
           READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        ITEMP2 = READA( COMAND, 1, ERROR)
        CALL POPARG( COMAND, COMAND)
        IF ( ERROR ) ITEMP2 = -1

        IF ( ITEMP1 .GE. 0) THEN
           ISCRN = ITEMP1
           REDRAW = .TRUE.
        ENDIF
        IF ( ITEMP2 .GE. 1) THEN
           KOROFF = ITEMP2
           REDRAW = .TRUE.
        ENDIF
        
      ELSEIF( COMAND( 1: 2) .EQ. 'MA') THEN
*  SET COLOR MAP
*  NUMBER   COLOR
*
*    1      WHITE
*    2      RED
*    3      GREEN
*    4      BLUE
*    5      CYAN
*    6      MAGENTA
*    7      YELLOW
*    8      ORANGE
*    9      GREEN-YELLOW
*   10      GREEN-CYAN
*   11      BLUE-CYAN
*   12      BLUE-MAGENTA
*   13      RED-MAGENTA
*   14      DARK GRAY
*   15      LIGHT GRAY
*
        CALL POPARG( COMAND, COMAND)
C?        IF(COMAND(1:1) .EQ. 'T' .OR. COMAND(1:1).EQ.'C') THEN
C?        ELSEIF( COMAND(1;1) .EQ. 'P' .OR. COMAND(1:1).EQ. 'H') THEN
C"        ELSE
C?          WRITE (*,*) 'Do you want the color map for the'
c?          WRITE (*,*) ' Terminal or the Plotter?')
C?        ENDIF
        CALL DEBUGR( 'CURRENT TERMINAL COLOR USE')
        DUMMY = ' '
        K = 1
        DO 2030 I= 1, 200
        DO 2020 J= 1, NATOMS
          IF ( IE( J) .EQ. I ) THEN
            ITEMP = ICOLAT( I)
            IF ( NCOLOR .LT. 1) THEN
              WRITE( DUMMY( K: ), '( A6, 1X, I3,'' '' )') ATSYMB( I),
     .                 ICOLAT( I )
            ELSE      
              IF( ITEMP.NE. MOD(ITEMP, 1+NCOLOR))THEN
                WRITE( DUMMY( K: ), '( A6, 1X, I3,''*'' )') ATSYMB( I),
     .                 MOD(ICOLAT( I ), NCOLOR)
              ELSE
                WRITE( DUMMY( K: ), '( A6, 1X, I3,'' '' )') ATSYMB( I),
     .                 MCOLOR( ICOLAT( I ) )
              ENDIF
            ENDIF
            K = K + 15
            IF( K.GE.65)THEN
              WRITE(*,*) DUMMY( 1:K)
              K = 1
            ENDIF
            GOTO 2030
          ENDIF
 2020   CONTINUE
 2030   CONTINUE
        IF( K.GT.1) CALL DEBUGR( DUMMY( 1: K ) )
        CALL DEBUGR( '*   means the result of modulo calculation.' )
        IF ( ISCOLO .GT. 0 ) THEN
          WRITE (*,'('' This terminal recognizes '',I3,
     .               '' colors.'')' ) NCOLOR
          WRITE (*,*)
     .' Nr. 1    2   3    4   5    6    7    8    9   10  11  12'//
     .'  13  14     15'
          WRITE (*,*)
     .'    Whi. Red Grn. Blu Cyan Mag. Yel. Orn. G-Y G-C B-C B-M'//
     .' R-M DkGra  LtGra'
          IF ( AUDIN .EQ. 0 ) THEN
            CALL UPROMP('Shall I KEEP or REMOVE colors? ')
            READ ( *, '(A)', END=10) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
          ELSE
            READ( AUDIN, '(A)', END=10) COMAND
          ENDIF
          IF ( COMAND( 1: 1) .EQ. 'R' ) THEN
            CALL POPARG( COMAND, COMAND)
            ISCOLO = 0
            CALL DEBUGR( 'Ok, no colors.' )
            REDRAW = .TRUE.
            GOTO 10
          ELSEIF ( COMAND(1:1) .EQ. 'K' .OR. COMAND(1:1) .EQ. ' ') THEN
            CALL POPARG( COMAND, COMAND)
            CALL DEBUGR( 'Ok, we keep.' )
          ENDIF
        ELSE
          CALL DEBUGR( 'THIS TERMINAL DOES NOT CURRENTLY USE COLOR.' )
          CALL UPROMP( 'How many colors would you like to use? ')
          READ( *, '(A)', END=10) COMAND
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          J = READA( COMAND, 1, ERROR)
          IF(ERROR)THEN
            CALL DEBUGR( 'I could not understand that.' )
            GOTO 10
          ELSE
            ISCOLO = J
            NCOLOR = J
          ENDIF
        ENDIF

        IF ( AUDIN .EQ. 0 ) THEN
          CALL UPROMP('Shall I CHANGE, KEEP, or REMOVE colors? ')
          READ ( *, '(A)', END=10) COMAND
          CALL LCLEAN( COMAND, COMAND, .TRUE.)
          IF ( AUDOUT .GT. 0 ) WRITE ( AUDOUT, '(A)') COMAND
        ELSE
          READ( AUDIN, '(A)', END=10) COMAND
        ENDIF
        IF ( COMAND( 1: 1) .EQ. 'R' ) THEN
          CALL POPARG( COMAND, COMAND)
          ISCOLO = 0
          CALL DEBUGR( 'Ok, no colors.' )
          REDRAW = .TRUE.
          GOTO 10
        ELSEIF ( COMAND(1:1) .EQ. 'K' .OR. COMAND(1:1) .EQ. ' ') THEN
          CALL POPARG( COMAND, COMAND)
          CALL DEBUGR( 'Ok, we keep.' )
        ELSEIF( COMAND(1:1) .EQ. 'C') THEN
          CALL DEBUGR( 'Changing Colors.' )
          CALL POPARG( COMAND, COMAND)
 4000     IF( COMAND(1:1) .EQ. ' ')THEN
            CALL UPROMP(
     .         ' Enter an Atomic Symbol or Number and a Color number: ')
            READ(*, '(A)', END=10) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
          ENDIF
          IF ( COMAND(1:1).GE.'A' .AND. COMAND(1:1).LE.'Z')THEN
            I = INDEX( COMAND, ' ')
            J = NUMELE( COMAND( 1: I) )
          ELSEIF( COMAND(1:1) .EQ. ' ')THEN
            GOTO 10
          ELSE
            J = READA( COMAND, 1, ERROR)
          ENDIF
          CALL POPARG( COMAND, COMAND)
          IF( COMAND(1:1) .EQ. ' ')THEN
            CALL UPROMP( 'What COLOR for this atom? ')
            READ(*, '(A)', END=10) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
          ENDIF
          K = READA( COMAND, 1, ERROR)
          CALL POPARG( COMAND, COMAND)
          IF( ERROR )THEN
            CALL DEBUGR( 'I couldn''t understand the color.' )
          ELSEIF( K.LE.0 .OR. K.GT.NCOLOR) THEN
            WRITE (*,*) 'Invalid color, ',NCOLOR,' is maximum.'
          ELSE
            ICOLAT( J) = K
            REDRAW = .TRUE.
            GOTO 4000
          ENDIF
        ENDIF
      ELSE
        CALL DEBUGR( 'I didn''t recognize that...try Help.' )
        COMAND = ' '
      ENDIF
      GO TO 10
 9000 RETURN
      END
