1C PR rtl-optimization/58968.f 2C { dg-do compile { target powerpc*-*-* } } 3C { dg-options "-mcpu=power7 -O3 -w -ffast-math -funroll-loops" } 4 SUBROUTINE MAKTABS(IW,SOME,LBOX1,LBOX2,LBOX3,NSPACE,NA,NB, 5 * LBST,X, 6 * NX,IAMA,IAMI,IBMA,IBMI,MNUM,IDIM,MSTA,IBO, 7 * IDSYM,ISYM1,NSYM, 8 * NACT,LWRK,KTAB,LGMUL, 9 * LCON,LCOA,LCOB, 10 * LANDET,LBNDET,NAST,NBST,LSYMA,LSYMB,LGCOM, 11 * MINI,MAXI,LSPA,LSPB,LDISB, 12 * LSAS,LSBS,LSAC,LSBC, 13 * ITGA,ITGB,IAST,IBST,NCI,NA1EX,NB1EX,FDIRCT) 14 IMPLICIT DOUBLE PRECISION(A-H,O-Z) 15 LOGICAL SOME 16 DIMENSION LBOX1(NSPACE),LBOX2(NSPACE),LBOX3(NSPACE),LBST(NSPACE) 17 DIMENSION X(NX) 18 DIMENSION IAMA(NSPACE),IAMI(NSPACE),IBMA(NSPACE),IBMI(NSPACE) 19 DIMENSION MNUM(NSPACE),IDIM(NSPACE),MSTA(NSPACE+1),IBO(NACT) 20 DIMENSION LWRK(43),KTAB(NSYM),LGMUL(NSYM,NSYM) 21 DIMENSION LCON(NA) 22 DIMENSION LCOA(NSYM,ITGA),LCOB(NSYM,ITGB) 23 DIMENSION LANDET(NSPACE,ITGA),LBNDET(NSPACE,ITGB) 24 DIMENSION NAST(ITGA+1),NBST(ITGB+1) 25 DIMENSION LSYMA(IAST),LSYMB(IBST) 26 DIMENSION LGCOM(ITGB,ITGA) 27 DIMENSION MINI(NSPACE),MAXI(NSPACE) 28 DIMENSION LSPA(IAST),LSPB(IBST) 29 DIMENSION LDISB(NSYM,ITGB,ITGA) 30 DIMENSION LSAS(NSYM+1,ITGA),LSBS(NSYM+1,ITGB) 31 DIMENSION LSAC(IAST),LSBC(IBST) 32 LOGICAL FDIRCT 33 LCOA = 0 34 LCOB = 0 35 ISTA1 = LBST(1) 36 CALL RESETCO(LBOX1,NSPACE,NB,IBMA,IBMI,LBOX2) 37 NAST(1) = 0 38 NBST(1) = 0 39 DO II=1,ITGA 40 ITOT = 1 41 DO JJ=1,NSPACE 42 ITOT = ITOT * LANDET(JJ,II) 43 ENDDO 44 NAST(II+1) = NAST(II) + ITOT 45 ENDDO 46 DO II=1,ITGB 47 ITOT = 1 48 DO JJ=1,NSPACE 49 ITOT = ITOT * LBNDET(JJ,II) 50 ENDDO 51 NBST(II+1) = NBST(II) + ITOT 52 ENDDO 53 ICOMP = 0 54 CALL RESETCO(LBOX1,NSPACE,NA,IAMA,IAMI,LBOX3) 55 NA1EX = 0 56 NB1EX = 0 57 CALL RESETCO(LBOX1,NSPACE,NB,IBMA,IBMI,LBOX3) 58 DO IIB = 1,ITGB 59 CALL RESETDE(LBOX1,NSPACE,NB,MSTA,LCON) 60 DO KKB=NBST(IIB)+1,NBST(IIB+1) 61 DO II=1,NSPACE 62 LBOX2(II) = LBOX1(II) 63 ENDDO 64 IEBS = NB+1 65 DO ISPB1=NSPACE,1,-1 66 IOC1 = LBOX1(ISPB1) 67 IEBE = IEBS - 1 68 IEBS = IEBS - IOC1 69 LBOX2(ISPB1) = LBOX2(ISPB1)-1 70 DO IB1=IEBE,IEBS,-1 71 IO1 = LCON(IB1) 72 IGBE = IEBE - LBOX1(ISPB1) 73 DO ISPB2=ISPB1,NSPACE 74 IGBS = IGBE + 1 75 IGBE = IGBE + LBOX1(ISPB2) 76 LBOX2(ISPB2) = LBOX2(ISPB2) + 1 77 IGBA = MAX(IB1+1,IGBS) 78 DO IGAP=IGBA,IGBE+1 79 DO JJ=ISTA,IEND 80 NB1EX = NB1EX + 1 81 ENDDO 82 ISTA = LCON(IGAP)+1 83 IEND = LCON(IGAP+1)-1 84 IF (IGAP.EQ.IGBE) IEND=MSTA(ISPB2+1)-1 85 ENDDO 86 LBOX2(ISPB2) = LBOX2(ISPB2) - 1 87 ENDDO 88 ENDDO 89 LBOX2(ISPB1) = LBOX2(ISPB1) + 1 90 ENDDO 91 CALL MOVEUP2(LBOX1,NSPACE,NB,MSTA,LCON) 92 ENDDO 93 CALL PUSHCO(LBOX1,NSPACE,NB,IBMA,IBMI,LBOX3,IEND) 94 ENDDO 95 RETURN 96 END 97