      SUBROUTINE INFO
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)
      INTEGER*2 ATBOND
      CHARACTER*80 COMAND,VNAME,FILEIN,FILOUT,FILPLT, LLEGND
      CHARACTER*80 KEYWRD, KOMENT, TITLE, STEMP, DUMMY
      CHARACTER*6 ATSYMB
      CHARACTER*3 FTYPE
      LOGICAL ERROR, VALMSG
      REAL DENMAT, BONDS
      REAL VFREQ, VIBVEC
      COMMON /SYMTRY/ ISYM(10,NUMATM)
      COMMON /KEYS/ KEYWRD, KOMENT, TITLE
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      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)
C?      COMMON /VANRAD/ VANRAD(200)
      COMMON /INTCOR/ XNDOGM(3, NUMATM), INTFRE(3, NUMATM)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM),
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /VALNCE/ MAXVAL(200)
      COMMON /LEGEND/ FILEIN,FILOUT,FILPLT, LLEGND
      COMMON /FINFO/ DELTAH,RC,GRAD,RCGRAD,VIP,DIPOLE, ICHARG
      COMMON /FINFOC/ FTYPE
      COMMON /DENSTY/ DENMAT( MPACK ), BONDS( MPACK )
      COMMON /FORCE/ VFREQ(3*NUMATM), VIBVEC(3*NUMATM,3*NUMATM), IDVECT
      COMMON /COMM/ COMAND
      COMMON / PATH / ICPATH, NPATH, PATH( 30)
      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
*
*
      DIMENSION ICOUNT( 200),IELEC(200)
      DIMENSION IRADUS( NUMATM), TRADUS( NUMATM)
C
      DATA IELEC/1,2,1,2,3,4,5,6,7,8,1,2,3,4,5,6,7,8,
     .           1,2,10*0,3,4,5,6,7,8,1,2,10*0,3,4,5,6,7,8,
     .           46*0,
     Z           100*0 /
