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
|
! { dg-do run }
!*==CENTCM.spg processed by SPAG 6.55Dc at 09:26 on 23 Sep 2005
SUBROUTINE CENTCM
IMPLICIT DOUBLE PRECISION(A-H,O-Z)
PARAMETER (NM=16384)
PARAMETER (NG=100)
PARAMETER (NH=100)
PARAMETER (MU=20)
PARAMETER (NL=1)
PARAMETER (LL=10*NM)
PARAMETER (KP=2001,KR=2001,KG=2001)
COMMON /LCS / X0(3,-2:NM) , X(3,-2:NM,5) , XIN(3,-2:NM)
COMMON /MOLEC / LPBc(3) , MOLsp , MOLsa , NBX , NBY , NBZ , NPLa ,&
& LPBcsm
cm1 = 0.D0
cm2 = 0.D0
cm3 = 0.D0
DO i = 1 , MOLsa
cm1 = cm1 + X0(1,i)
cm2 = cm2 + X0(2,i)
cm3 = cm3 + X0(3,i)
ENDDO
cm1 = cm1/MOLsa
cm2 = cm2/MOLsa
cm3 = cm3/MOLsa
IF ( (cm1.EQ.0.D0) .AND. (cm2.EQ.0.D0) .AND. (cm3.EQ.0.D0) ) &
& RETURN
DO i = 1 , MOLsa
X0(1,i) = X0(1,i) - cm1
X0(2,i) = X0(2,i) - cm2
X0(3,i) = X0(3,i) - cm3
XIN(1,i) = XIN(1,i) - cm1
XIN(2,i) = XIN(2,i) - cm2
XIN(3,i) = XIN(3,i) - cm3
ENDDO
CONTINUE
END
PROGRAM test
IMPLICIT DOUBLE PRECISION(A-H,O-Z)
PARAMETER (NM=16384)
PARAMETER (NG=100)
PARAMETER (NH=100)
PARAMETER (MU=20)
PARAMETER (NL=1)
PARAMETER (LL=10*NM)
PARAMETER (KP=2001,KR=2001,KG=2001)
COMMON /LCS / X0(3,-2:NM) , X(3,-2:NM,5) , XIN(3,-2:NM)
COMMON /MOLEC / LPBc(3) , MOLsp , MOLsa , NBX , NBY , NBZ , NPLa ,&
& LPBcsm
MOLsa = 10
X0 = 1.
CALL CENTCM
END
|
