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