**
** 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 )
**
**
C
  10  CALL LCLEAN( COMAND, COMAND, .TRUE.)
      IF ( COMAND(1:1) .NE. ' ') GOTO 11
      CALL UPROMP( 'Draw:INFO> ')
      READ (5,2000,END=4000) COMAND
  11  CALL LCLEAN( COMAND, COMAND, .TRUE.)
 2000 FORMAT (A80)
      IF (COMAND(:1) .GE. '0' .AND. COMAND(:1) .LE. '9') THEN
          IPT1 = READA( COMAND, 1, ERROR)
          CALL POPARG( COMAND, COMAND)
          IF (ERROR) THEN
             CALL DEBUGR( 'READA ERROR.')
             GOTO 10
          ENDIF
          IF (IPT1 .GT. NATOMS .OR. IPT1.LT.1) THEN
             WRITE (*,*) 'INVALID NUMBER',IPT1
             GOTO 10
          ENDIF
          IF (COMAND(:1).LT.'0' .OR. COMAND(:1).GT.'9') THEN
             WRITE (*,1005) IPT1,ATSYMB(IE(IPT1)),(CO(IZ,IPT1),IZ=1,3)
 1005        FORMAT (' Atom Nr. ',I3,', is ',A5,' at:',3F8.4,'; BONDS:')
             IIT = 1
             DO 26 J=1,NATOMS
                IF (J .EQ. IPT1) GOTO 26
                IF ( ATBOND( IPT1,J) .GT. 0 ) THEN
                   DIST=ATDIST(IPT1,J)
                   WRITE (STEMP( IIT:),1006) J,DIST
 1006              FORMAT ( 1X,' To: ',I3,' by ', F7.4,';' )
                   IIT = INDEX( STEMP( IIT:), ';') + IIT
                   IF ( IIT .GT. 59 ) THEN
                      WRITE ( *, '( A )' ) STEMP(:IIT-2)//'.'
                      STEMP = '      '
                     IIT = 1
                   ENDIF
               ENDIF
   26       CONTINUE
            IF ( IIT .GT. 3 ) WRITE ( *, '( A ) ' ) STEMP(:IIT-2)//'.'
            GOTO 10
         ENDIF
         IPT2 = READA( COMAND, 1, ERROR)
         CALL POPARG( COMAND, COMAND)
         IF (IPT2 .GT. NATOMS .OR. IPT2.LT.0) THEN
            WRITE ( DUMMY, '('' INVALID NUMBER'',I8)') IPT2
            CALL DEBUGR( DUMMY( 1: 24) )
            GOTO 10
         ENDIF
         IF (COMAND(:1).LT.'0' .OR. COMAND(:1).GT.'9') THEN
            DIST=ATDIST(IPT1,IPT2)
            WRITE (*,1015) IPT1,IPT2,DIST
 1015       FORMAT (1X,'Atoms',I4,' and',I4,' separated by',F12.6,
     1              ' Angstroms.')
            GOTO 10
         ENDIF
         IPT3 = READA( COMAND, 1, ERROR)
         CALL POPARG( COMAND, COMAND)
         IF (IPT3 .GT. NATOMS) THEN
            WRITE (*,*) 'INVALID NUMBER',IPT3
            GOTO 10
         ENDIF
          IF (COMAND(:1).LT.'0' .OR. COMAND(:1).GT.'9') THEN
            CALL BANGLE(IPT1,IPT2,IPT3,ANGLE, CO)
            WRITE (*,1025) IPT1,IPT2,IPT3,ANGLE
 1025       FORMAT (1X,'Angle',2(I4,','),I4,' is ',F10.6,
     1        ' degrees.')
            GOTO 10
         ELSE
            IPT4 = READA( COMAND, 1, ERROR)
            CALL POPARG( COMAND, COMAND)
            IF (IPT4 .GT. NATOMS) THEN
               WRITE (*,*) 'INVALID NUMBER',IPT4
               GOTO 10
            ENDIF
            CALL DIHED(IPT1,IPT2,IPT3,IPT4,ANGLE, CO)
            WRITE (*,1035) IPT1,IPT2,IPT3,IPT4,ANGLE
 1035       FORMAT (1X,'Atoms',3(I4,','),I4,' describe a',
     1              ' dihedral of ', F11.6,' degrees.')
            GOTO 10
         ENDIF
      ELSEIF( COMAND(1:3) .EQ. 'DOF') THEN
* FIND SPECIFIC DEGREE OF FREEDOM
        CALL POPARG( COMAND, COMAND)
        IF ( COMAND(1:1) .EQ. ' ') THEN
          CALL UPROMP('Which Degree of Freedom (DOF)do you want? ')
          READ( *, '(A)', END=10) COMAND
        ENDIF
        IFREE = READA( COMAND, 1, ERROR)
        CALL POPARG( COMAND, COMAND)
        IF (ERROR) THEN
           CALL DEBUGR('I do not understand that request.')
           GOTO 10
        ENDIF
        KCOUNT = 0
        DO 210 I= 1, NATOMS
        DO 210 J= 1, 3
           IF ( INTFRE( J, I) .EQ. 1 ) THEN
             KCOUNT = KCOUNT + 1
             IF ( KCOUNT .EQ. IFREE) THEN
               WRITE( DUMMY, '('' D.O.F. '',I4,'' IS FOR THE DISTANCE'',
     .              '' OF ATOM '',I4)') IFREE, I
               IF( J .EQ. 2) THEN
                 DUMMY( 25:32) = 'ANGLE'
               ELSEIF( J.EQ. 3) THEN
                 DUMMY( 25:32) = 'DIHEDRAL'
               ENDIF
               CALL DEBUGR( DUMMY(1:50) )
               GOTO 10
             ENDIF
           ENDIF
 210    CONTINUE
        WRITE( DUMMY, '('' SORRY, '',I4,'' IS THE MAXIMUM D.O.F.'')')
     .         KCOUNT
        CALL DEBUGR( DUMMY(1:30) )
      ELSEIF (COMAND(:1) .EQ. 'R' ) THEN
