      PROGRAM  DRAWII
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
C                MAIN ROUTINE OF DRAWING PROGRAM
C
C         NOTICE:  This program contains segments of code
C                  extracted in total from the packages:
C                     NAMOD - a perspective plotting program
C                     ORTEP - Oak Ridge Thermal Elipsoid Plotter
C                  The only "new" code consists of front-end and
C                  back-end logic to provide interactive operation
C                  along with various user services such as 
C                     EDIT, INFORMATION, DISPLAY MODIFICATION,
C                     STICK FIGURES, etc.
C    
C                  With the exception of the NAMODI and ORTEP segments,
C                  this program and associated subroutines lies TOTALLY
C                  within the area of PUBLIC DOMAIN.
C
C                                          MAJOR DONN M. STORCH, USAF
C                                              1986
C
C
      IMPLICIT REAL (A-H,O-Z)
      INCLUDE 'SIZES'
      REAL XMASS
      CHARACTER*80 FILEC,VNAME,FILEIN,FILOUT,FILPLT,FILMMI
      CHARACTER*80 KEYWRD,KOMENT,TITLE,COMAND, STRTMP, SUBCOM, LLEGND
      CHARACTER*80 DUMMY
      CHARACTER*3 FTYPE
      CHARACTER*4 EXTIN, EXTOUT, EXTPLT
      CHARACTER*1 ANSWER, ASCII, BELL
      CHARACTER*6 ATSYMB, ATLABS
      LOGICAL OPNERR, MODATA, ERROR, REDRAW,
     .        RBELL, DOSUB, RESET, FIRST
      INTEGER FLAGS, DEVTYP, LINWID, LINSPP, AUDIN, AUDOUT
      INTEGER*2 ATBOND
      DIMENSION COBAK(3, NUMATM),EVEC(3,3), INVERT( 3)
      DIMENSION TEMCO(3,NUMATM)
      DIMENSION DISPL( 3), ANGLES( 3)
      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 /FINFO/ DELTAH,RC,GRAD,RCGRAD,VIP,DIPOLE, ICHARG
      COMMON /FINFOC/ FTYPE
      COMMON /SYMTRY/ ISYM(10,NUMATM)
      COMMON /ASCIIC/ ASCII( 0: 255 )
      COMMON /ATMASS/ ATMASS ( NUMATM )
      COMMON /EXMASS/ XMASS( 200)
      COMMON /INTCOR/ XNDOGM(3, NUMATM), INTFRE(3, NUMATM)
      COMMON /KEYS/ KEYWRD,KOMENT,TITLE
      COMMON /COMM/ COMAND
      COMMON /FIRST/ FIRST
      COMMON /DEVICE/ ITYPE, ISCRN, KOROFF
      COMMON /ATSYMB/ ATSYMB( 200)
      COMMON /COLORS/ ICOLAT( 200)
      COMMON /LABELS/ ATLABS(NUMATM)
      COMMON /NAINTE/  NO,NUBOND,ITABLE,INDCL
      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
      COMMON /HCPY/ JHDEV
      COMMON /LEGEND/ FILEIN,FILOUT,FILPLT, LLEGND
C?      COMMON /VANRAD/ VANRAD(200)
C?      COMMON /ATMRAD/ ATMRAD(200)
      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
      COMMON /EDIT/ MODATA, REDRAW
      COMMON /VALNCE/ MAXVAL(200)
      COMMON /OUTPUT/ IPAPER,IPAGE
      COMMON /ALLROT/ ROTPRD(3,3)
      EQUIVALENCE ( BELL, ASCII(7))

	 DATA FIRST /.TRUE./
