| ! { dg-do compile } |
| ! { dg-options "-O3 -std=legacy" } |
| |
| SUBROUTINE EFTORD(DM,CHDINT,L4) |
| IMPLICIT DOUBLE PRECISION (A-H,O-Z) |
| PARAMETER (MXPT=100, MXFRG=50, MXFGPT=MXPT*MXFRG) |
| DIMENSION DM(*),CHDINT(L4) |
| COMMON /FGRAD / DEF0,DEFT0,TORQ0 |
| * ,ATORQ(3,MXFRG) |
| COMMON /CSSTV / CX,CY,CZ |
| * EFBTRM(MXFGPT),EFATRM2(MXFGPT),EFBTRM2(MXFGPT), |
| * EFDIP(3,MXFGPT),EFQAD(6,MXFGPT), |
| * EFOCT(10,MXFGPT),FRGNME(MXFGPT) |
| IF(NROOTS.EQ.5) CALL ROOT5 |
| IF(NROOTS.EQ.6) CALL ROOT6 |
| IF(NROOTS.GE.7) THEN |
| CALL ABRT |
| END IF |
| DO 403 I = 1,IJ |
| CHDINT(ICC)=CHDINT(ICC)-DUM*DUMY |
| ICC=ICC+1 |
| 403 CONTINUE |
| CHDINT(ICC)=CHDINT(ICC)-DUM*DUMY |
| DO 550 J=MINJ,MAX |
| LJ=LOCJ+J |
| IF (LI-LJ) 920,940,940 |
| 920 ID = LJ |
| GO TO 960 |
| 940 ID = LI |
| 960 NN = (ID*(ID-1))/2+JD |
| DUM = DM(NN) |
| ATORQ(1,INF)=ATORQ(1,INF)-DUM*(CHDINT(ICC+1)*EFDIP(3,IC) |
| $ -CHDINT(ICC+2)*EFDIP(2,IC)) |
| ICC=ICC+1 |
| ICC=ICC+1 |
| 550 CONTINUE |
| END |