* search of atoms in a radius
*   Radius ## [RADIUS] [SS] 
*          where ## is atom number 
*                RADIUS is radius of search
*                SS is type of atom to look for
         CALL POPARG( COMAND, COMAND)
         IMATCH = 0
         IF ( COMAND( 1:1) .EQ. ' ') THEN
             CALL UPROMP( 'Search around what atom number? ')
             READ ( *, '(A)', END=10) COMAND
             CALL LCLEAN( COMAND, COMAND, .TRUE.)
         ENDIF
         ICTR = READA( COMAND, 1, ERROR)
         CALL POPARG( COMAND, COMAND)
         IF ( ICTR .LT. 1 .OR. ICTR .GT. NATOMS .OR. ERROR ) THEN
            CALL DEBUGR( 'Error on your atom number.')
            GOTO 10
         ENDIF
         IF ( COMAND( 1:1) .GE. '0' .AND. COMAND(1:1) .LE. '9' ) THEN
            RADIUS = READA( COMAND, 1, ERROR)
            CALL POPARG( COMAND, COMAND)
            IF ( RADIUS .LT. 5.0D-2 .OR. ERROR ) THEN
               CALL DEBUGR( 'I don''t understand the RADIUS.')
               GOTO 10
            ENDIF
         ELSE
            RADIUS = 5.0
         ENDIF
         IF ( COMAND( 1:1) .GE. 'A' .AND. COMAND( 1:1) .LE. 'Z') THEN
            I = INDEX( COMAND, ' ') - 1
            IMATCH = NUMELE( COMAND(1: I) )
            CALL POPARG( COMAND, COMAND)
            IF ( IMATCH .LT. 1 ) THEN
               CALL DEBUGR( 'I do not recognize that atomic symbol.')
               GOTO 10
            ENDIF
         ENDIF
         WRITE (*,'('' Search radius '', F8.2,'' about atom'', I4)')
     .              RADIUS, ICTR
         IF ( IMATCH .GT. 0 ) 
     .          WRITE (*, *) 'Matching only '//ATSYMB(IMATCH)
         IIIRAD = 0
         DO 1220 I= 1, NATOMS
            IF ( I .EQ. ICTR) GOTO 1220
            IF ( IMATCH .GT. 0 .AND. IMATCH .NE. IE( I ) ) GOTO 1220
            DIST=ATDIST(I, ICTR)
            IF ( DIST .LT. RADIUS ) THEN
               IIIRAD = IIIRAD + 1
               IRADUS( IIIRAD) = I
               TRADUS( IIIRAD) = DIST
            ENDIF
 1220    CONTINUE
         DO 1222 I= 1, IIIRAD-1
         DO 1222 J= I+1, IIIRAD
           IF ( TRADUS( I) .GT. TRADUS( J) ) THEN
             TEMP = TRADUS( I)
             TRADUS( I) = TRADUS( J)
             TRADUS( J) = TEMP
             ITEMP = IRADUS( I)
             IRADUS( I) = IRADUS( J)
             IRADUS( J) = ITEMP
           ENDIF
 1222    CONTINUE
         IIT = 1
         STEMP = ' '
         DO 1200 I= 1, IIIRAD
           WRITE (STEMP( IIT:), 1007) IRADUS( I), TRADUS( I)
           IIT = INDEX( STEMP( IIT:), ';') + IIT
           IF ( IIT .GT. 59 ) THEN
             WRITE ( *, '( A )' ) STEMP(:IIT-2)//','
             STEMP = ' '
             IIT = 1
           ENDIF
 1200    CONTINUE
 1007    FORMAT ( 1X,' Atom ',I3,' at ', F7.4,';' )
         IF ( IIT .GT. 3 ) THEN
            WRITE ( *, '( A )' ) STEMP(:IIT-2)//'.'
         ENDIF
      ELSEIF ( COMAND(1:1) .EQ. 'E' ) THEN
