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