Subversion Repositories openrisc

! { 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