1! { dg-do run }
2!*==CENTCM.spg  processed by SPAG 6.55Dc at 09:26 on 23 Sep 2005
3      SUBROUTINE CENTCM
4      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
5      PARAMETER (NM=16384)
6      PARAMETER (NG=100)
7      PARAMETER (NH=100)
8      PARAMETER (MU=20)
9      PARAMETER (NL=1)
10      PARAMETER (LL=10*NM)
11      PARAMETER (KP=2001,KR=2001,KG=2001)
12      COMMON /LCS   / X0(3,-2:NM) , X(3,-2:NM,5) , XIN(3,-2:NM)
13      COMMON /MOLEC / LPBc(3) , MOLsp , MOLsa , NBX , NBY , NBZ , NPLa ,&
14     &                LPBcsm
15      cm1 = 0.D0
16      cm2 = 0.D0
17      cm3 = 0.D0
18      DO i = 1 , MOLsa
19         cm1 = cm1 + X0(1,i)
20         cm2 = cm2 + X0(2,i)
21         cm3 = cm3 + X0(3,i)
22      ENDDO
23      cm1 = cm1/MOLsa
24      cm2 = cm2/MOLsa
25      cm3 = cm3/MOLsa
26      IF ( (cm1.EQ.0.D0) .AND. (cm2.EQ.0.D0) .AND. (cm3.EQ.0.D0) )      &
27     &     RETURN
28      DO i = 1 , MOLsa
29        X0(1,i) = X0(1,i) - cm1
30        X0(2,i) = X0(2,i) - cm2
31        X0(3,i) = X0(3,i) - cm3
32        XIN(1,i) = XIN(1,i) - cm1
33        XIN(2,i) = XIN(2,i) - cm2
34        XIN(3,i) = XIN(3,i) - cm3
35      ENDDO
36      CONTINUE
37      END
38      PROGRAM test
39      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
40      PARAMETER (NM=16384)
41      PARAMETER (NG=100)
42      PARAMETER (NH=100)
43      PARAMETER (MU=20)
44      PARAMETER (NL=1)
45      PARAMETER (LL=10*NM)
46      PARAMETER (KP=2001,KR=2001,KG=2001)
47      COMMON /LCS   / X0(3,-2:NM) , X(3,-2:NM,5) , XIN(3,-2:NM)
48      COMMON /MOLEC / LPBc(3) , MOLsp , MOLsa , NBX , NBY , NBZ , NPLa ,&
49     &                LPBcsm
50      MOLsa = 10
51      X0 = 1.
52      CALL CENTCM
53      END
54