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