C
C##      DATA ATSYMB/
C##     .   'H',  'HE', 'LI', 'BE',  'B',  'C',  'N',  'O',  'F', 'NE',
C##     1   'NA', 'MG', 'AL', 'SI',  'P',  'S', 'CL', 'AR',  'K', 'CA',
C##     2   'SC', 'TI',  'V', 'CR', 'MN', 'FE', 'CO', 'NI', 'CU', 'ZN',
C##     3   'GA', 'GE', 'AS', 'SE', 'BR', 'KR', 'RB', 'SR',  'Y', 'ZR',
C##     4   'NB', 'MO', 'TC', 'RU', 'RH', 'PD', 'AG', 'CD', 'IN', 'SN',
C##     5   'SB', 'TE',  'I', 'XE', 'CS', 'BA', 'LA', 'CE', 'PR', 'ND',
C##     6   'PM', 'SM', 'EU', 'GD', 'TB', 'DY', 'HO', 'ER', 'TM', 'YB',
C##     7   'LU', 'HF', 'TA',  'W', 'RE', 'OS', 'IR', 'PT', 'AU', 'HG',
C##     8   'TL', 'PB', 'BI', 'PO', 'AT', 'RN', 'FR', 'RA', 'AC', 'TH',
C##     9   'PA',  'U', 'NP', 'PU', 'AM', 'CM', 'BK', 'CF', 'XX',  'D',
C##     .   '00',  'X',  'Z', 'DP', 'LP',  '+',  '-', '++', '--', 'ME',
C##     1   'ET','IPR','BUT', 'PH', 'CH','CH2','CH3', 'OH','GLY','ALA',
C##     2  'VAL','LEU','ILE','PHE','PRO','SER','THR','MET','CYS','TRP',
C##     3  'ASN','GLN','ASP','GLU','TYR','LYS','ARG','HIS', 'TV',  'R',
C##     4   'DD', 'CB','H2O','HOH', 6*'  ',
C##     5   '..', 49*' '/
C
C##      DATA VANRAD/
C##     .   0.37, 0.93, 1.34, 0.90, 0.82, 0.77, 0.75, 0.73, 0.72, 1.31,
C##     1   1.54, 1.30, 1.18, 1.11, 1.06, 1.02, 0.99, 1.74, 1.96, 1.74,
C##     2   1.44, 1.36, 1.34, 1.27, 1.26, 1.26, 1.25, 1.24, 1.38, 1.31, 
C##     3   1.26, 1.22, 1.19, 1.16, 1.14, 1.89, 2.11, 1.92, 1.62, 1.48, 
C##     4   1.46, 1.39, 1.36, 1.34, 1.34, 1.37, 1.53, 1.48, 1.44, 1.41, 
C##     5   1.38, 1.35, 1.33, 2.09, 2.25, 1.98, 1.69, 1.65, 1.65, 1.64, 
C##     6   1.63, 1.66, 1.85, 1.61, 1.59, 1.59, 1.58, 1.57, 1.56, 1.70, 
C##     7   1.56, 1.58, 1.46, 1.39, 1.37, 1.35, 1.36, 1.38, 1.50, 1.49, 
C##     8   1.48, 1.47, 1.46, 1.46, 1.45, 2.14, 2.40, 2.40, 2.40, 1.65,
C##     9   1.65, 7*1.42, 2*-10.0,
C##     .   9*-10.00, 0.77,
C##     H   8*0.75, 1.37, 1.50,
C##     I   10*1.50,
C##     J   8*1.50, -10., 0.77,
C##     L   -10.,1.0,-10.,-10., 6*-10.0,
C##     Z   50*-10.00 /
C
C##      DATA ATMRAD/
C##     .   0.37, 0.93, 1.34, 0.90, 0.82, 0.77, 0.75, 0.73, 0.72, 1.31,
C##     1   1.54, 1.30, 1.18, 1.11, 1.06, 1.02, 0.99, 1.74, 1.96, 1.74,
C##     2   1.44, 1.36, 1.34, 1.27, 1.26, 1.26, 1.25, 1.24, 1.38, 1.31, 
C##     3   1.26, 1.22, 1.19, 1.16, 1.14, 1.89, 2.11, 1.92, 1.62, 1.48, 
C##     4   1.46, 1.39, 1.36, 1.34, 1.34, 1.37, 1.53, 1.48, 1.44, 1.41, 
C##     5   1.38, 1.35, 1.33, 2.09, 2.25, 1.98, 1.69, 1.65, 1.65, 1.64, 
C##     6   1.63, 1.66, 1.85, 1.61, 1.59, 1.59, 1.58, 1.57, 1.56, 1.70, 
C##     7   1.56, 1.58, 1.46, 1.39, 1.37, 1.35, 1.36, 1.38, 1.50, 1.49, 
C##     8   1.48, 1.47, 1.46, 1.46, 1.45, 2.14, 2.40, 2.40, 2.40, 1.65,
C##     9   1.65, 7*1.42, 2*0.30,
C##     .   9*0.30, 0.77,
C##     H   8*0.75, 2*1.60,
C##     I   10*1.60,
C##     J   8*1.60, 0.30,0.77,
C##     L   0.30,1.0,0.30,0.30, 6*0.30,
C##     Z   50*0.30 /
C
C##      DATA MAXVAL / 
C##     .  1, 0, 1, 2, 3, 4, 3, 2, 1, 0,
C##     .  1, 2, 3, 4, 3, 2, 1, 0, 1, 2, 
C##     .  10*6, 
C##     .  6, 3, 4, 3, 2, 1, 0, 499, 499, 499,
C##     .  60*499,
C##     .  10*499,
C##     H  8*499, 2*2,
C##     I  10*2,
C##     J  8*2, 2*499,
C##     L  10*499,
C##     Z  50*499 /
*
C##      DATA XMASS / 1.0078250D0, 4.0026D0,  6.939D0,    9.0122D0,  
C##     .   10.811D0, 12.0D0, 14.067D0, 15.9994D0, 18.9984D0, 20.183D0,
C##     3   22.9898D0, 24.312D0,   26.9815D0,  28.086D0,
C##     .   30.9738D0, 32.064D0,   35.453D0,   39.948D0,
C##     4   39.102D0,  40.08D0,    44.956D0,   47.90D0,   50.942D0,
C##     .   51.996D0,  54.938D0,   55.847D0,   58.933D0,   58.71D0,
C##     .    63.54D0,  65.37D0,
C##     .   69.72D0,   72.59D0,    74.922D0,   78.96D0,   79.909D0,
C##     .   83.80D0,   85.47D0,    87.62D0,    88.905D0,   91.22D0,
C##     .  92.906D0,   95.94D0,
C##     .   98.00D0,   101.07D0,   102.905D0,  106.4D0,   107.870D0,
C##     .  112.40D0,   114.82D0,   118.69D0,   121.75D0,   127.60D0,
C##     .  126.904D0,  131.30D0,
C##     6  132.905D0,  137.34D0,   138.91D0,  140.12D0,   140.907D0,  
C##     .  144.24D0,   147.00D0,  150.35D0,  151.96D0,  157.25D0,   
C##     .  158.924D0,  162.50D0,   164.930D0, 167.26D0, 168.934D0,
C##     .  173.04D0,   174.97D0,  178.49D0,  180.948D0,  183.85D0,
C##     .  186.2D0,    190.2D0,    192.2D0,    195.09D0,  196.967D0,
C##     .  200.59D0,  204.37D0,   207.19D0,   208.980D0,  210.00D0,
C##     .  210.00D0,  222.00D0, 114*0.000D0 /
*
*  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
*
C##      DATA ICOLAT 
C##     .   /15,                                                13,
C##     .    13,13,                              13, 1, 4, 2, 3,13,
C##     .    13,13,                              13, 4,13, 7, 3,13,
C##     .    13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13, 3,13,
C##     .    13,13,13,13,13,13,13,13,13,13,13,13,13,13,13,13, 3,13,
C##     .    13,13,
C##     .       13,13,13,13,13,13,13,13,13,13,13,13,13,13,
C##     .          13,13,13,13,13,13,13,13,13,13,13,13,13,13, 3,13,
C##     .    13,13,
C##     .       13,13,13,13,13,13,13,13,13,13,13,13,13,13,
C##     .          13,13,13,13,13,13,13,13,13,13,13,13,13,13, 3,13,
C##     .   3, 1, 1, 1, 1, 1, 1, 3, 3, 7, 7, 1, 3, 3, 2, 2, 3, 4, 4, 4,
C##     .    4*13, 58*13 /

*
C
*  HERE WE SET THE TYPE OF OFF-LINE HARDCOPY GRAPHICS
*        THE VALUES OF JHDEV ARE:
*              1 =>  IDS PAPER TIGER
*              2 =>  EPSON FX-80
*              3 =>  DEC LA50
*              4 =>  ZENITH MPI-99
*              5 =>  Hewlet-Packard STYLE PEN PLOTTER
*
*
C
C LETS SET THE SCALE INFORMATION TO DEFAULT
C
      CALL MINMAX
C
      JHDEV = 5
      FTYPE = ' '
      KEYWRD = ' '
      TITLE  = ' '
      KOMENT = ' '
      VDIST = 20.0
      XBOUND = 12.0
      YBOUND = 12.0
C?      BORDER = 4.0
      BORDER = 2.0
      RETRAC = 0.000
C?      IN600 = 4
      IN600 = 3
      XCENTR = 0.00
      YCENTR = 0.00
C?      SCOR1 = 0.00
      SCOR1 = 2.00
      SCOR2 = 1.54
      REDUCT = 0.90
      NORATM = 2
      NORBON = 1
      NRBOND = 4
      BTHICK = 0.06
      XTITLE = -0.15
      YTITLE = -1.30
      THEIT = 0.35
      DO 3000 I= 0, 255
         ASCII( I ) = CHAR( I )
 3000 CONTINUE
      IFIRST=0
      ITABLE=1
      ITYPE = 0
      KOROFF = 1
      IPAPER=100
      IPAGE=100
      OPNERR = .FALSE.
      MODATA = .FALSE.
      REDRAW = .FALSE.
      DOSUB = .FALSE.
      SUBCOM = ' '
      FILEIN = ' '
      JHDEV = -ABS(JHDEV)