* user wants to know the Euler equivalent rotation
        CALL POPARG( COMAND, COMAND)
        CALL PREULR( THETA, PHI, PSI )
        WRITE ( DUMMY, 
     .    '('' EULERIAN EQUIVALENT: THETA='', F12.6,'' PHI='',
     .      F12.6, '' PSI='', F12.6)') THETA, PHI, PSI
        CALL DEBUGR( DUMMY( 1: 79) )
      ELSEIF (COMAND(1:1) .EQ. 'B' ) THEN
* user wants bond order information
        CALL POPARG( COMAND, COMAND)
        IF ( BONDS( 1 ) .LT. 1.0D-4 ) THEN
           CALL DEBUGR( 'No BONDORDER information present.')
        ELSE
           K = 0
           DO 4100 I = 1, NATOMS
           STEMP = ' '
           IL = 0
              DO 4200 J = 1, I
                 K = K + 1
                 WRITE ( STEMP(6*IL+1:), '(F5.3)') BONDS(K)
                 IL = IL + 1
                 IF ( IL .GE. 10 ) THEN
                    WRITE (*,*) STEMP(1:6*IL)
                    IL = 0
                 ENDIF
 4200         CONTINUE
              IF ( IL .GT. 0 ) WRITE (*,*) STEMP(1:6*IL)
 4100         CONTINUE
           ENDIF
      ELSEIF (COMAND(:1) .EQ. 'I') THEN
* USER ASKED FOR INFORMATION
        WRITE ( *, '( A )' ) ' FILE TYPE IS '//FTYPE
        IF ( FTYPE .EQ. 'ARC' .OR. FTYPE .EQ. 'OUT') THEN
           WRITE ( *, '( A79 )' ) KEYWRD
           WRITE ( *, '( A79 )' ) KOMENT
           WRITE ( *, '( A79 )' ) TITLE
           WRITE (*,3000) DELTAH, VIP
           WRITE (*,3020) GRAD, ICHARG
           IF (RCGRAD.NE.0.0 .OR. RC.NE.0.0) 
     .            WRITE (*,3010) RC, ICPATH, RCGRAD
           IF (DIPOLE .GT. 0.0D0) WRITE (*,3030) DIPOLE
 3000      FORMAT (1X, 'HEAT OF FORMATION      =  ',F12.5,
     .                 '  IONISATION POTENTIAL =  ',F12.5)
 3010      FORMAT (1X, 'REACTION COORDINATE ',F12.5,
     .                 '  on atom ',I4,' GRADIENT ',F12.5)
 3020      FORMAT (1X, 'GRADIENT NORM          =  ',F12.5,
     .                 '  CHARGE ON SYSTEM  ', I3)
 3030      FORMAT (1X, '  MOLECULAR DIPOLE     =  ',F12.5)

         ELSEIF( FTYPE .EQ. 'GEO') THEN
           WRITE ( *, '( A79 )' ) KEYWRD
           WRITE ( *, '( A79 )' ) KOMENT
           WRITE ( *, '( A79 )' ) TITLE
         ELSEIF( FTYPE .EQ. 'TEC') THEN
           WRITE (*, '(A79)' ) KEYWRD
           WRITE (*, '(A79)' ) KOMENT
           WRITE (*, '(A79)' ) TITLE
         ELSEIF( FTYPE.EQ.'DRC' ) THEN
           WRITE ( *, '( A79 )' ) KEYWRD
           WRITE ( *, '( A79 )' ) KOMENT
           WRITE ( *, '( A79 )' ) TITLE
           ETIME = DELTAH
           EXKIN = RC
           ENERR = GRAD
           EPOT = RCGRAD
           EKINET = VIP
           IREFNR = INT(DIPOLE)
           IPOINT = ICHARG
           WRITE ( *, 4010 )
           WRITE ( *, 4011 ) ETIME, IPOINT, EPOT, EKINET, EPOT+EKINET, 
     .        ENERR, IREFNR
 4010      FORMAT( ' ',
     .  '  FEMTOSEC  POINT  POTENTIAL  +   KINETIC  =   TOTAL  ',
     .  '     ERROR   REF')
 4011      FORMAT( ' ',
     .  F10.5, 3X,I4, 1X,F10.5, 2X,F10.5, 2X,F10.5, 2X,F10.5, 2X,I4 )   

         ELSEIF( FTYPE.EQ.'IRC') THEN
           WRITE ( *, '( A79 )' ) KEYWRD
           WRITE ( *, '( A79 )' ) KOMENT
           WRITE ( *, '( A79 )' ) TITLE
           ETIME = DELTAH
           EXKIN = RC
           ENERR = GRAD
           EPOT = RCGRAD
           EKINET = VIP
           IREFNR = INT(DIPOLE)
           IPOINT = ICHARG
           WRITE ( *, 4020 )
           WRITE ( *, 4021 ) IPOINT, EPOT, EKINET, EPOT+EKINET, 
     .        ENERR, IREFNR
 4020      FORMAT( ' ',
     .  '    POINT   POTENTIAL +   E. LOST   =   TOTAL    ',
     .  '   ERROR   REF')
 4021      FORMAT( ' ',
     .       5X,I4, 2X,F10.5, 2X,F10.5, 2X,F10.5, 2X,F10.5, 2X,I4 )   
         ENDIF
         CALL POPARG( COMAND, COMAND)

      ELSEIF (COMAND(:1) .EQ. 'D' ) THEN
        WRITE ( *, 8000 ) MAXHEV, MAXLIT, NUMATM
 8000 FORMAT(' Dimensioned: ',I4,' heavy + ',I4,' light =',I5,' total.')
         CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. 'T' ) THEN
