C  Copyright (c) 2003-2010 University of Florida
C
C  This program is free software; you can redistribute it and/or modify
C  it under the terms of the GNU General Public License as published by
C  the Free Software Foundation; either version 2 of the License, or
C  (at your option) any later version.

C  This program is distributed in the hope that it will be useful,
C  but WITHOUT ANY WARRANTY; without even the implied warranty of
C  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C  GNU General Public License for more details.

C  The GNU General Public License is included in this distribution
C  in the file COPYRIGHT.
      SUBROUTINE COMVEC(NDEG,TYPE,ORDER,COUNT,AXIS,NATMS,Q,SCRATCH,
     &NORD,V,CHAR)
C
C SUBROUTINE PERFORMS A GIVEN SYMMETRY OPERATION ON COORDINATES AND
C  AN INPUT VECTOR (V), SHUFFLES THE TRANSFORMED VECTOR AND RETURNS 
C  OVERLAP OF TRANSFORMED V WITH ORIGINAL V.  USED TO COMPUTE CHARACTERS
C  OF SYMMETRY OPERATIONS.  FOR N-FOLD DEGENERACIES, V WILL BE N TIMES
C  AS LONG AS Q.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "mxatms.par"
      DIMENSION V(NDEG*3*NATMS),SCRATCH(9*NATMS)
      DIMENSION NORD(2*MXATMS),Q(3*NATMS)
      CHARACTER*1 TYPE
      INTEGER ORDER,COUNT,AXIS,ERR
      IX1=3*NATMS+1
      IX2=3*NATMS+IX1
      IJ1=NATMS+1
      IJ2=IJ1+NATMS
      CHAR=0.D0
C
C ZERO OUT SCRATCH VECTOR
C

      CALL ZERO(SCRATCH,9*NATMS)
C
C PERFORM PARTICULAR SYMMETRY OPERATION ON COORINATES AND GENERATE
C   "STANDARD" LIST OF CENTERS WITH SORTXYZ.
C
      CALL DOSYOP(TYPE,ORDER,COUNT,AXIS,NATMS,Q,SCRATCH,ERR,0)
      CALL SORTXYZ(SCRATCH(1),SCRATCH(IX1),NORD(IJ1),NATMS)
C
C NOW DO SAME OPERATION TO V INPUT VECTOR AND THEN SWAP ATOM
C  ORDERING TO COMPARE WITH OLD (UNTRANSFORMED) V.
C    
C LOOP OVER LEVEL OF DEGENERACY AND COMPUTE CHARACTER.
C
      DO 10 I=0,NDEG-1
      IBOT=1+3*I*NATMS
      CALL DOSYOP(TYPE,ORDER,COUNT,AXIS,NATMS,V(IBOT),
     &SCRATCH(IX2),ERR,0)
      CALL SWPORD(NORD(1),NORD(IJ1),SCRATCH(IX2),SCRATCH(IX1),NATMS)
      CHAR=xdot(3*NATMS,SCRATCH(IX1),1,V(IBOT),1)+CHAR
 10   CONTINUE
      RETURN
      END