*
C      CALL SETTRM
*
*
* SET ISTYPE FOR STICK DRAWING
      ISTYPE = 1
* SET LATYPE FOR ATOM NUMBERING LABELS
      LATYPE = +1
      BSCALE = 1.4
      RESET = .TRUE.
      DEBUG = .FALSE.
      DEBUGL = .FALSE.
      DEBUGN = .FALSE.
      DEBUGO = .FALSE.
      DEBUGP = .FALSE.
      MODATA = .FALSE.
      COMAND = '   '
      EXTIN =  '.OUT'
      EXTOUT = '.DAT'
      EXTPLT = '.PLT'
*  FIRST ALLOW EACH INDIVIDUAL ATOM AND ALL TYPES
*        EXCEPT DUMMIES (TYPE=XX) AND EDITED ATOMS (TYPE=DD)
*           AND HIDDEN-DUMMIES (TYPE=..)
      DO 2 I= 1, 200
         IF ( ATSYMB(I)(1:2) .EQ. 'XX') THEN
            IREM(I) = I
         ELSEIF( ATSYMB(I)(1:2) .EQ. 'DD') THEN
            IREM(I) = I
         ELSEIF( ATSYMB(I)(1:2) .EQ. '..') THEN
            IREM(I) = I
         ELSE
            IREM(I) = 0
         ENDIF
  2   CONTINUE
      DO 3 I= 1, NUMATM
      IMASK(I)=0
    3 CONTINUE
      CALL PLOT(0,0,1)
      CALL PLOT (0,0,6)
      CALL PLOT (0,0,8)
      ICLR=ISCRN
      IF (ITYPE .EQ. 1) ICLR = 1
      IF ( ICLR .LT. 1) ICLR = 1
      CALL DEBUGR( '             DRAW: VERSION 2.00' )
      IR = 20
C?      OPEN(UNIT=20, STATUS='UNKNOWN', IOSTAT = ITEMP)
C?      INQUIRE( UNIT=IR, NAME= STRTMP, IOSTAT = ITEMP, EXIST = OPNERR )
C?      WRITE (*,*) STRTMP
C?      CLOSE( UNIT=20)
C?      IF(  OPNERR ) GOTO 3002
      CALL DEBUGR( ' ')
      CALL DEBUGR( '         by Maj. Donn Storch, USAF' )
      CALL DEBUGR( ' ' )
      CALL DEBUGR( '          Department of Chemistry' )
      CALL DEBUGR( 'United States Air Force Academy, CO 80840-5700' )
      CALL DEBUGR( ' ' )
      CALL DEBUGR( '       For HELP enter ? at any time.' )
      
