      SUBROUTINE MOVE
      INCLUDE 'SIZES'
      IMPLICIT REAL (A-H,O-Z)
      DIMENSION XDIST( NUMATM),YDIST( NUMATM),ZDIST( NUMATM)
      DIMENSION IGROUP( NUMATM)
      CHARACTER*80 VNAME,TITLE,COMAND
      LOGICAL ERROR, MODATA, REDRAW
      REAL VFREQ, VIBVEC
      COMMON/ATOMS/ CO(3, NUMATM),IE( NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON/GEOM/ COOLD(3, NUMATM),NA( NUMATM),NB( NUMATM),NC( NUMATM)
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /COMM/ COMAND
      COMMON /EDIT/ MODATA, REDRAW
      COMMON /FORCE/ VFREQ(3*NUMATM), VIBVEC(3*NUMATM,3*NUMATM), IDVECT
      COMMON /INTCOR/ XNDOGM(3, NUMATM), INTFRE(3, NUMATM)
C
 400  CALL UPROMP( 'Draw:MOVE> ')
      READ (5, '( A )' ) COMAND
      CALL LCLEAN(COMAND,COMAND, .TRUE.)
      IF (COMAND(:1) .EQ. 'H' .OR. COMAND(:1) .EQ. '?') THEN
         COMAND = 'DRAW MOVE'
         CALL HELP( COMAND )
         COMAND = '     '
      ELSEIF (COMAND(:1) .EQ. 'C' ) THEN
         WRITE (*,*) 'Cartesian movement'
         CALL UPROMP( 
     .    'Move ALL ATOMS the same or INDIVIDUALLY ? ' )
         READ (*, '( A )' ) COMAND
         CALL LCLEAN(COMAND,COMAND, .TRUE.)
         IF (COMAND(:1).EQ.'A' .OR. COMAND(1:1).EQ.'S') THEN
            CALL UPROMP( 'OK BY HOW MUCH (X,Y,Z ANGSTROMS) ' )
            READ ( *, '( A )' ) COMAND
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            IF ( COMAND(:1) .EQ. ' ') GOTO 400
            X = READA( COMAND, 1 , ERROR)
            IF ( ERROR ) THEN
               WRITE ( *, *) 'INPUT ERROR.'
               GOTO 400
            ENDIF
            COMAND = COMAND( INDEX( COMAND, ' '):)
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            Y = READA( COMAND, 1, ERROR)
            IF ( ERROR ) THEN
               CALL UPROMP( 'Y DISPLACEMENT: ')
               READ ( *, '( A )' ) COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE.)
               IF ( COMAND(:1) .EQ. ' ') THEN
                  Y = 0.0D0
               ELSE
                  Y = READA( COMAND, 1, ERROR)
                  IF ( ERROR) Y = 0.0D0
               ENDIF
            ENDIF
            COMAND = COMAND( INDEX( COMAND, ' '):)
            CALL LCLEAN( COMAND, COMAND, .TRUE.)
            Z = READA( COMAND, 1, ERROR)
            IF ( ERROR ) THEN
               CALL UPROMP( 'Z DISPLACEMENT: ')
               READ ( *, '( A )' ) COMAND
               CALL LCLEAN( COMAND, COMAND, .TRUE.)
               IF ( COMAND(:1) .EQ. ' ') THEN
                  Z = 0.0D0
               ELSE
                  Z = READA( COMAND, 1, ERROR)
                  IF ( ERROR) Y = 0.0D0
               ENDIF
            ENDIF
            IF (DEBUG) WRITE (*,*) 'X,Y,Z=',X,Y,Z
            DO 401 I=1,NATOMS
              XDIST(I)=X
              YDIST(I)=Y
  401       ZDIST(I)=Z
            CALL XYZMOV(XDIST,YDIST,ZDIST,0,IGROUP)
            REDRAW = .TRUE.
            RETURN
          ELSEIF( COMAND(1:1) .EQ. 'I')THEN
            CALL UPROMP(
     .        'Shall I move MANUALLY or by a NORMAL VIBRATION? ')
            READ ( *, '( A )', END=400 ) COMAND
            CALL LCLEAN(COMAND, COMAND, .TRUE.)
            IF ( COMAND(:1) .EQ.'M' )THEN
              WRITE (6,454) NATOMS
  454         FORMAT ( ' I will prompt you for each of the ',I4,
     1           ' atoms; you must enter three (3) values' )
   410        DO 422 I=1,NATOMS
                 WRITE(COMAND,'('' ATOM '',I4,'' VALUES X, Y, Z: '')') I
                 CALL UPROMP( COMAND( :INDEX(COMAND,':')+1) )
                 READ (*,'(A)', END=400) COMAND
                 CALL LCLEAN( COMAND, COMAND, .TRUE.)
                 IF ( COMAND(1:1) .EQ. '*') THEN
                    XDIST(I)=XDIST(I-1)
                    YDIST(I)=YDIST(I-1)
                    ZDIST(I)=ZDIST(I-1)
                 ELSE
                    IF ( COMAND(1:1) .EQ. '"') THEN
                       XDIST(I) = XDIST( I-1)
                    ELSE
                       XDIST(I) = READA( COMAND, 1, ERROR)
                    ENDIF
                    CALL POPARG( COMAND, COMAND)
                    IF ( COMAND(1:1) .EQ. '"') THEN
                       YDIST(I) = YDIST( I-1)
                    ELSE
                       YDIST(I) = READA( COMAND, 1, ERROR)
                    ENDIF
                    CALL POPARG( COMAND, COMAND)
                    IF ( COMAND(1:1) .EQ. '"') THEN
                       ZDIST(I) = ZDIST( I-1)
                    ELSE
                       ZDIST(I) = READA( COMAND, 1, ERROR)
                    ENDIF
                    CALL POPARG( COMAND, COMAND)
