--- /dev/null
+! { dg-do compile }
+! { dg-options "-O2 -funroll-loops" }
+
+ SUBROUTINE EFPGRD(IFCM,NAT,NVIB,NPUN,FCM,
+ * DEN,GRD,ENG,DIP,NVST,NFTODO,LIST)
+ IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+ DIMENSION DEN(*),GRD(*),ENG(*),DIP(*),LIST(*)
+ PARAMETER (MXPT=100, MXFRG=50, MXFGPT=MXPT*MXFRG)
+ COMMON /FGRAD / DEF(3,MXFGPT),DEFT(3,MXFRG),TORQ(3,MXFRG),
+ * ATORQ(3,MXFRG)
+ IF(NVST.EQ.0) THEN
+ CALL PUVIB(IFCM,IW,.FALSE.,NCOORD,IVIB,IATOM,ICOORD,
+ * ENG(IENG),GRD(IGRD),DIP(IDIP))
+ END IF
+ DO 290 IVIB=1,NVIB
+ DO 220 IFRG=1,NFRG
+ DO 215 J=1,3
+ DEFT(J,IFRG)=GRD(INDX+J-1)
+ 215 CONTINUE
+ INDX=INDX+6
+ 220 CONTINUE
+ 290 CONTINUE
+ END