source: trunk/fsource/spsubs/sglcen.for @ 211

Last change on this file since 211 was 211, checked in by vondreele, 12 years ago

unfix includes

File size: 1.3 KB
RevLine 
[57]1      SUBROUTINE SGLCEN(LCENT,CEN,NCV)
2
[211]3      INCLUDE       '../INCLDS/COPYRIGT.FOR' 
[57]4
5C       This program was developed for
6C                    The Division of Chemistry
7C                               of
8C               The National Research Council of Canada
9C                               by
10C       Allen C. Larson, 14 Cerrado Loop, Santa Fe, NM 87505, USA
11
12      INTEGER*4     LCENT               !Lattice centering type flag
13      REAL*4        CEN(3,4)            !List of lattice centering vectors
14      INTEGER*4     NCV                 !Number of lattcie centering vectors
15
16      REAL*4        CENV(3,6)           
17      INTEGER*4     NCVT(7)             
18
19      DATA NCVT/1,2,2,2,2,4,3/
20      DATA CENV/  0,0.5,0.5,  0.5,0,0.5,  0.5,0.5,0,  0.5,0.5,0.5,
21     1  0.3333333,0.6666667,0.6666667,  0.6666667,0.3333333,0.3333333/
22
23      NCV = NCVT(LCENT)
24      CEN(1,1) = 0.0
25      CEN(2,1) = 0.0
26      CEN(3,1) = 0.0
27      IF ( NCV.GT.1 ) THEN
28        J = LCENT-1
29        IF ( LCENT.EQ.6 ) J=1
30        IF ( LCENT.EQ.7 ) J=5
31        DO I=2,NCV                                          !Copy the lattice centering vectors
32          CEN(1,I) = CENV(1,J)
33          CEN(2,I) = CENV(2,J)
34          CEN(3,I) = CENV(3,J)
35          J = J+1
36        END DO
37      END IF
38      RETURN
39      END
Note: See TracBrowser for help on using the repository browser.