* *********  HERE FOR NEW INPUT FILE ***************
   1  CONTINUE
      ISTYPE = MOD( ISTYPE, 10)
      CALL UPROMP( 'What is name of file ['//EXTIN//'] ')
      READ(5,'(A80)', END=4000) STRTMP
 3002 CONTINUE
      ISEMI = INDEX( STRTMP, ';')
      IF ( ISEMI .GT. 0) STRTMP( ISEMI:ISEMI) = '@'
 3001 ISLASH = INDEX( STRTMP, '/')
      IF ( ISLASH .GT. 0) THEN
         STRTMP( ISLASH: ISLASH) = '\\'
         GOTO 3001
      ENDIF
      CALL LCLEAN( STRTMP, STRTMP, .TRUE.)
      ISEMI = INDEX( STRTMP, '@')
      IF ( ISEMI .GT. 0) STRTMP( ISEMI:ISEMI) = ';'
* CHECK FOR HELP
      IF ( STRTMP(:1) .EQ. '?' ) THEN
         COMAND = 'DRAW'
         CALL HELP( COMAND )
         COMAND = ' '
         GOTO 1
      ENDIF
* CHECK FOR PRELIMINARY COMMANDS
 2222 IZZ = INDEX( STRTMP, '\\')
      IF (IZZ .GT. 0) THEN
         IF (STRTMP(IZZ+1:IZZ+3) .EQ. '-H') THEN
            IREM(1)=1
            STRTMP=STRTMP(:IZZ-1)//STRTMP(IZZ+3:)
            GOTO 2222
         ELSEIF (STRTMP(IZZ+1:IZZ+4) .EQ. '+XX') THEN
            IREM(99)=0
            STRTMP=STRTMP(:IZZ-1)//STRTMP(IZZ+4:)
            GOTO 2222
         ELSEIF ( STRTMP( IZZ+1:IZZ+6) .EQ. 'ORTEP') THEN
            ISTYPE = 4
            STRTMP = STRTMP( :IZZ-1)// STRTMP( IZZ+6: )
            GOTO 2222
         ELSEIF ( STRTMP( IZZ+1:IZZ+7) .EQ. 'NAMODI') THEN
            ISTYPE = 2
            STRTMP = STRTMP( :IZZ-1)// STRTMP( IZZ+7: )
            GOTO 2222
         ELSEIF ( STRTMP( IZZ+1: IZZ+7) .EQ. 'DEBUGI') THEN
            DEBUGI = .TRUE.
            STRTMP = STRTMP( :IZZ-1)//STRTMP( IZZ+7:)
            GOTO 2222
         ELSEIF ( STRTMP( IZZ+1:IZZ+6) .EQ. 'DEBUG') THEN
            DEBUG = .TRUE.
            STRTMP = STRTMP( :IZZ-1)//STRTMP( IZZ+6:)
            GOTO 2222
         ELSEIF ( STRTMP( IZZ+1:IZZ+6) .EQ. 'RETRO') THEN
            ITYPE = 7
            ISCRN = 20
            STRTMP = STRTMP( :IZZ-1)//STRTMP(IZZ+6:)
            GOTO 2222
         ENDIF
      ENDIF
      IF ( STRTMP(:1) .EQ. '*' ) THEN
         IF ( FILEIN(1:1) .EQ. ' ') THEN
           CALL DEBUGR('YOU WILL HAVE TO PROVIDE A FILE NAME FOR')
           CALL DEBUGR('SUBSEQUENT OPERATIONS.')
         ENDIF
         GOTO 6
      ENDIF
      FILEIN = STRTMP
      DO 1000 I=1, 80
C  CHECK FOR DIRECTORY/SUB DIRECTORY JUNK
         IF (STRTMP(I:I).EQ.']') INDIR=0
         IF (STRTMP(I:I).EQ.'[') INDIR=1
         IF (INDIR.EQ.1) GOTO 1000
         IF (STRTMP(I:I).EQ.'.') GOTO 1010
         IF (STRTMP(I:I).EQ.' ') GOTO 1005
 1000 CONTINUE
      CALL DEBUGR( ' ERROR IN HANDLING FILE NAMES.')
C APPLY DEFAULT EXTENSIONS
C     FIRST IS .ARC
C?1005  IF ( I .LT. 2 ) CALL QUIT
1005  IF ( I .LT. 2 ) GOTO 4000
      STRTMP(I:) = EXTIN
      IFILE = I + 4
      FILEIN=STRTMP
C    NOW  .PLT  FOR PLOT
1010  IFILE = I + 4
      STRTMP(I:) = EXTPLT
      FILPLT=STRTMP
C   NOW FOR THE OUTPUT FILE  .DAT
      STRTMP(I:) = EXTOUT
      FILOUT=STRTMP
C   NOW FOR THE MOLECULAR MECHANICS FILE .MMI
      STRTMP(I+1:)= 'MMI'
      FILMMI=STRTMP
C
  6   IF ( RESET ) THEN
         CALL ROTCLR
         RESET = .FALSE.
      ENDIF
      NATOMS = 0
      STRTMP = FILEIN
C?      LLEGND = FILEIN
      LLEGND = ' '
      IR = 20
      CALL GPRDR( IR, FILEIN, FTYPE, XNDOGM, IE, NATOMS, 
     .            NA, NB, NC, .TRUE. )
      IF ( FTYPE .NE. 'TEC' ) THEN
* RESET STRUCTURE TYPE IF IT IS SET FOR TEC FILE
         IF ( ISTYPE.EQ.9) ISTYPE = 1
         IF (NATOMS.LT.0) THEN
            CLOSE (UNIT= IR)
            IF (NATOMS .EQ. -100) THEN
              FILEIN = STRTMP
              CALL DEBUGR( 'END OF FILE' )
              GOTO 1
            ELSEIF (OPNERR) THEN
              OPNERR = .FALSE.
              GOTO 1
            ELSEIF (NATOMS .EQ. -1000) THEN
              CALL DEBUGR( 'NEW FILE' )
              FILEIN = STRTMP
              OPNERR = .TRUE.
              GOTO 111
            ELSE
              WRITE (*,*) 'DRAW: ERROR, NATOMS=',NATOMS
            ENDIF
         ENDIF
 8       CONTINUE
         IF ( FTYPE .NE. 'PDB' .AND. FTYPE .NE. 'GIP') THEN
            CALL GMETRY( NUATOM, NATOMS, IE, XNDOGM, 
     .                        NA, NB, NC, CO, ERROR)
            TEMPXX=CO(1,1)
            TEMPYY=CO(2,1)
            TEMPZZ=CO(3,1)
            CALL TOTROT(TEMPXX,TEMPYY,TEMPZZ)
         ENDIF
         IF ( IE( 1) .LE. NUMELE( 'GLY') ) CALL SETBON( .FALSE. )
         CALL SETLAB
         CALL PLOT(0,0,9)
90       DO 10 IA=1,NATOMS
            DO 10 J=1,3
            COBAK(J,IA)=CO(J,IA)
            COOLD(J,IA)=CO(J,IA)
            TEMCO(J,IA)=CO(J,IA)
  10     CONTINUE
C?         IF ( AUDIN .EQ. 0) CALL PICTUR
         CALL PICTUR
         DOSUB = .TRUE.
      ENDIF
111   CALL PLOT(0,0,8)
      IF (RBELL ) WRITE (*,'(1X,A)') BELL
      REDRAW = .FALSE.
      IF ( DOSUB ) THEN
         COMAND = SUBCOM
         DOSUB = .FALSE.
      ENDIF
      IF ( COMAND(:1) .NE. ' ') GOTO 300
      IF ( AUDIN .EQ. 0 ) THEN
         CALL UPROMP( 'DRAW> ' )
         READ (5, '(A)', END=4000) COMAND
      ELSE
         READ( AUDIN, '(A)', END=4000) COMAND
         WRITE ( *, '(A)') 'AUDIT-IN> '//COMAND(1:60)
      ENDIF
      CALL LCLEAN ( COMAND, COMAND, .TRUE.)
      IF ( AUDOUT .GT. 0 ) WRITE( AUDOUT, '(A80)') COMAND
300   IF (COMAND(:1) .EQ. 'H' .OR. COMAND(:1) .EQ. '?') THEN
         COMAND = 'DRAW'
         CALL HELP( COMAND )
         COMAND = ' '
      ELSEIF( COMAND( 1:3) .EQ. 'ORI') THEN
* TO ORIENT
         CALL ORIENT( TEMCO, IE, CO, IE, DISPL, ANGLES)
      ELSEIF (COMAND(:4) .EQ. 'BELL' ) THEN
         IF (RBELL ) THEN
            RBELL = .FALSE.
         ELSE
            RBELL = .TRUE.
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'B') THEN
         WRITE (*,'(1X,A)') BELL
      ELSEIF ( COMAND(:1) .EQ. 'C') THEN
         CALL POPARG( COMAND, COMAND)
         IF ( COMAND(:1) .EQ. ' ') THEN
            IF ( SUBCOM(:1) .EQ. ' ') THEN
                CALL DEBUGR( 'THERE IS NO COMMAND STORED.' )
            ELSE
               WRITE ( *, *) SUBCOM(:79)
            ENDIF
            CALL UPROMP( 'Draw: COMMAND> ')
            READ (*, '( A )' ) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( COMAND(:1) .EQ. 'Q') THEN
               SUBCOM = ' '
               CALL DEBUGR( 'COMMAND ERASED.' )
            ELSE
               SUBCOM = COMAND
            ENDIF
         ELSEIF ( COMAND(:1) .EQ. 'Q' ) THEN
            SUBCOM = '    '
            CALL DEBUGR( 'COMMAND ERASED.' )
         ELSE
            SUBCOM = COMAND
         ENDIF
         DOSUB = .TRUE.
         COMAND = '    '
         ELSEIF ( COMAND(:3) .EQ. 'REF' ) THEN
           CALL POPARG( COMAND, COMAND)
           CALL LCLEAN( COMAND, COMAND, .TRUE.)
           IF ( NATOMS .LT. 1 ) THEN
             CALL DEBUGR( 'No atoms present, option not premitted.' )
           ELSE