c?                    XDIST(I)=XDIST(I)*SCALEM
c?                    YDIST(I)=YDIST(I)*SCALEM
c?                    ZDIST(I)=ZDIST(I)*SCALEM
                    XDIST(I)=XDIST(I)
                    YDIST(I)=YDIST(I)
                    ZDIST(I)=ZDIST(I)
                 ENDIF
  422         CONTINUE
           ELSEIF( COMAND(1:1).EQ.'N' .OR. COMAND(1:1).EQ.'V')THEN
              CALL UPROMP( 'WHICH EIGENVECTOR NUMBER? [DEFAULT IS 1] ')
              READ ( *, '(A)', END=400) COMAND
              CALL LCLEAN( COMAND, COMAND, .TRUE.)
              IF ( COMAND(:1) .EQ. ' ') THEN
                 IDVECT = 1
              ELSE
                 IDVECT = READA( COMAND, 1, ERROR)
              ENDIF
              CALL UPROMP( 'Enter a multiplier  [ 1.000] ')
              READ ( *, '( A )' ) COMAND
              CALL LCLEAN( COMAND, COMAND, .TRUE.)
              IF ( COMAND(:1) .EQ. ' ') THEN
                 SCALEM = 1.0D0
              ELSE
                 SCALEM=READA( COMAND,1,ERROR)
                 IF(ERROR)SCALEM=1.0
              ENDIF
              ITEMP = 0
              DO 404 I= 1, NATOMS
                 IF ( IE(I) .NE. 99) THEN
                    XDIST( I) = VIBVEC( ITEMP+1, IDVECT ) * SCALEM
                    YDIST( I) = VIBVEC( ITEMP+2, IDVECT ) * SCALEM
                    ZDIST( I) = VIBVEC( ITEMP+3, IDVECT ) * SCALEM
                    ITEMP = ITEMP + 3
                 ELSE
                    XDIST( I) = 0.0D0
                    YDIST( I) = 0.0D0
                    ZDIST( I) = 0.0D0
                 ENDIF
  404         CONTINUE
           ELSE
              CALL DEBUGR( 'I wish you would use one of my options.')
              GOTO 400
           ENDIF
           CALL XYZMOV(XDIST,YDIST,ZDIST,0,IGROUP)
           CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM )
           REDRAW = .TRUE.
           GO TO 400
         ENDIF
      ELSEIF (COMAND(:1) .EQ. 'I') THEN
         CALL DEBUGR( 'INTERNAL GEOMETRY MOVEMENT.')
         CALL UPROMP( 'INPUT SCALE MULTIPLIER (DEFAULT IS 1.000) ')
         READ ( *, '(A)', END=400 ) COMAND
         CALL LCLEAN( COMAND, COMAND, .TRUE.)
         IF ( COMAND(:1) .EQ. ' ') THEN
            SCALEM = 1.0D0
         ELSE
            SCALEM = READA( COMAND, 1, ERROR)
            IF (ERROR) SCALEM = 1.0D0
         ENDIF
         IF (SCALEM.EQ.0)SCALEM=1.0D0
         WRITE (*,*) 'MANUAL IS THE ONLY MODE.'
  505    WRITE (6,454)NATOMS
         IUNIT=5
  510    DO 522 I=1,NATOMS
  518       WRITE (6,*) ' ATOM ',I,
     .           ' VALUES OF LENGTH, BOND ANGLE, DIHED'
            READ (5,*) XDIST(I),YDIST(I),ZDIST(I)
  520       XDIST(I)=XDIST(I)*SCALEM
            YDIST(I)=YDIST(I)*SCALEM
            ZDIST(I)=ZDIST(I)*SCALEM
  522    CONTINUE
         CALL MNDMOV(XDIST,YDIST,ZDIST,0,IGROUP)
         CALL GMETRY(NUATOM,NATOMS,NN,A,NA,NB,NC,COORD,ERROR)
         REDRAW = .TRUE.
      ELSEIF (COMAND(:1) .EQ. 'Q' ) THEN
         RETURN
      ELSE
         WRITE (*,*) 'I don''t understand, try Help.'
         GO TO 400
      ENDIF

      RETURN
      END