*  CHECK TYPE OF TERMINAL
         WRITE ( *, '( '' ITTRM='', I4 )' ) ITTRM
         CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. 'Q' ) THEN
*  USER WISHES TO LEAVE OUR HAPPY ROUTINE
         CALL POPARG( COMAND, COMAND)
         RETURN
      ELSEIF (COMAND(:1) .EQ. 'N' ) THEN
*  SEARCH FOR NEAREST NEIGHBORS
         DMIN = 10000.0
         HMIN = 10000.0
         IHA = 0
         DO 51 IA = 1, NATOMS-1
            IF ( IE( IA) .LT. 1 .OR. IE(IA) .GT. 200 ) GOTO 51
            IF ( ATSYMB( IE( IA)) .EQ. 'XX') GOTO 51
            IF ( ATSYMB( IE( IA)) .EQ. 'DD') GOTO 51
            IF ( ATSYMB( IE( IA)) .EQ. 'LP') GOTO 51
            DO 50 IB = 1+IA, NATOMS
               IF ( IE( IB) .LT. 1 .OR. IE(IB) .GT. 200 ) GOTO 50
               IF ( ATSYMB( IE( IB)) .EQ. 'XX') GOTO 50
               IF ( ATSYMB( IE( IB)) .EQ. 'DD') GOTO 50
               IF ( ATSYMB( IE( IB)) .EQ. 'LP') GOTO 50
               DIST=ATDIST(IA,IB)
               IF (DMIN .GT. DIST ) THEN
                  DMIN = DIST
                  IIA = IA
                  IIB = IB
                  IF ( IE(IA).NE.1 .AND. IE(IB).NE.1) THEN
                     IHA = IA
                     IHB = IB
                     HMIN = DIST
                  ENDIF
              ENDIF
 50     CONTINUE
 51     CONTINUE
        WRITE (*,1050) IIA,IIB,DMIN