*  REFLECTION
*   CHECK FOR REFLECTION TYPE
             REDRAW = .FALSE.
             INVERT( 1) = 1
             INVERT( 2) = 1
             INVERT( 3) = 1
             IF ( COMAND( :1) .EQ. ' ') THEN
               CALL UPROMP( 
     .              'Specify reflection plane: XY, YZ, XZ, or INV: ')
               READ ( *, '( A )' ) COMAND
             ENDIF
             IF ( COMAND( :2).EQ.'XY' .OR. COMAND( :2).EQ.'YX' ) THEN
               INVERT( 3) = -1
               REDRAW = .TRUE.
             ELSEIF (COMAND(:2).EQ.'YZ'.OR.COMAND(:2).EQ.'ZY') THEN
               INVERT( 1) = -1
               REDRAW = .TRUE.
             ELSEIF (COMAND(:2).EQ.'XZ'.OR.COMAND(:2).EQ.'ZX') THEN
               INVERT( 2) = -1
               REDRAW = .TRUE.
             ELSEIF ( COMAND( :2) .EQ. 'IN') THEN
               INVERT( 1) = -1
               INVERT( 2) = -1
               INVERT( 3) = -1
               REDRAW = .TRUE.
             ELSE
               WRITE (*, *) 'NO REFLECTION SPECIFIED USE XY, YZ, OR XZ.'
             ENDIF
             IF ( REDRAW ) THEN
               CALL ROTSUM( dble(INVERT(1)), 0.0D0, 0.0D0, 0.0D0,
     .   dble(INVERT(2)), 0.0D0,0.0D0, 0.0D0, dble(INVERT(3)) )
               DO 41 IA = 1, NATOMS
                 DO 41 J = 1, 3
                   COBAK( J, IA) = CO( J, IA)
                   CO( J, IA) = CO( J, IA) * INVERT( J)
   41          CONTINUE
               CALL PICTUR
               REDRAW = .FALSE.
             ENDIF
          ENDIF
      ELSEIF ( COMAND(:3) .EQ. 'RES' ) THEN
         CALL POPARG( COMAND, COMAND)
         IF ( NATOMS.LT.1 ) THEN
            CALL DEBUGR( 'No atoms present.' )
            GOTO 111
         ENDIF
         IF ( ISTYPE .LT. 10 ) THEN
            CALL ROTCLR
            CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
            CALL GMETRY( NUATOM, NATOMS, IE, XNDOGM, 
     .                        NA, NB, NC, CO, ERROR)
            CALL SETBON( .FALSE. )
            CALL PICTUR
         ELSE
            CALL DEBUGR( 'RESET NOT PERMITTED IN THIS SITUATION.')
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'G') THEN
* Make GIP file
         FILEC = ' '
         CALL POPARG( COMAND, COMAND)
         ISTART = 0
5050     CONTINUE
         ITEMP = INDEX( COMAND, ' ')-1
         IF ((COMAND(1:1).GE.'0' .AND. COMAND(1:1).LE.'9') .AND.
     .      ( COMAND(ITEMP:ITEMP).GE.'0' .AND.
     .        COMAND(ITEMP:ITEMP).LE.'9')) THEN
           ISTART = READA( COMAND, 1, ERROR)
           IF( ERROR ) ISTART = 0
           CALL POPARG( COMAND, COMAND)
           GOTO 5050
         ELSEIF( COMAND(1:1) .NE. ' ') THEN
           FILEC = COMAND( 1: ITEMP)
           CALL POPARG( COMAND, COMAND)
           GOTO 5050
         ENDIF
         CALL GIPOUT( ISTART, FILEC )
      ELSEIF (COMAND(:2) .EQ. 'RO' .AND. NATOMS.GT.0 ) THEN
         REDRAW = .FALSE.
         DO 13 IA=1,NATOMS
            DO 13 J=1,3
               COOLD(J,IA)=CO(J,IA)
               COBAK(J,IA)=CO(J,IA)
   13    CONTINUE
         CALL POPARG( COMAND, COMAND)
         CALL ROTATE
         IF ( REDRAW ) THEN
            DO 14 IA=1,NATOMS
               DO 14 J=1,3
                  COOLD(J,IA)=CO(J,IA)
   14       CONTINUE
            CALL SETBON( .FALSE. )
            CALL PICTUR
            REDRAW = .FALSE.
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'S' .AND. NATOMS.GT.0 ) THEN
*  CALL AXIS AND PLACE MOLECULE BY SYMMETRY AXES
         CALL POPARG( COMAND, COMAND)
         IF (COMAND(:1) .EQ. ' ') THEN
            MASS = 2
         ELSE
            MASS = READA( COMAND, 1, ERROR)
            CALL POPARG( COMAND, COMAND)
         ENDIF
         IF(MASS.LE.1) MASS=2
         CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
         CALL GMETRY( NUATOM, NATOMS, IE, XNDOGM, 
     .                        NA, NB, NC, CO, ERROR)
         IB = 0
         DO 16 IA=1,NATOMS
            IB = IB + 1
            ATMASS( IB ) = XMASS( IE( IA ) )
            DO 15 J=1,3
               COOLD(J,IA)=CO(J,IA)
               COBAK(J,IA)=CO(J,IA)
  15        CONTINUE
  16     CONTINUE
         CALL ROTCLR
         CALL AXIS(CO, IB, CMOM, BMOM, AMOM, SUMW, MASS, EVEC)
         CALL ROTSUM( EVEC(1,1), EVEC(1,2), EVEC(1,3),
     .                EVEC(2,1), EVEC(2,2), EVEC(2,3),
     .                EVEC(3,1), EVEC(3,2), EVEC(3,3) )
         DO 17 IA=1,NATOMS
         DO 17 J=1,3
            COOLD(J,IA)=CO(J,IA)
  17     CONTINUE
         CALL SETBON( .FALSE. )
         TEMPXX=CO(1,1)
         TEMPYY=CO(2,1)
         TEMPZZ=CO(3,1)
         CALL TOTROT(TEMPXX,TEMPYY,TEMPZZ)
         CALL PICTUR
C?         WRITE (*,7000) AMOM,BMOM,CMOM
C? 7000    FORMAT (1X, 'MOMENTS OF INERTIA: A=',F10.6,', B=',F10.6,
C?     .        '; C=',F10.6 )
      ELSEIF (COMAND(1:6) .EQ. 'AUTHOR') THEN
         CALL DEBUGR( 
     .'This program was written by Major D.M. STORCH, at USAF Academy')
         CALL POPARG( COMAND, COMAND)
      ELSEIF ( COMAND( 1:1) .EQ. 'A' ) THEN
