4
** Routines for calculating a block of the sigma3 (alpha-beta) vector
7
** Center for Computational Quantum Chemistry
8
** University of Georgia
14
#include <libciomr/libciomr.h>
19
#define MIN0(a,b) (((a)<(b)) ? (a) : (b))
20
#define MAX0(a,b) (((a)>(b)) ? (a) : (b))
21
#define INDEX(i,j) ((i>j) ? (ioff[(i)]+(j)) : (ioff[(j)]+(i)))
27
** Calculate a block of the sigma3 vector in equation (9c) of
28
** Olsen, Roos, et al.
31
void s3_block(struct stringwr *alplist, struct stringwr *betlist,
32
double **C, double **S, double *tei, int nas, int nbs,
33
int Ja_list, int Jb_list)
35
struct stringwr *Ia, *Ib ;
36
unsigned int Ia_ex, Ib_ex;
43
int Iacnt, Jbcnt, *Iaij, *Ibij;
44
unsigned int *Iaridx, *Ibridx;
45
signed char *Iasgn, *Ibsgn;
49
nirreps = CalcInfo.nirreps;
52
for (Ia=alplist,Ia_idx=0; Ia_idx < nas; Ia_idx++,Ia++) {
54
/* loop over excitations E^a_{kl} from |A(I_a)> */
55
Iacnt = Ia->cnt[Ja_list];
56
Iaridx = Ia->ridx[Ja_list];
57
Iasgn = Ia->sgn[Ja_list];
58
Iaij = Ia->ij[Ja_list];
59
for (Ia_ex=0; Ia_ex < Iacnt; Ia_ex++) {
61
Tptr = tei + ioff[kl];
66
for (Ib=betlist, Ib_idx=0; Ib_idx < nbs; Ib_idx++, Ib++) {
68
/* loop over excitations E^b_{ij} from |B(I_b)> */
69
Jbcnt = Ib->cnt[Jb_list];
70
Ibridx = Ib->ridx[Jb_list];
71
Ibsgn = Ib->sgn[Jb_list];
72
Ibij = Ib->ij[Jb_list];
75
for (Ib_ex=0; Ib_ex < Jbcnt; Ib_ex++) {
79
ijkl = ioff[MAX0(ij,kl)] + MIN0(ij,kl);
80
tval += tei[ijkl] * C[Ja_idx][Jb_idx] *
81
(double) Ja_sgn * (double) Jb_sgn;
83
S[Ia_idx][Ib_idx] += tval;
85
} /* end loop over Ib */
86
} /* end loop over Ia excitations */
87
} /* end loop over Ia */
95
** Calculate a block of the sigma3 vector in equation (9c) of
96
** Olsen, Roos, et al. For diagonal blocks of sigma.
98
** currently assumes that (ij|ij)'s have not been halved
101
void s3_block_diag(struct stringwr *alplist, struct stringwr *betlist,
102
double **C, double **S, double *tei, int nas, int nbs,
103
int Ja_list, int Jb_list)
105
struct stringwr *Ia, *Ib;
106
unsigned int Ia_ex, Ib_ex;
113
int Iacnt, Jbcnt, *Iaij, *Ibij;
114
unsigned int *Iaridx, *Ibridx;
115
signed char *Iasgn, *Ibsgn;
116
double *Tptr, *Cptr, *Sptr;
119
for (Ia=alplist,Ia_idx=0; Ia_idx < nas; Ia_idx++,Ia++) {
121
/* loop over excitations E^a_{kl} from |A(I_a)> */
123
Iacnt = Ia->cnt[Ja_list];
124
Iaridx = Ia->ridx[Ja_list];
125
Iasgn = Ia->sgn[Ja_list];
126
Iaij = Ia->ij[Ja_list];
127
for (Ia_ex=0; Ia_ex < Iacnt; Ia_ex++) {
132
Tptr = tei + ioff[kl];
138
for (Ib=betlist, Ib_idx=0; Ib_idx < nbs; Ib_idx++, Ib++) {
140
/* loop over excitations E^b_{ij} from |B(I_b)> */
141
Jbcnt = Ib->cnt[Jb_list];
142
Ibridx = Ib->ridx[Jb_list];
143
Ibsgn = Ib->sgn[Jb_list];
144
Ibij = Ib->ij[Jb_list];
147
for (Ib_ex=0; Ib_ex < Jbcnt && (ij = *Ibij++)<=kl; Ib_ex++) {
149
Jb_sgn = *Ibsgn++ * Ja_sgn;
150
tval2 = Tptr[ij] * Cptr[Jb_idx] * Jb_sgn;
151
if (ij == kl) tval2 *= 0.5;
155
} /* end loop over Ib */
156
} /* end loop over Ia excitations */
157
} /* end loop over Ia */
166
** Calculate a block of the sigma3 (alpha-beta) vector for a diagonal
167
** block of sigma. The string replacements are fed in through arrays.
168
** Assumes that (ij|ij)'s have not been halved
170
** David Sherrill, 13 August 1995
173
void s3_block_rotf(int *Cnt[2], int **Ij[2],
174
int **Ridx[2], signed char **Sgn[2], double **C, double **S,
175
double *tei, int nas, int nbs)
184
int Iacnt, Jbcnt, *Iaij, *Ibij;
185
int *Iaridx, *Ibridx;
186
signed char *Iasgn, *Ibsgn;
191
for (Ia_idx=0; Ia_idx < nas; Ia_idx++) {
193
/* loop over excitations E^a_{kl} from |A(I_a)> */
194
Iacnt = Cnt[0][Ia_idx];
195
Iaridx = Ridx[0][Ia_idx];
196
Iasgn = Sgn[0][Ia_idx];
197
Iaij = Ij[0][Ia_idx];
198
for (Ia_ex=0; Ia_ex < Iacnt; Ia_ex++) {
200
Tptr = tei + ioff[kl];
205
for (Ib_idx=0; Ib_idx < nbs; Ib_idx++) {
207
/* loop over excitations E^b_{ij} from |B(I_b)> */
208
Jbcnt = Cnt[1][Ib_idx];
209
Ibridx = Ridx[1][Ib_idx];
210
Ibsgn = Sgn[1][Ib_idx];
211
Ibij = Ij[1][Ib_idx];
214
for (Ib_ex=0; Ib_ex < Jbcnt; Ib_ex++) {
218
ijkl = ioff[MAX0(ij,kl)] + MIN0(ij,kl);
219
tval += tei[ijkl] * C[Ja_idx][Jb_idx] *
220
(double) Ja_sgn * (double) Jb_sgn;
222
S[Ia_idx][Ib_idx] += tval;
223
} /* end loop over Ib */
224
} /* end loop over Ia excitations */
225
} /* end loop over Ia */
230
** S3_BLOCK_DIAG_ROTF()
232
** Calculate a block of the sigma3 vector in equation
233
** (9c) of Olsen, Roos, et al. For diagonal blocks of sigma.
234
** The string replacements are fed in through arrays.
235
** Assumes that (ij|ij)'s have not been halved.
238
void s3_block_diag_rotf(int *Cnt[2], int **Ij[2],
239
int **Ridx[2], signed char **Sgn[2], double **C, double **S,
240
double *tei, int nas, int nbs)
249
int Iacnt, Jbcnt, *Iaij, *Ibij;
250
int *Iaridx, *Ibridx;
251
signed char *Iasgn, *Ibsgn;
256
for (Ia_idx=0; Ia_idx < nas; Ia_idx++) {
258
/* loop over excitations E^a_{kl} from |A(I_a)> */
259
Iacnt = Cnt[0][Ia_idx];
260
Iaridx = Ridx[0][Ia_idx];
261
Iasgn = Sgn[0][Ia_idx];
262
Iaij = Ij[0][Ia_idx];
263
for (Ia_ex=0; Ia_ex < Iacnt; Ia_ex++) {
265
Tptr = tei + ioff[kl];
270
for (Ib_idx=0; Ib_idx < nbs; Ib_idx++) {
272
/* loop over excitations E^b_{ij} from |B(I_b)> */
273
Jbcnt = Cnt[1][Ib_idx];
274
Ibridx = Ridx[1][Ib_idx];
275
Ibsgn = Sgn[1][Ib_idx];
276
Ibij = Ij[1][Ib_idx];
279
for (Ib_ex=0; Ib_ex < Jbcnt; Ib_ex++) {
283
if (ij > kl) continue;
284
ijkl = ioff[MAX0(ij,kl)] + MIN0(ij,kl);
285
tval2 = tei[ijkl] * C[Ja_idx][Jb_idx] *
286
(double) Ja_sgn * (double) Jb_sgn;
287
if (ij == kl) tval2 *= 0.5;
290
S[Ia_idx][Ib_idx] += tval;
291
} /* end loop over Ib */
292
} /* end loop over Ia excitations */
293
} /* end loop over Ia */
added
removed
src/bin/detci/s3.c