1050    FORMAT (1X,'Nearest neighbors are ',I4,' and',I4,' at ',
     1             F10.6,' Angstroms.')
        IF ( IHA.GT.0 .AND. IHA.NE.IIA) 
     .         WRITE (*, '('' Nearest HEAVY neighbors are '', I4,
     .         '' and '',I4,'' by '', F10.6,'' Angstroms.'' )' )
     .         IHA, IHB, HMIN
          CALL POPARG( COMAND, COMAND)

      ELSEIF( COMAND( 1:2) .EQ. 'VI' ) THEN
*  SHOW NORMAL MODES OF VIBRATION
        IREAL = 0
        DO 3500 ICCC=1, NATOMS
          IF( IE(ICCC).LT.99 ) IREAL = IREAL + 1
 3500   CONTINUE
        CALL POPARG( COMAND, COMAND)
        IF ( ABS( VFREQ(1)) .LT. 1.0D-4) THEN
          CALL DEBUGR( 'NO VIBRATION INFORMATION AVAILABLE.')
        ELSE
          IF ( COMAND( 1:1) .GE. '0' .AND. COMAND(1:1) .LE. '9') THEN
            ITEMP = READA( COMAND, 1, ERROR)
            CALL POPARG( COMAND, COMAND)
          ELSE
            ITEMP = 0
          ENDIF
          MAXMOD = NATOMS*3
          IF ( FTYPE.EQ. 'DRC') MAXMOD = 1
          IF ( FTYPE.EQ. 'IRC') MAXMOD = 1
          IF ( ITEMP .GT. 0 ) THEN
            IF( ITEMP.LE.MAXMOD) THEN
              WRITE ( *, '('' VIBRATION MODE '', I4)') ITEMP
              DO 1100 I= 0, IREAL-1
                WRITE ( *, '('' ATM. '', I4, '': '', 3F10.5)')
     .               I+1, ( VIBVEC( I*3+J, ITEMP), J= 1, 3)
 1100         CONTINUE
            ELSE
              WRITE( *,'('' TOO BIG, THE MAXIMUM IS '',I5)') MAXMOD
            ENDIF
          ELSE
            DO 1110 K= 1, MAXMOD
              WRITE ( *, '('' VIBRATION MODE '', I4)') K
              DO 1120 I= 0, IREAL-1
                WRITE ( *, '('' ATM. '', I4, '': '', 3F10.5)')
     .              I+1, ( VIBVEC( I*3+J, K), J=1, 3)
 1120         CONTINUE
 1110       CONTINUE
          ENDIF
        ENDIF
      ELSEIF (COMAND(1:2) .EQ. 'VA' ) THEN
*  CHECK FOR ANY ATOMS WHICH EXCEED "NORMAL" VALENCE"
        VALMSG = .FALSE.
        DO 68 I=1,NATOMS
          IF ( IE( I) .GT. 98 ) GOTO 68
          NBOND=0
          IIT = 0
          DO 62 J=1,NATOMS
            IF ( IE( J) .GT. 98) GOTO 62
            IF ( I .EQ. J ) GOTO 62
            IF ( ATBOND( I, J) .NE. 0 ) NBOND = NBOND + 1
  62      CONTINUE
          IF ( NBOND .GT. MAXVAL(IE(I)) ) THEN
            VALMSG = .TRUE.
            WRITE ( *,1060) ATSYMB(IE(I)),I,NBOND