* REQUESTING AUDITING
         CALL POPARG( COMAND, COMAND)
         IF (COMAND( 1:1) .EQ. ' ') THEN
            CALL UPROMP(' Do you want INPUT or OUTPUT ? ')
            READ (*,'(A)', END=10) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
         ENDIF
         IF ( COMAND( 1:1) .EQ. 'I' ) THEN
            IF ( AUDIN .NE. 0 ) THEN
               CALL DEBUGR(' AUDIT input in progress.' )
               GOTO 111
            ENDIF
            CALL POPARG( COMAND, COMAND)
            IF (COMAND( 1:1) .NE. ' ') THEN
               CALL UPROMP(' What INPUT file [.AUD] ? ')
               READ(*, '(A)', END=10) DUMMY
            ELSE
               DUMMY = COMAND( 1: INDEX( COMAND, ' ') )
               CALL POPARG( COMAND, COMAND)
            ENDIF
            CALL LCLEAN( DUMMY, DUMMY, .TRUE.)
            IDOT = INDEX( DUMMY, '.')
            IF ( IDOT .LT. 1) DUMMY = DUMMY(1:LLENG(DUMMY))//'.AUD'
            OPEN( UNIT=2, FILE=DUMMY, STATUS='OLD', ERR= 4321)
            REWIND 2
            WRITE( DUMMY, '('' AUDIT INPUT FROM FILE '',A)') DUMMY
            CALL DEBUGR( DUMMY(1: LLENG( DUMMY) ) )
            AUDIN = 2
            GOTO 111
 4321     CONTINUE
            CALL DEBUGR(' I can''t open that file.')
            GOTO 111
         ELSEIF( COMAND( 1:1) .EQ. 'O') THEN
            IF ( AUDOUT .NE. 0 ) THEN
               CALL DEBUGR(' AUDIT output in progress.' )
               CALL UPROMP(' Shall I stop auditing ? ')
               READ( *, '(A)', END=10) DUMMY
               CALL LCLEAN( DUMMY, DUMMY, .TRUE.)
               IF ( DUMMY(1:1) .EQ. 'Y') THEN
                  CLOSE( AUDOUT )
                  AUDOUT = 0
                  CALL DEBUGR(' AUDIT output is ended, file closed.')
               ENDIF
               GOTO 111
            ENDIF
            IF (COMAND(:1) .NE. ' ') THEN
               CALL UPROMP(' What OUTPUT file [.AUD] ? ')
               READ(*, '(A)', END=10) DUMMY
            ELSE
               DUMMY = COMAND( 1: INDEX( COMAND, ' ') )
               CALL POPARG( COMAND, COMAND)
            ENDIF
            CALL LCLEAN( DUMMY, DUMMY, .TRUE.)
            IDOT = INDEX( DUMMY, '.')
            IF ( IDOT .LT. 1) DUMMY = DUMMY(1:LLENG(DUMMY))//'.AUD'
            OPEN( UNIT=3, FILE=DUMMY, STATUS='NEW', ERR= 4341)
            REWIND 3
            WRITE( DUMMY, '('' AUDIT OUTPUT TO FILE '',A)') DUMMY
            CALL DEBUGR( DUMMY(1: LLENG( DUMMY) ) )
            AUDOUT = 3
            GOTO 111
 4341      CONTINUE
            CALL DEBUGR(' I cannot open that output file.')
            GOTO 111
         ENDIF
      ELSEIF (COMAND(1:1) .EQ. 'T') THEN
*  TERMINAL COMMAND
         CALL POPARG( COMAND, COMAND)
         IF (COMAND(:1) .EQ. ' ') THEN
            IF (ITYPE .EQ. 0) THEN
               WRITE (*,501) 'NON-GRAPHIC'
            ELSEIF (ITYPE .EQ. 1) THEN
               WRITE (*,501) '4025 (TEKTRONIX)'
            ELSEIF (ITYPE .EQ. 2) THEN
               WRITE (*,501) 'PRO350'
            ELSEIF (ITYPE .EQ. 3) THEN
C?               WRITE (*,501) 'USAFA TERAK 8600'
            ELSEIF (ITYPE .EQ. 4) THEN
               WRITE (*,501) 'USAFA VT10X'
            ELSEIF (ITYPE .EQ. 5) THEN
               WRITE (*,501) '41xx (TEKTRONIX)'
            ELSEIF (ITYPE .EQ. 6) THEN
               WRITE (*,501) 'DEC GIGI'
            ELSEIF (ITYPE .EQ. 7) THEN
               WRITE (*,501) 'RETRO-GRAPHICS ON VT-102'
            ELSEIF (ITYPE .EQ. 8) THEN
               WRITE (*,501) 'DEC 240'
            ELSEIF (ITYPE .EQ. 9) THEN
               WRITE (*,501) '4010 (TEKTRONIX)'
            ELSEIF (ITYPE .EQ. 10) THEN
               WRITE (*,501) 'HP GRAPHIC LANGUAGE'
            ELSEIF (ITYPE .EQ. 11) THEN
               WRITE (*,501) 'APOLLO COLOR WORKSTATION'
	    ELSEIF (ITYPE .EQ. 12) THEN
               WRITE (*,501) 'APOLLO MONO WORKSTATION'
            ELSEIF (ITYPE .EQ. 15) THEN
	       WRITE (*,501) 'X11 WORKSTATION'
            ELSEIF (ITYPE .EQ. 16) THEN
	       WRITE (*,501) 'X11 WORKSTATION'
            ELSE
               WRITE (*,*) 'ERROR: Bad terminal type, ITYPE=',ITYPE
            ENDIF
 501     FORMAT (' Current terminal type is ',A,'.' )
  510       CALL UPROMP( 'Draw:TERMINAL> ')
            READ (5, '(A80)', END=502) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
         ENDIF
         NTYPE = ITYPE
         IF (COMAND(:1) .EQ. 'N' ) THEN
            NTYPE = 0
            ISCRN = 20
         ELSEIF (COMAND(:4) .EQ. '4025') THEN
            NTYPE = 1
            ISCRN = 26
         ELSEIF (COMAND(:3) .EQ. 'PRO') THEN
            NTYPE = 2
            ISCRN = 0
         ELSEIF (COMAND(:3) .EQ. 'TER') THEN
