SUBROUTINE SETVEC(IVECNO)
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)
      REAL VFREQ, VIBVEC, XMASS
      INTEGER*2 ATBOND
      CHARACTER*80 COMAND
      DIMENSION EVEC( 3, 3)
      LOGICAL ERROR, MODATA, REDRAW
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      CHARACTER*3 FTYPE
      COMMON /FINFO/ DELTAH,RC,GRAD,RCGRAD,VIP,DIPOLE, ICHARG
      COMMON /FINFOC/ FTYPE
      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 /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM), 
     .                ISTYPE, LATYPE, IMASK( NUMATM), ISCOLO
      COMMON /FORCE/ VFREQ(3*NUMATM), VIBVEC(3*NUMATM,3*NUMATM), IDVECT
      COMMON /EDIT/ MODATA, REDRAW
      COMMON /ALLROT/ ROTPRD( 3, 3)
      COMMON /ATMASS/ ATMASS( NUMATM)
      COMMON /EXMASS/ XMASS(200)
**************************************************************************
      IF (IVECNO .GT. 0 ) THEN
         OLDVEC = IVECNO
      ELSEIF (IVECNO .EQ. 0 ) THEN
         IVECNO = OLDVEC
      ELSE
* REMOVE VECTORS
         ISTYPE = MOD( ISTYPE, 10)
         DO 10 IA = 1, NATOMS
            IF ( IE( IA) .EQ. 200 ) GOTO 15
  10     CONTINUE
  15     NATOMS = IA
         RETURN
      ENDIF
      IF ( FTYPE .EQ. 'OUT') THEN      
         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 ) THEN
               ATMASS( IB ) = XMASS( IE( IA ) )
               NATOMS = NATOMS + 1
            ENDIF
  416    CONTINUE
         MASS = 1
         CALL XYZMND( NATOMS, CO, NA, NB, NC, XNDOGM)
         CALL GMETRY( NUATOM, NATOMS, IE, XNDOGM, NA, NB, NC, CO, ERROR)
         CALL AXIS(CO, IB, CMOM, BMOM, AMOM, SUMW, MASS, EVEC)
         DO 410 I= 1, 3
         DO 410 J= 1, 3
  410    ROTPRD( I, J) = EVEC( I, J)
         WRITE (*,*) 'MODE NUMBER:',IDVECT
         VSCALE = 0.5D0
         ITEMP = 0
         NATOM1 = NATOMS
         DO 400 I= 1, NATOMS
            IF ( IE( I) .LT. 99 ) THEN
                WRITE ( COMAND, '('' COORDS: '',3F9.6,
     .               ''; COMPTS: '',3F9.6)') (CO( J,I), J= 1,3),
     .               ( VIBVEC( ITEMP+J, IDVECT), J=1,3)
               IF ( DEBUG) CALL DEBUGR( COMAND )
               NATOM1 = NATOM1 + 1
               DO 401 J= 1, 3
  401          CO( J, NATOM1 ) = CO( J,I)+VIBVEC( ITEMP+J, IDVECT)*VSCALE
C?              WRITE (*,'(''SCALED TO:   '',3F10.6 )')
C?     .                         (CO( J, NATOM1 ), J=1,3)
               IE( NATOM1) = 200
               IMASK( NATOM1) = 1
               ITEMP = ITEMP + 3
            ENDIF
  400    CONTINUE
         NATOMS = NATOM1
         REDRAW = .TRUE.
      ELSEIF( FTYPE.EQ.'IRC' .OR. FTYPE.EQ.'DRC') THEN
* PROCESSING FOR IRC
         VSCALE = 0.5D0
         ITEMP = 0
         NATOM1 = NATOMS
         DO 500 I= 1, NATOMS
            IF ( IE( I) .LT. 99 ) THEN
                WRITE ( COMAND, '('' COORDS: '',3F9.6,
     .               ''; COMPTS: '',3F9.6)') (CO( J,I), J= 1,3),
     .               ( VIBVEC( ITEMP+J, 1), J=1,3)
               IF ( DEBUG) CALL DEBUGR( COMAND )
               NATOM1 = NATOM1 + 1
               DO 501 J= 1, 3
  501          CO( J, NATOM1 ) = CO( J,I)+VIBVEC( ITEMP+J, 1)*VSCALE
C?              WRITE (*,'(''SCALED TO:   '',3F10.6 )')
C?     .                         (CO( J, NATOM1 ), J=1,3)
               IE( NATOM1) = 200
               IMASK( NATOM1) = 1
               ITEMP = ITEMP + 3
            ENDIF
  500    CONTINUE
         NATOMS = NATOM1
         REDRAW = .TRUE.
      ELSE
         CONTINUE
      ENDIF
*
      RETURN
      END