1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
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
|