C?            NTYPE = 3
C?            ISCRN = 26
            ISCRN = 0
           CALL DEBUGR('That type is no longer available.')
         ELSEIF (COMAND(:2).EQ.'41') THEN
            NTYPE = 5
            ISCRN = 26
         ELSEIF (COMAND(:4) .EQ. 'GIGI') THEN
            NTYPE = 6
         ELSEIF (COMAND(:4) .EQ. 'RETR') THEN
            NTYPE = 7
            ISCRN = 24
         ELSEIF (COMAND(:3) .EQ. '240' .OR. 
     .           COMAND(:3) .EQ. '241' .OR.
     .           COMAND(:6) .EQ. 'DEC240' .OR.
     .           COMAND(:6) .EQ. 'DEC241' .OR.
     .           COMAND(:5) .EQ. 'VT240' .OR.
     .           COMAND(:5) .EQ. 'VT241' ) THEN
            NTYPE = 8
            ISCRN = 20
         ELSEIF (COMAND(:3) .EQ. '401' ) THEN
            NTYPE = 9
            ISCRN = 24
         ELSEIF (COMAND(:2) .EQ. 'HP' ) THEN
            NTYPE = 10
            ISCRN = 24
	 ELSEIF (COMAND(:5) .EQ. 'APCOL') THEN
            NTYPE = 11
            ISCRN = 24
	 ELSEIF (COMAND(:5) .EQ. 'APMON') THEN
            NTYPE = 12
            ISCRN = 24
	 ELSEIF (COMAND(:9) .EQ. 'BIG-COLOR') THEN
            NTYPE = 13
            ISCRN = 40
	 ELSEIF (COMAND(:8) .EQ. 'BIG-MONO') THEN
            NTYPE = 14
            ISCRN = 40
	 ELSEIF (COMAND(:4) .EQ. 'XCOL' ) THEN
            NTYPE = 15
            ISCRN = 24
	 ELSEIF (COMAND(:4) .EQ. 'XMON' ) THEN
            NTYPE = 16
            ISCRN = 24
         ELSEIF ( COMAND(:1) .EQ. 'H' .OR. COMAND(:1) .EQ. '?' ) THEN
            COMAND = 'DRAW TERMINAL'
            CALL HELP ( COMAND )
            COMAND = '    '
            GOTO 510
         ENDIF
 502     IF ( NTYPE .NE. ITYPE) THEN
            CALL PLOT( 0, 0, 0)
            ITYPE = NTYPE
            CALL PLOT(0,0,1)
            CALL PLOT(0,0,6)
            CALL PLOT(0,0,8)
            CALL POPARG( COMAND, COMAND)
            GOTO 90
         ENDIF
         CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:5) .EQ. 'DEBUG') THEN
 333       CONTINUE
           CALL POPARG( COMAND, COMAND)
           IF ( COMAND( :1) .NE. ' ') GOTO 334
           WRITE ( *, *) 'DEBUG:    L  N  O  P  I'
           WRITE ( *, '( 6X, 6( 2X, L1) )' ) DEBUG, DEBUGL, DEBUGN,
     .             DEBUGO, DEBUGP, DEBUGI
           CALL UPROMP( 'Draw: DEBUG> ')
           READ ( *, '( A )' ) COMAND
           CALL LCLEAN( COMAND, COMAND, .TRUE.)
 334       IF ( COMAND( :1) .EQ. ' ' .OR. COMAND(:1) .EQ. 'Q' ) THEN
              CONTINUE
           ELSE
              IF ( COMAND(:6) .EQ. 'DEBUG ') THEN
                 DEBUG = .NOT. DEBUG
              ELSEIF (COMAND(:6).EQ.'DEBUGL'.OR.COMAND(:1).EQ.'L') THEN
                 DEBUGL = .NOT. DEBUGL
              ELSEIF (COMAND(:6).EQ.'DEBUGN'.OR.COMAND(:1).EQ.'N') THEN
                 DEBUGN = .NOT. DEBUGN
              ELSEIF (COMAND(:6).EQ.'DEBUGO'.OR.COMAND(:1).EQ.'O') THEN
                 DEBUGO = .NOT. DEBUGO
              ELSEIF (COMAND(:6).EQ.'DEBUGP'.OR.COMAND(:1).EQ.'P') THEN
                 DEBUGP = .NOT. DEBUGP
              ELSEIF (COMAND(:6).EQ.'DEBUGI'.OR.COMAND(:1).EQ.'I') THEN
                 DEBUGI = .NOT. DEBUGI
              ENDIF
              GOTO 333
          ENDIF
      ELSEIF (COMAND(:1) .EQ. 'D') THEN
          CALL POPARG( COMAND, COMAND)
          CALL DSPLAY
          IF ( REDRAW ) THEN
             CALL SETBON( .FALSE. )
             CALL PICTUR
             REDRAW = .FALSE.
          ENDIF
      ELSEIF (COMAND(:2) .EQ. 'MM' .AND. NATOMS.GT.0 ) THEN
*  MOLECULAR MECHANICS FILE GENERATION
          CALL POPARG( COMAND, COMAND)
          IF (COMAND(:1) .NE. '*' .AND. COMAND(:1) .NE. ' ') THEN
             IDOT=INDEX(COMAND,'.')
             IF (IDOT .LT. 1) 
     .         COMAND=COMAND(:INDEX(COMAND,' ')-1)//'.MMI'
             FILMMI=COMAND
          ELSEIF (COMAND(:1) .EQ. '*') THEN
             IBRAK=INDEX(FILMMI,']')
             IF (IBRAK .GT. 2) FILMMI=FILMMI(IBRAK+1:)
             CALL POPARG( COMAND, COMAND)
          ENDIF
          CALL MMIOUT( FILMMI )
      ELSEIF (COMAND(:2) .EQ. 'MO' ) THEN
          IF ( NATOMS.LT.1 ) THEN
             CALL DEBUGR( 'No atoms present.' )
          ELSE 
*  MOVE THE GEOMETRY
             DO 18 IA=1,NATOMS
                 DO 18 J=1,3
                    COBAK(J,IA)=CO(J,IA)
   18        CONTINUE
             CALL MOVE
             IF ( REDRAW ) THEN
                DO 19 IA=1,NATOMS
                   DO 19 J=1,3
                      COOLD(J,IA)=CO(J,IA)
   19           CONTINUE
                CALL SETBON( .FALSE. )
                CALL PICTUR
                MODATA = .TRUE.
                REDRAW = .FALSE.
             ENDIF
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'Q') THEN
          GOTO 4000
      ELSEIF (COMAND(:1) .EQ. 'I') THEN
* REQUEST FOR INFORMATION
          CALL POPARG( COMAND, COMAND)
          CALL INFO
          DOSUB = .FALSE.
          GOTO 111
      ELSEIF (COMAND(:1) .EQ. 'P') THEN
* PRODUCE PLOTTER FILE
         IPAP2=IPAPER
         CALL POPARG( COMAND, COMAND)
 40      CONTINUE
         ITEMP = INDEX( COMAND, ' ')-1
         IF (( COMAND(:1) .GE. '0' .AND. COMAND(:1) .LE. '9') .AND.
     .      (COMAND(ITEMP:ITEMP).GE.'0' .AND. 
     .       COMAND(ITEMP:ITEMP).LE.'9')) THEN
            ITEMP=READA(COMAND,1,ERROR)
            IF (ERROR) THEN
               WRITE (*,*) 'ERROR, PLOT SCALE IS ',IPAPER
            ELSE
               IPAPER=ITEMP
            ENDIF
         ELSEIF (COMAND(:1) .NE. '*' .AND. COMAND(:1) .NE. ' ') THEN
            IDOT=INDEX(COMAND,'.')
            IF (IDOT .LT. 1) 
     .         COMAND=COMAND(:INDEX(COMAND,' ')-1)//EXTPLT
            FILPLT=COMAND
         ELSEIF (COMAND .EQ. '*') THEN
            IBRAK=INDEX(FILPLT,']')
            IF (IBRAK .GT. 2) FILPLT=FILPLT(IBRAK+1:)
            CALL POPARG( COMAND, COMAND)
         ENDIF
         CALL POPARG( COMAND, COMAND)
         IF (COMAND(:1) .NE. ' ') GOTO 40
         IF (IPAPER .LT. 10) IPAPER = 100 / IPAPER
         CALL OUTPLT
         IPAPER=IPAP2
         ITEMP=INDEX(FILPLT,' ')
      ELSEIF (COMAND(:1) .EQ. 'L' .AND. NATOMS.GT.0 ) THEN
          DO 50 IA=1,NATOMS
             DO 50 J=1,3
                CO(J,IA) = COBAK(J,IA)
   50     CONTINUE
          CALL POPARG( COMAND, COMAND)
          GOTO 90
      ELSEIF( COMAND(1:3) .EQ. 'NEW') THEN
          COMAND = ' '
          CALL DEBUGR( ' Quitting current file...')
          IR = -IR
          CALL GPRDR( IR, FILEIN, FTYPE, XNDOGM, IE, NATOMS, 
     .            NA, NB, NC, .TRUE. )
          GOTO 1
      ELSEIF (COMAND(1:1) .EQ. 'N') THEN
