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