gcc/testsuite/gfortran.dg/pr45578.f90

   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