1060        FORMAT (' Atom ',A4,I4,' has',I3,
     1             ' bonding neighbors.')
            IIT = 1
            STEMP = '      '
            DO 65 J=1,NATOMS
              IF ( I .EQ. J ) GOTO 65
              IF ( ATBOND( I, J) .NE. 0 ) THEN
                DIST=ATDIST(I,J)
                WRITE (STEMP( IIT:),1006) J,DIST
                IIT = INDEX( STEMP( IIT:), ';') + IIT
                IF ( IIT .GT. 59 ) THEN
                  VALMSG = .TRUE.
                  WRITE ( *, '( A )' ) STEMP(:IIT-2)//','
                  STEMP = '      '
                  IIT = 1
                 ENDIF
               ENDIF
  65         CONTINUE
           ELSEIF ( MAXVAL(IE(I))-NBOND .GT. 0) THEN
             IF ( IE( I) .EQ. 1 ) THEN
               VALMSG = .TRUE.
               WRITE (*, '('' HYDROGEN '',I4,'' has ZERO BONDS.'')') I
             ELSE
               NBOND = 0
               DO 66 J= 1, NATOMS
                 IF ( ATBOND( I, J) .NE. 0) THEN
                   IF( IE( J) .EQ. 6) NBOND = NBOND + 3
                   IF( IE( J) .EQ. 7) NBOND = NBOND + 3
                   IF( IE( J) .EQ. 8) NBOND = NBOND + 2
                   IF( IE( J) .EQ. 16) NBOND = NBOND + 2
                 ENDIF
  66           CONTINUE
               IF ( NBOND .LT. MAXVAL( IE( I)) ) THEN
                 VALMSG = .TRUE.
                 WRITE ( *, '( 1X, A6, '' NUMBER '', I4,
     .             '' MAY HAVE TOO FEW BONDS.'')') ATSYMB( IE( I)), I
               ENDIF
             ENDIF
           ENDIF
  68    CONTINUE
        IF ( IIT .GT. 3 ) WRITE ( *, '( A )' ) STEMP(:IIT-2)//'.'
        IF ( .NOT. VALMSG) CALL DEBUGR( 'All Valences seem OK.')
        CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. 'C') THEN
*  A COUNT OF ATOMS, FORMULA, ORBITALS, ETC.
        IHEAVY=0
        ILIGHT=0
        NELEC=-ICHARG
        DO 6 I=1, 200
 6        ICOUNT(I)=0
          IDUMMY=0
          DO 8 I=1,NATOMS
            ICOUNT(IE(I))=ICOUNT(IE(I))+1
            NELEC=NELEC+IELEC(IE(I))
            IF ( IE(I) .EQ. 1 ) THEN
              ILIGHT=ILIGHT+1
            ELSEIF ( IE(I) .EQ. 99 ) THEN
              IDUMMY=IDUMMY+1
            ELSE
              IHEAVY=IHEAVY+1
            ENDIF
