forked from JackS9/phatpsy
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathteindx.f
160 lines (157 loc) · 5.45 KB
/
teindx.f
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
SUBROUTINE TEINDX(IOTYPE,TEIBUF)
IMPLICIT REAL*8(A-H,O,R-Z),INTEGER*2(P),LOGICAL*1(Q)
C-----------------------------------------------------------------------
C
C TEINDX...
C
C THIS ROUTINE READS AND WRITES TWO-ELECTRON INTEGRALS ALONG
C WITH THREE DESCRIPTOR WORDS CONTAINING POINTERS TO FOCK AND
C DENSITY MATRIX ELEMENTS AND WEIGHT FACTORS CORRESPONDING TO EACH
C POINTER DEPENDING ON THE SYMMETRY OF THE INTEGRAL. THE INTEGRALS
C AND THIER DESCRIPTOR WORDS ARE HELD IN A BUFFER UNTIL IT IS FIL-
C LED OR EMPTIED AUTOMATICALLY TO REDUCE I/O AND MAKE EFFICIENT
C USE OF STORAGE.
C
C VARIABLE DEFINITIONS:
C
C IUNIT0......... =IUNIT(IELEM+10), FORTRAN I/O UNIT TO FROM
C WHICH THE INTEGRALS ARE WRITTEN AND LATER READ
C ALONG WITH THIER DESCRIPTOR WORDS. IELEM IS
C THE INDEX OF THE CURRENT ELEMENT.
C IOTYPE LT 0 ... SET BUFFER COUNTER (LAST) TO ZERO AND RETURN.
C USED TO INITIATE A SERIES OF CALLS TO 'PUTTEI'.
C GE 0 ... SET COUNTER TO ZERO AND PRIME THE BUFFER.
C USED TO INITIATE A SERIES OF CALLS TO 'GETTEI'.
C TEI............ NON-ZERO VALUE OF TWO-ELECTRON INTEGRAL.
C TEIWD1......... 8-BYTE WORD EQUIVALENT TO TWO 2-BYTE POINTERS
C AND TWO 2-BYTE WEIGHT FACTORS (SEE 'GENINT'
C FOR DESCRIPTION).
C TEIWD2......... SAME AS TEIWD1.
C TEIWD3......... SAME AS TEIWD1 AND TEIWD2.
C TEIBUF......... BUFFER AREA FOR HOLDING INTEGRALS AND THIER
C DESCRIPTOR WORDS BEFORE READING OR WRITING
C TO IUNIT0.
C LENBUF......... LENGTH (DIMENSION) OF TEIBUF.
C
C ENTRY POINT: PUTTEI...
C
C THIS ENTRY POINT PLACES A SINGLE INTEGRAL AND ITS DESCRIPTOR
C WORDS INTO THE PROPER PLACE IN THE BUFFER ARRAY. FIRST CALL TO
C THIS ENTRY POINT MUST BE PRECEDED BY A CALL TO 'TEINDX' WITH
C IOTYPE GE 0. THE VALUES OF THE POINTERS AND WEIGHT FACTORS ARE
C PASSED THROUGH COMMON /NDXTEI/.
C
C ENTRY POINT: GETTEI...
C
C THIS ENTRY POINT PICKS A SINGLE INTEGRAL AND ITS DESCRIPTOR
C WORDS OUT OF THE PROPER PLACE IN THE BUFFER ARRAY. THE FIRST
C CALL TO THIS ENTRY POINT MUST BE PRECEDED BY A CALL TO 'TEINDX'
C WITH IOTYPE LT 0. THE VALUES OF THE POINTERS AND WEIGHT FACTORS
C ARE PASSED THROUGH COMMON /NDXTEI/.
C
C ENTRY POINT: DMPBUF...
C
C THIS ENTRY POINT WRITES OUT THE LAST PARTIALLY FILLED BUFFER
C AND MUST FOLLOW THE LAST CALL TO 'PUTTEI' IN A SERIES.
C
C COMMON USAGE:
C
C /PARMS/ SETS - IPARM(36)(=LAST)
C USES - IPARM(36)(=LAST)
C IPARM(39)(=IUNIT0)
C
C /IODATA/ USES - IUNIT(IELEM+10)(=IUNIT0),LENBUF
C
C
C /NDXTEI/ PUTTEI USES - IAC,KAC,IBD,KBD,IAD,KAD,IBC,KBC,
C IAB,KAB,ICD,KCD
C GETTEI SETS - (SAME)
C
C-----------------------------------------------------------------------
COMMON /PARMS/ APARM(20),IPARM(50),QPARM(50)
EQUIVALENCE (IPARM(36),LAST),(IPARM(39),IUNIT0)
COMMON /IODATA/ IUNIT(20),LENBUF
DIMENSION TEIBUF(LENBUF),PNDX(12)
EQUIVALENCE (TEIWD1,PNDX(1)),(TEIWD2,PNDX(5)),(TEIWD3,PNDX(9))
COMMON /NDXTEI/ IAC,KAC,IBD,KBD,IAD,KAD,IBC,KBC,IAB,KAB,ICD,KCD
LAST=0
IF (IOTYPE.LT.0) RETURN
READ (IUNIT0) TEIBUF
RETURN
END
C
C -->
SUBROUTINE PUTTEI(TEI,TEIBUF)
IMPLICIT REAL*8(A-H,O,R-Z),INTEGER*2(P),LOGICAL*1(Q)
COMMON /PARMS/ APARM(20),IPARM(50),QPARM(50)
EQUIVALENCE (IPARM(36),LAST),(IPARM(39),IUNIT0)
COMMON /IODATA/ IUNIT(20),LENBUF
DIMENSION TEIBUF(LENBUF),PNDX(12)
EQUIVALENCE (TEIWD1,PNDX(1)),(TEIWD2,PNDX(5)),(TEIWD3,PNDX(9))
COMMON /NDXTEI/ IAC,KAC,IBD,KBD,IAD,KAD,IBC,KBC,IAB,KAB,ICD,KCD
PNDX(1)=IAC
PNDX(2)=KAC
PNDX(3)=IBD
PNDX(4)=KBD
PNDX(5)=IAD
PNDX(6)=KAD
PNDX(7)=IBC
PNDX(8)=KBC
PNDX(9)=IAB
PNDX(10)=KAB
PNDX(11)=ICD
PNDX(12)=KCD
TEIBUF(LAST+1)=TEI
TEIBUF(LAST+2)=TEIWD1
TEIBUF(LAST+3)=TEIWD2
TEIBUF(LAST+4)=TEIWD3
LAST=LAST+4
IF ((LENBUF-LAST).GE.4) RETURN
CALL DMPBUF(TEIBUF)
RETURN
END
C
C -->
SUBROUTINE DMPBUF(TEIBUF)
IMPLICIT REAL*8(A-H,O,R-Z),INTEGER*2(P),LOGICAL*1(Q)
COMMON /PARMS/ APARM(20),IPARM(50),QPARM(50)
EQUIVALENCE (IPARM(36),LAST),(IPARM(39),IUNIT0)
COMMON /IODATA/ IUNIT(20),LENBUF
DIMENSION TEIBUF(LENBUF)
WRITE (IUNIT0) TEIBUF
LAST=0
RETURN
END
C
C -->
SUBROUTINE GETTEI(TEI,TEIBUF)
IMPLICIT REAL*8(A-H,O,R-Z),INTEGER*2(P),LOGICAL*1(Q)
COMMON /PARMS/ APARM(20),IPARM(50),QPARM(50)
EQUIVALENCE (IPARM(36),LAST),(IPARM(39),IUNIT0)
COMMON /IODATA/ IUNIT(20),LENBUF
DIMENSION TEIBUF(LENBUF),PNDX(12)
EQUIVALENCE (TEIWD1,PNDX(1)),(TEIWD2,PNDX(5)),(TEIWD3,PNDX(9))
COMMON /NDXTEI/ IAC,KAC,IBD,KBD,IAD,KAD,IBC,KBC,IAB,KAB,ICD,KCD
IF ((LENBUF-LAST).GE.4) GO TO 10
READ (IUNIT0) TEIBUF
LAST=0
10 CONTINUE
TEI=TEIBUF(LAST+1)
TEIWD1=TEIBUF(LAST+2)
TEIWD2=TEIBUF(LAST+3)
TEIWD3=TEIBUF(LAST+4)
IAC=PNDX(1)
KAC=PNDX(2)
IBD=PNDX(3)
KBD=PNDX(4)
IAD=PNDX(5)
KAD=PNDX(6)
IBC=PNDX(7)
KBC=PNDX(8)
IAB=PNDX(9)
KAB=PNDX(10)
ICD=PNDX(11)
KCD=PNDX(12)
LAST=LAST+4
RETURN
END