* NEXT GEOMETRY DESCRIPTION
          IF ( COMAND(2:2) .EQ. '+') COMAND(2: ) = ' '//COMAND(2:)
          KPOINT = 0
 55       CONTINUE
          CALL POPARG( COMAND, COMAND)
          RESET = .FALSE.
          IF (COMAND(:1) .EQ. 'R') THEN
            RESET = .TRUE.
            GOTO 55
         ELSEIF ( COMAND(1:1) .EQ. '+') THEN
           KPOINT = READA( COMAND, 2, ERROR)
           IF( ERROR ) THEN
             CALL DEBUGR( 'I don''t understand the point number.')
             GOTO 111
           ENDIF
           KPOINT = KPOINT + ICHARG
* NOTE: ICHARG IS USED AS NUMBER OF CURRENT POINT FOR DRC'S
           GOTO 55
         ELSEIF ( COMAND(1:1) .GE. '0' .AND. COMAND(1:1) .LE. '9' ) THEN
           KPOINT = READA( COMAND, 1, ERROR)
           GOTO 55
         ENDIF
         IF ( (FTYPE.EQ.'DRC' .OR. FTYPE.EQ.'IRC')
     .           .AND. KPOINT.GT.0 ) THEN
 3111       CALL GPRDR( IR, FILEIN, FTYPE, XNDOGM, IE, NATOMS, 
     .            NA, NB, NC, .TRUE. )
            IF ( NATOMS .LT. 0 ) THEN
               WRITE(*,'('' END OF DRC/IRC FILE...LAST POINT IS '',I8)')
     .                 ICHARG
            ELSE
               IF ( KPOINT .GT. ICHARG) GOTO 3111
               IF ( KPOINT .LT. ICHARG) 
     .             WRITE (*,'('' Closest following point is '',I8)')
     .                   ICHARG
            ENDIF
            GOTO 8
         ELSE
           DO 56 I = 1, KPOINT
             CALL GPRDR( IR, FILEIN, FTYPE, XNDOGM, IE, NATOMS, 
     .          NA, NB, NC, .TRUE. )
             IF ( NATOMS .LT. 0 ) THEN
                  WRITE(*, '('' END OF INPUT FILE...LAST POINT IS '',
     .                 I8)') ICHARG
                GOTO 8
             ENDIF
  56       CONTINUE
         ENDIF
         GOTO 6
      ELSEIF( COMAND(1:3) .EQ. 'EXT') THEN
*  EXTRACT FROM IRC/DRC FILE
         IF( FTYPE .NE. 'DRC' .AND. FTYPE.NE.'IRC')THEN
           CALL DEBUGR( 'Sorry, this is the wrong file type.')
         ELSE
           CALL DRCEXT
         ENDIF
      ELSEIF (COMAND(1:1) .EQ. 'E') THEN
*  SET UP FOR EDIT COMMAND
         DO 20 IA=1,NATOMS
           DO 20 J=1,3
             COOLD(J,IA)=CO(J,IA)
             COBAK(J,IA)=CO(J,IA)
   20    CONTINUE
         CALL POPARG( COMAND, COMAND)
         CALL EDITOR
         IF ( REDRAW ) THEN
           DO 21 IA=1,NATOMS
             DO 21 J=1,3
               COOLD(J,IA)=CO(J,IA)
               COBAK(J,IA)=CO(J,IA)
   21      CONTINUE
           CALL SETBON( .FALSE. )
           CALL PICTUR
           REDRAW = .FALSE.
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'O') THEN
*  OUTPUT COMMAND TO MAKE A DATA FILE
         CALL POPARG( COMAND, COMAND)
         IF (COMAND(:1) .NE. '*' .AND. COMAND(:1) .NE. ' ') THEN
            IDOT=INDEX(COMAND,'.')
            IF (IDOT .LT. 1) 
     .         COMAND=COMAND(:INDEX(COMAND,' ')-1)//EXTOUT
            FILOUT=COMAND
         ELSEIF (COMAND .EQ. '*') THEN
            IBRAK=INDEX(FILOUT,']')
            IF (IBRAK .GT. 2) FILOUT=FILOUT(IBRAK+1:)
         ENDIF
         CALL POPARG( COMAND, COMAND)
         IF( NATOMS .LT. 1 ) THEN
           CALL DEBUGR( 'OUTPUT forbidden because there are no atoms.')
           GOTO 111
         ENDIF
         OPEN (UNIT=7,FILE=FILOUT,STATUS='NEW', ERR=92)
         REWIND 7
         CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
         CALL MNDOUT
         CLOSE (UNIT=7)
         ITEMP=INDEX(FILOUT,' ')
         WRITE (*,*) 'Internal coordinates written to '//FILOUT(:ITEMP)
         MODATA = .FALSE.
         GOTO 111
 92      WRITE (*,*) 'ERROR OPENING: '//FILOUT(:ITEMP)//'  ABORTED.'
      ELSE
         CALL DEBUGR( 'I don''t understand')
         COMAND = '    '
      ENDIF
      CALL POPARG( COMAND, COMAND)
      DOSUB = .FALSE.
      GOTO 111
 4000 CONTINUE
      IF ( AUDIN .GT. 0 ) THEN
         CLOSE( AUDIN)
         AUDIN = 0
         CALL DEBUGR( 'End of AUDIT INPUT, reverting to manual input.')
         GOTO 111
      ENDIF
      IF (MODATA ) THEN
         CALL DEBUGR( 'You have not saved your modified geometry.')
         CALL DEBUGR( 'Use OUTPUT command to save new geometry or')
         CALL DEBUGR( 'repeat the command to quit without save.')
         MODATA = .FALSE.
         CALL POPARG( COMAND, COMAND)
         GOTO 111
      ELSE
C?         CALL QUIT
         CALL PLOT( 0, 0, 0)
         STOP ' '
      ENDIF
      END
