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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
C
C Notice of Public Domain nature of this Program
C
C 'This computer program is a work of the United States
C Government and as such is not subject to protection by
C copyright (17 U.S.C. # 105.) Any person who fraudulently
C places a copyright notice or does any other act contrary
C to the provisions of 17 U.S. Code 506(c) shall be subject
C to the penalties provided therein. This notice shall not
C be altered or removed from this software and is to be on
C all reproductions.'
C
FUNCTION AABABC(IOCCA1, IOCCB1, IOCCA2, NMOS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION IOCCA1(NMOS), IOCCB1(NMOS), IOCCA2(NMOS)
***********************************************************************
*
* AABABC EVALUATES THE C.I. MATRIX ELEMENT FOR TWO MICROSTATES DIFFERING
* BY BETA ELECTRON. THAT IS, ONE MICROSTATE HAS A BETA ELECTRON
* IN PSI(I) WHICH, IN THE OTHER MICROSTATE IS IN PSI(J)
*
***********************************************************************
COMMON /XYIJKL/ XY(NMECI,NMECI,NMECI,NMECI)
COMMON /BASEOC/ OCCA(NMECI)
DO 10 I=1,NMOS
10 IF(IOCCA1(I).NE.IOCCA2(I)) GOTO 20
20 IJ=IOCCB1(I)
DO 30 J=I+1,NMOS
IF(IOCCA1(J).NE.IOCCA2(J)) GOTO 40
30 IJ=IJ+IOCCA1(J)+IOCCB1(J)
40 SUM=0.D0
DO 50 K=1,NMOS
50 SUM=SUM+ (XY(I,J,K,K)-XY(I,K,J,K))*(IOCCA1(K)-OCCA(K)) +
1 XY(I,J,K,K) *(IOCCB1(K)-OCCA(K))
IF(MOD(IJ,2).EQ.1)SUM=-SUM
AABABC=SUM
RETURN
END
FUNCTION AABBCD(IOCCA1, IOCCB1, IOCCA2, IOCCB2, NMOS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION IOCCA1(NMOS), IOCCB1(NMOS), IOCCA2(NMOS), IOCCB2(NMOS)
***********************************************************************
*
* AABBCD EVALUATES THE C.I. MATRIX ELEMENT FOR TWO MICROSTATES DIFFERING
* BY TWO SETS OF M.O.S. ONE MICROSTATE HAS AN ALPHA ELECTRON
* IN PSI(I) AND A BETA ELECTRON IN PSI(K) FOR WHICH THE OTHER
* MICROSTATE HAS AN ALPHA ELECTRON IN PSI(J) AND A BETA ELECTRON
* IN PSI(L)
*
***********************************************************************
COMMON /XYIJKL/ XY(NMECI,NMECI,NMECI,NMECI)
COMMON /SPQR/ ISPQR(NMECI*NMECI,NMECI),IS,ILOOP, JLOOP
DO 10 I=1,NMOS
10 IF(IOCCA1(I) .NE. IOCCA2(I)) GOTO 20
20 DO 30 J=I+1,NMOS
30 IF(IOCCA1(J) .NE. IOCCA2(J)) GOTO 40
40 DO 50 K=1,NMOS
50 IF(IOCCB1(K) .NE. IOCCB2(K)) GOTO 60
60 DO 70 L=K+1,NMOS
70 IF(IOCCB1(L) .NE. IOCCB2(L)) GOTO 80
80 IF( I.EQ.K .AND. J.EQ.L .AND. IOCCA1(I).NE.IOCCB1(I)) THEN
ISPQR(ILOOP,IS)=JLOOP
IS=IS+1
ENDIF
IF(IOCCA1(I) .LT. IOCCA2(I)) THEN
M=I
I=J
J=M
ENDIF
IF(IOCCB1(K) .LT. IOCCB2(K)) THEN
M=K
K=L
L=M
ENDIF
XR=XY(I,J,K,L)
C# WRITE(6,'(4I5,F12.6)')I,J,K,L,XR
C
C NOW UNTANGLE THE MICROSTATES
C
IJ=1
IF( I.GT.K .AND. J.GT.L .OR. I.LE.K .AND. J.LE.L)IJ=0
IF( I.GT.K ) IJ=IJ+IOCCA1(K)+IOCCB1(I)
IF( J.GT.L ) IJ=IJ+IOCCA2(L)+IOCCB2(J)
IF(I.GT.K)THEN
M=I
I=K
K=M
ENDIF
DO 90 M=I,K
90 IJ=IJ+IOCCB1(M)+IOCCA1(M)
IF(J.GT.L)THEN
M=J
J=L
L=M
ENDIF
DO 100 M=J,L
100 IJ=IJ+IOCCB2(M)+IOCCA2(M)
C
C IJ IN THE PERMUTATION NUMBER, .EQUIV. -1 IF IJ IS ODD.
C
IF(MOD(IJ,2).EQ.1)XR=-XR
AABBCD=XR
RETURN
END
FUNCTION AABACD(IOCCA1, IOCCB1, IOCCA2, IOCCB2, NMOS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION IOCCA1(NMOS), IOCCB1(NMOS), IOCCA2(NMOS), IOCCB2(NMOS)
***********************************************************************
*
* AABACD EVALUATES THE C.I. MATRIX ELEMENT FOR TWO MICROSTATES DIFFERING
* BY TWO ALPHA MOS. ONE MICROSTATE HAS ALPHA ELECTRONS IN
* M.O.S PSI(I) AND PSI(J) FOR WHICH THE OTHER MICROSTATE HAS
* ELECTRONS IN PSI(K) AND PSI(L)
*
***********************************************************************
COMMON /XYIJKL/ XY(NMECI,NMECI,NMECI,NMECI)
IJ=0
DO 10 I=1,NMOS
10 IF(IOCCA1(I) .LT. IOCCA2(I)) GOTO 20
20 DO 30 J=I+1,NMOS
IF(IOCCA1(J) .LT. IOCCA2(J)) GOTO 40
30 IJ=IJ+IOCCA2(J)+IOCCB2(J)
40 DO 50 K=1,NMOS
50 IF(IOCCA1(K) .GT. IOCCA2(K)) GOTO 60
60 DO 70 L=K+1,NMOS
IF(IOCCA1(L) .GT. IOCCA2(L)) GOTO 80
70 IJ=IJ+IOCCA1(L)+IOCCB1(L)
80 IJ=IJ+IOCCB2(I)+IOCCB1(K)
SUM=(XY(I,K,J,L)-XY(I,L,K,J))
IF(MOD(IJ,2).EQ.1)SUM=-SUM
AABACD=SUM
RETURN
END
FUNCTION BABBBC(IOCCA1, IOCCB1, IOCCB2, NMOS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION IOCCA1(NMOS), IOCCB1(NMOS), IOCCB2(NMOS)
***********************************************************************
*
* BABBBC EVALUATES THE C.I. MATRIX ELEMENT FOR TWO MICROSTATES DIFFERING
* BY ONE BETA ELECTRON. THAT IS, ONE MICROSTATE HAS A BETA
* ELECTRON IN PSI(I) AND THE OTHER MICROSTATE HAS AN ELECTRON IN
* PSI(J).
***********************************************************************
COMMON /XYIJKL/ XY(NMECI,NMECI,NMECI,NMECI)
COMMON /BASEOC/ OCCA(NMECI)
DO 10 I=1,NMOS
10 IF(IOCCB1(I).NE.IOCCB2(I)) GOTO 20
20 IJ=0
DO 30 J=I+1,NMOS
IF(IOCCB1(J).NE.IOCCB2(J)) GOTO 40
30 IJ=IJ+IOCCA1(J)+IOCCB1(J)
40 IJ=IJ+IOCCA1(J)
C
C THE UNPAIRED M.O.S ARE I AND J
SUM=0.D0
DO 50 K=1,NMOS
50 SUM=SUM+ (XY(I,J,K,K)-XY(I,K,J,K))*(IOCCB1(K)-OCCA(K)) +
1 XY(I,J,K,K) *(IOCCA1(K)-OCCA(K))
IF(MOD(IJ,2).EQ.1)SUM=-SUM
BABBBC=SUM
RETURN
END
FUNCTION BABBCD(IOCCA1, IOCCB1, IOCCA2, IOCCB2, NMOS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION IOCCA1(NMOS), IOCCB1(NMOS), IOCCA2(NMOS), IOCCB2(NMOS)
***********************************************************************
*
* BABBCD EVALUATES THE C.I. MATRIX ELEMENT FOR TWO MICROSTATES DIFFERING
* BY TWO BETA MOS. ONE MICROSTATE HAS BETA ELECTRONS IN
* M.O.S PSI(I) AND PSI(J) FOR WHICH THE OTHER MICROSTATE HAS
* ELECTRONS IN PSI(K) AND PSI(L)
*
***********************************************************************
COMMON /XYIJKL/ XY(NMECI,NMECI,NMECI,NMECI)
IJ=0
DO 10 I=1,NMOS
10 IF(IOCCB1(I) .LT. IOCCB2(I)) GOTO 20
20 DO 30 J=I+1,NMOS
IF(IOCCB1(J) .LT. IOCCB2(J)) GOTO 40
30 IJ=IJ+IOCCA2(J)+IOCCB2(J)
40 IJ=IJ+IOCCA2(J)
DO 50 K=1,NMOS
50 IF(IOCCB1(K) .GT. IOCCB2(K)) GOTO 60
60 DO 70 L=K+1,NMOS
IF(IOCCB1(L) .GT. IOCCB2(L)) GOTO 80
70 IJ=IJ+IOCCA1(L)+IOCCB1(L)
80 IJ=IJ+IOCCA1(L)
IF((IJ/2)*2.EQ.IJ) THEN
ONE=1.D0
ELSE
ONE=-1.D0
ENDIF
BABBCD=(XY(I,K,J,L)-XY(I,L,J,K))*ONE
RETURN
END
FUNCTION DIAGI(IALPHA,IBETA,EIGA,XY,NMOS)
IMPLICIT DOUBLE PRECISION(A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION XY(NMECI,NMECI,NMECI,NMECI), EIGA(NMECI),
1IALPHA(NMOS), IBETA(NMOS)
************************************************************************
*
* CALCULATES THE ENERGY OF A MICROSTATE DEFINED BY IALPHA AND IBETA
*
************************************************************************
X=0.0D0
DO 20 I=1,NMOS
IF (IALPHA(I).NE.0)THEN
X=X+EIGA(I)
DO 10 J=1,NMOS
X=X+((XY(I,I,J,J)-XY(I,J,I,J))*IALPHA(J)*0.5D0 +
1 (XY(I,I,J,J) )*IBETA(J))
10 CONTINUE
ENDIF
20 CONTINUE
DO 40 I=1,NMOS
IF (IBETA(I).NE.0) THEN
X=X+EIGA(I)
DO 30 J=1,I
30 X=X+(XY(I,I,J,J)-XY(I,J,I,J))*IBETA(J)
ENDIF
40 CONTINUE
DIAGI=X
RETURN
END
|
