1! { dg-do compile }
2! { dg-options "-O2 -funroll-loops" }
3
4      SUBROUTINE EFPGRD(IFCM,NAT,NVIB,NPUN,FCM,
5     *                  DEN,GRD,ENG,DIP,NVST,NFTODO,LIST)
6      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
7      DIMENSION DEN(*),GRD(*),ENG(*),DIP(*),LIST(*)
8      PARAMETER (MXPT=100, MXFRG=50, MXFGPT=MXPT*MXFRG)
9      COMMON /FGRAD / DEF(3,MXFGPT),DEFT(3,MXFRG),TORQ(3,MXFRG),
10     *                ATORQ(3,MXFRG)
11      IF(NVST.EQ.0) THEN
12         CALL PUVIB(IFCM,IW,.FALSE.,NCOORD,IVIB,IATOM,ICOORD,
13     *              ENG(IENG),GRD(IGRD),DIP(IDIP))
14      END IF
15      DO 290 IVIB=1,NVIB
16               DO 220 IFRG=1,NFRG
17                  DO 215  J=1,3
18                     DEFT(J,IFRG)=GRD(INDX+J-1)
19  215             CONTINUE
20                  INDX=INDX+6
21  220          CONTINUE
22  290 CONTINUE
23      END
24