8         CONTINUE
          WRITE (*,1070) IHEAVY,ILIGHT,IDUMMY,ILIGHT+4*IHEAVY,NELEC
 1070     FORMAT (1X, I4,' heavy, ',I4,' light',
     .        ' (',I3,' dummy) atoms with ',I4,' orbs',
     .        ' and ',I4,' elns.' )
          IF (NELEC/2*2 .NE. NELEC) WRITE (*,*) '* * * * * * * THIS',
     .       ' SYSTEM IS A RADICAL * * * * * * *'
          STEMP = ' Formula: '
          IIT = INDEX( STEMP, ':') + 1
          IF ( ICOUNT(6) .GT. 0) THEN
            IT=ICOUNT(6)
            STEMP( IIT:) = 'C'
            IIT = IIT + 1
            IF ( IT .GT. 1 .AND. IT .LT. 10 ) THEN
              WRITE ( STEMP(IIT:), '( I1 )') IT
              IIT = IIT + 2
            ELSEIF ( IT.GT.9 .AND. IT.LT.100) THEN
              WRITE ( STEMP(IIT:), '( I2 )') IT
              IIT = IIT + 3
            ELSEIF ( IT.GT.99 .AND. IT.LT.1000) THEN
              WRITE ( STEMP(IIT:), '( I3 )') IT
              IIT = IIT + 4
            ELSE
              IIT = IIT + 1
            ENDIF
            ICOUNT(6)=0
          ENDIF
          IF ( ICOUNT(1) .GT. 0) THEN
            IT=ICOUNT(1)
            STEMP( IIT: ) = 'H'
            IIT = IIT + 1
            IF ( IT .GT. 1 .AND. IT.LT.10) THEN
              WRITE ( STEMP(IIT:), '(I1)') IT
              IIT = IIT + 2
            ELSEIF( IT.GT.9 .AND. IT.LT. 100) THEN
              WRITE ( STEMP(IIT:), '(I2)') IT
              IIT = IIT + 3
            ELSEIF( IT.GT.99 .AND. IT.LT.1000) THEN
              WRITE ( STEMP(IIT:), '(I3)') IT
              IIT = IIT + 4
            ELSE
              IIT = IIT + 1
            ENDIF
            ICOUNT(1)=0
          ENDIF
          DO 9 I= 1, 200
             IF ( ICOUNT(I) .GT. 0) THEN
                IT=ICOUNT(I)
                STEMP( IIT: ) = ATSYMB( I )
                IIT = INDEX( STEMP( IIT:), ' ') + IIT - 1
                IF ( IT .GT. 1 .AND. IT.LT.10) THEN
                   WRITE ( STEMP(IIT:), '(I1)' ) IT
                   IIT = IIT + 2
                ELSEIF ( IT.GT.9 .AND. IT.LT.100) THEN
                   WRITE ( STEMP(IIT:), '(I2)') IT
                   IIT = IIT + 3
                ELSEIF ( IT.GT.99 .AND. IT.LT.1000) THEN
                   WRITE ( STEMP(IIT:), '(I3)') IT
                   IIT = IIT + 4
                ELSE
                   IIT = IIT + 1
                ENDIF
                ICOUNT(I)=0
                IF ( IIT .GT. 70 ) THEN
                   WRITE (*, '(A)') STEMP( 1: IIT)
                   STEMP = ' Formula (cont):'
                   IIT = INDEX( STEMP, ':')+1
                ENDIF
             ENDIF
 9        CONTINUE
          IF ( IIT .GT. INDEX(STEMP, ':')+2 )
     .                    WRITE (*, '( A )' ) STEMP(:IIT)
          CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. 'F') THEN
         IFILE = MAX( 1, INDEX(FILEIN,' ')-1 )
         WRITE (*,*) 'Input file:          '//FILEIN(:IFILE)
         CALL POPARG( COMAND, COMAND)
      ELSEIF (COMAND(:1) .EQ. 'H' .OR. COMAND(:1) .EQ. '?' ) THEN
         COMAND = 'DRAW INFORMATION'
         CALL HELP( COMAND )
         COMAND = ' '
      ELSEIF (COMAND(:2) .EQ. 'AU' ) THEN
         CALL DEBUGR( 'Program written by Maj Donn M. Storch, USAFA')
         CALL POPARG( COMAND, COMAND)
      ELSEIF ( COMAND(:1) .EQ. 'S' ) THEN
* user wants summary of symmetry information
         CALL POPARG( COMAND, COMAND)
         IF ( ISYM(1,1) .EQ. 0 ) THEN
            CALL DEBUGR( 'NO SYMMETRY INFORMATION.')
         ELSE
            CALL DEBUGR( ' SYMMETRY INFORMATION:' )
            DO 73 I= 1, NUMATM
               DO 74 J= 10, 1, -1
                  IF ( ISYM( J, I ) .NE. 0 ) GOTO 75
  74           CONTINUE
  75           IF ( J .GT. 0 ) THEN
                  WRITE (*, '('' REF:'',I4,'' FTN:'',I4,'' TO  '',
     .                    8I4 )' ) (ISYM(K,I),K=1,J)
               ELSE
                  GOTO 76
               ENDIF
  73        CONTINUE
  76        CONTINUE
         ENDIF
      ELSE
         CALL DEBUGR( 'You have lost me... try Help.')
         COMAND = ' '
      ENDIF
      GOTO 10
 4000 CONTINUE
      RETURN
      END
