29
32
#include"int_fjt.h"
36
// For a set of SALCs, we need to be able to select coefficients of all nonzero derivatives
37
// of a given shell quartet. It is best done when the relevant subset of the (sparse) SALC coefficient
38
// matrix is pre-arranged in an array
40
double coef; // contribution of this cartesian derivative to this SALC
41
int cart_der; // cartesian derivative (for this quartet) [0,3*num_unique_atoms)
42
int salc; // SALC index [0,num_atoms*3)
50
const double toler = UserOptions.cutoff;
51
const int num_coords = 3*Molecule.num_atoms; // total number of coordinates, symmetry-adapted or otherwise
52
// max number of nonzero derivatives for a SO shell quartet = 4 (centers) * 3 (x,y,z) * maximum multiplicity of a nucleus
53
const int max_num_cdsalcs_per_quartet = 12*Symmetry.max_stab_index;
55
/*--- ASCII file to print integrals ---*/
58
/*--- Various data structures ---*/
59
struct iwlbuf* D1ERIOUT; /* IWL buffer for target integrals */
60
struct tebuf** tot_data; /* accum. for contracted integrals */
61
vector<int> num_of_ints_in_totdata; /* counts how many integrals are in each tot_data */
62
struct shell_pair *sp_ij, *sp_kl;
63
struct unique_shell_pair *usp_ij,*usp_kl;
67
double_array_t fjt_table;
70
std::vector<int> unique_center; unique_center.reserve(4);
71
std::vector<int> nuc(4);
73
PSI_INT_LEAST64 total_te_count = 0;
74
vector<PSI_INT_LEAST64> te_count_per_coord(num_coords,0); // keeps track of how many integrals were written out
75
int ij, kl, ik, jl, ijkl;
76
int ioffset, joffset, koffset, loffset;
81
int pkblock_end_index = -1;
82
int i, j, k, l, m, ii, jj, kk, ll;
84
int sii, sjj, skk, sll , slll;
87
int upk, num_unique_pk;
88
int usi_arr[3], usj_arr[3], usk_arr[3], usl_arr[3];
89
int *sj_arr, *sk_arr, *sl_arr;
90
int *sj_fbf_arr, *sk_fbf_arr, *sl_fbf_arr;
92
int stab_i,stab_j,stab_k,stab_l,stab_ij,stab_kl;
93
int *R_list, *S_list, *T_list;
95
int dcr_ij, dcr_kl, dcr_ijkl;
97
int num_unique_quartets;
99
int max_num_unique_quartets;
100
int max_num_prim_comb;
102
int size, class_size;
103
int max_cart_class_size;
105
int bf_i, bf_j, bf_k, bf_l, so_i, so_j, so_k, so_l, s;
106
int np_i, np_j, np_k, np_l;
110
int iimax, jjmax, kkmax, llmax;
111
int irrep, npi_ij, npi_kl, npi_ik, npi_jl, ind_offset;
113
int num_prim_comb, p;
116
double pkblock_end_value = 0.0;
119
vector<double> so_int;
121
const int max_num_cdsalc_per_quartet = min(max_num_cdsalcs_per_quartet,CDSALCs.nsalcs);
122
so_int.reserve(max_num_cdsalc_per_quartet);
129
eriout = fopen("d1eriout.dat","w");
131
D1ERIOUT = new struct iwlbuf[num_coords];
132
for(int c=0; c<num_coords; c++)
133
iwl_buf_init(&D1ERIOUT[c], IOUnits.itapD1ERI_SO+c, toler, 0, 0);
135
init_Taylor_Fm_Eval(BasisSet.max_am*4-4+DERIV_LVL,UserOptions.cutoff);
137
init_fjt(BasisSet.max_am*4+DERIV_LVL);
138
init_fjt_table(&fjt_table);
140
init_libderiv_base();
142
/*-------------------------
143
Allocate data structures
144
-------------------------*/
145
max_cart_class_size = (ioff[BasisSet.max_am])*
146
(ioff[BasisSet.max_am])*
147
(ioff[BasisSet.max_am])*
148
(ioff[BasisSet.max_am]);
149
max_num_unique_quartets = Symmetry.max_stab_index*
150
Symmetry.max_stab_index*
151
Symmetry.max_stab_index;
153
// Final integrals are stored here
154
tot_data = new struct tebuf*[num_coords];
155
for(int c=0; c<num_coords; c++) {
156
tot_data[c] = new struct tebuf[max_num_unique_quartets*max_cart_class_size];
158
num_of_ints_in_totdata.resize(num_coords);
159
for(int c=0; c<num_coords; c++)
160
num_of_ints_in_totdata[c] = 0;
162
// These arrays are used to hold cartesian AO derivative integrals
163
double* cart_ints[12];
164
for(int i=0; i<12; i++)
165
cart_ints[i] = new double[max_cart_class_size];
166
// plist_ints holds all symmetry-unique AO shell quartets for a given SO shell quartet
167
// plist_ints[i][j] is the pointer to j-th *total* derivative of i-th AO shell quartet which contributes to the current SO quartet
168
// note that only total derivatives are stored, i.e. partial derivatives produced by libderiv are combined
169
// to yield total derivatives
170
double*** plist_ints = new double**[max_num_unique_quartets];
171
for(int i=0; i<max_num_unique_quartets; i++) {
172
plist_ints[i] = new double*[12];
173
for(int j=0; j<12; j++) {
174
plist_ints[i][j] = new double[max_cart_class_size];
177
// For every SO shell quartet we need the following information:
178
// 1) irreps of all total derivative operators which give nonzero when applied to the SO quartet
179
// 2) given an irrep, which total derivative operators contribute
180
// For every AO shell quartet in a petit list for a given SO shell quartet we need the following information:
181
// 1) number of nonzero total derivatives (same as number of distinct centers, n, times 3, 1 <= n <= 4)
182
// 2) irreps of all total derivative operators which give nonzero when applied to the AO quartet
183
// 3) given an irrep, which total derivative operators contribute
39
namespace psi { namespace CINTS {
185
40
// For a set of SALCs, we need to be able to select coefficients of all nonzero derivatives
186
41
// of a given shell quartet. It is best done when the relevant subset of the (sparse) SALC coefficient
187
42
// matrix is pre-arranged in an array
188
// plist_salcs[s][g][i] is an i-th nonzero contribution to a SALC of irrep g
189
// which results in nonzero when applied to member s of a petite list
190
struct cdsalc_elem_vec {
195
cdsalc_elem_vec** plist_salcs = new cdsalc_elem_vec*[max_num_unique_quartets];
196
for(int i=0; i<max_num_unique_quartets; i++) {
197
plist_salcs[i] = new cdsalc_elem_vec[Symmetry.nirreps];
198
for(int j=0; j<Symmetry.nirreps; j++) {
199
plist_salcs[i][j].nelems=0;
200
plist_salcs[i][j].elems = new cdsalc_elem[max_num_cdsalcs_per_quartet];
204
int* salc_all2thisquartet = new int[num_coords]; // maps absolute SALC index to the SALC index for this quartet
205
int* salc_thisquartet2all = new int[max_num_cdsalcs_per_quartet]; // the reverse of the above
207
sj_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
208
sk_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
209
sl_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
210
if (Symmetry.nirreps > 1) {
211
sj_fbf_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
212
sk_fbf_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
213
sl_fbf_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
216
max_num_prim_comb = (BasisSet.max_num_prims*
217
BasisSet.max_num_prims)*
218
(BasisSet.max_num_prims*
219
BasisSet.max_num_prims);
221
init_libderiv1(&Libderiv, BasisSet.max_am-1, max_num_prim_comb, max_cart_class_size);
223
/*------------------------------------
224
generate all unique shell quartets
225
------------------------------------*/
226
if(UserOptions.print_lvl >= PRINT_DEBUG) {
227
fprintf(outfile," -Electron repulsion integrals:\n\n");
230
for (int usii=0; usii<Symmetry.num_unique_shells; usii++)
231
for (int usjj=0; usjj<=usii; usjj++)
232
for (int uskk=0; uskk<Symmetry.num_unique_shells; uskk++) {
233
const int usll_max = (usii==uskk ? usjj : uskk);
234
for (int usll=0; usll<=usll_max; usll++){
241
/* place in "ascending" angular mom-
242
my simple way of optimizing PHG recursion (VRR) */
243
/* these first two are good for the HRR */
244
if(BasisSet.shells[Symmetry.us2s[usi]].am < BasisSet.shells[Symmetry.us2s[usj]].am){
249
if(BasisSet.shells[Symmetry.us2s[usk]].am < BasisSet.shells[Symmetry.us2s[usl]].am){
254
/* this should be /good/ for the VRR */
255
if(BasisSet.shells[Symmetry.us2s[usi]].am + BasisSet.shells[Symmetry.us2s[usj]].am >
256
BasisSet.shells[Symmetry.us2s[usk]].am + BasisSet.shells[Symmetry.us2s[usl]].am){
265
si = Symmetry.us2s[usi];
266
sjj = Symmetry.us2s[usj];
267
skk = Symmetry.us2s[usk];
268
sll = Symmetry.us2s[usl];
270
int center_i = BasisSet.shells[si].center-1;
271
int center_j = BasisSet.shells[sjj].center-1;
272
int center_k = BasisSet.shells[skk].center-1;
273
int center_l = BasisSet.shells[sll].center-1;
275
if (Symmetry.nirreps > 1) { /*--- Non-C1 symmetry case ---*/
276
/*--- Generate the petite list of shell quadruplets using DCD approach of Davidson ---*/
277
usp_ij = &(Symmetry.us_pairs[usi][usj]);
278
usp_kl = &(Symmetry.us_pairs[usk][usl]);
279
stab_i = Symmetry.atom_positions[center_i];
280
stab_j = Symmetry.atom_positions[center_j];
281
stab_k = Symmetry.atom_positions[center_k];
282
stab_l = Symmetry.atom_positions[center_l];
283
stab_ij = Symmetry.GnG[stab_i][stab_j];
284
stab_kl = Symmetry.GnG[stab_k][stab_l];
285
R_list = Symmetry.dcr[stab_i][stab_j];
286
S_list = Symmetry.dcr[stab_k][stab_l];
287
T_list = Symmetry.dcr[stab_ij][stab_kl];
288
lambda_T = Symmetry.nirreps/Symmetry.dcr_deg[stab_ij][stab_kl];
289
ni = (BasisSet.puream ? 2*BasisSet.shells[si].am - 1 : ioff[BasisSet.shells[si].am]);
290
nj = (BasisSet.puream ? 2*BasisSet.shells[sjj].am - 1 : ioff[BasisSet.shells[sjj].am]);
291
nk = (BasisSet.puream ? 2*BasisSet.shells[skk].am - 1 : ioff[BasisSet.shells[skk].am]);
292
nl = (BasisSet.puream ? 2*BasisSet.shells[sll].am - 1 : ioff[BasisSet.shells[sll].am]);
294
memset(sj_arr,0,sizeof(int)*max_num_unique_quartets);
295
memset(sk_arr,0,sizeof(int)*max_num_unique_quartets);
296
memset(sl_arr,0,sizeof(int)*max_num_unique_quartets);
297
memset(sj_fbf_arr,0,sizeof(int)*max_num_unique_quartets);
298
memset(sk_fbf_arr,0,sizeof(int)*max_num_unique_quartets);
299
memset(sl_fbf_arr,0,sizeof(int)*max_num_unique_quartets);
301
for(dcr_ij=0;dcr_ij<Symmetry.dcr_dim[stab_i][stab_j];dcr_ij++){
303
sj = BasisSet.shells[sjj].trans_vec[R]-1;
304
for(dcr_ijkl=0;dcr_ijkl<Symmetry.dcr_dim[stab_ij][stab_kl];dcr_ijkl++){
305
T = T_list[dcr_ijkl];
306
sk = BasisSet.shells[skk].trans_vec[T]-1;
307
slll = BasisSet.shells[sll].trans_vec[T]-1;
308
for(dcr_kl=0;dcr_kl<Symmetry.dcr_dim[stab_k][stab_l];dcr_kl++) {
310
sl = BasisSet.shells[slll].trans_vec[S]-1;
312
total_am = BasisSet.shells[si].am +
313
BasisSet.shells[sj].am +
314
BasisSet.shells[sk].am +
315
BasisSet.shells[sl].am;
316
/*-------------------------------------------------------------
317
Obviously redundant or zero cases should be eliminated here!
318
Right now only zero case is eliminated. Redundancies arising
319
in DCD approach when usi == usj etc. may be eliminated too
320
but lambda_T will have to be replaced by an array (it won't
321
the same for every shell quartet in petite list anymore).
322
-------------------------------------------------------------*/
324
(BasisSet.shells[si].center!=BasisSet.shells[sj].center)||
325
(BasisSet.shells[sj].center!=BasisSet.shells[sk].center)||
326
(BasisSet.shells[sk].center!=BasisSet.shells[sl].center)) {
330
sj_fbf_arr[count] = BasisSet.shells[sj].fbf-1;
331
sk_fbf_arr[count] = BasisSet.shells[sk].fbf-1;
332
sl_fbf_arr[count] = BasisSet.shells[sl].fbf-1;
338
} /* petite list is ready to be used */
339
num_unique_quartets = count;
341
else { /*--- C1 symmetry case ---*/
342
num_unique_quartets = 1;
346
ni = (BasisSet.puream ? 2*BasisSet.shells[usi].am - 1 : ioff[BasisSet.shells[usi].am]);
347
nj = (BasisSet.puream ? 2*BasisSet.shells[usj].am - 1 : ioff[BasisSet.shells[usj].am]);
348
nk = (BasisSet.puream ? 2*BasisSet.shells[usk].am - 1 : ioff[BasisSet.shells[usk].am]);
349
nl = (BasisSet.puream ? 2*BasisSet.shells[usl].am - 1 : ioff[BasisSet.shells[usl].am]);
350
ioffset = BasisSet.shells[usi].fbf - 1;
351
joffset = BasisSet.shells[usj].fbf - 1;
352
koffset = BasisSet.shells[usk].fbf - 1;
353
loffset = BasisSet.shells[usl].fbf - 1;
355
class_size = ni*nj*nk*nl;
357
/* Determine irreps of all derivative operators whose application to this SO quartet is not identically zero */
358
/* assume Abelian groups only, i.e. at most 8 irreps */
359
int irreps_of_allowed_derivatives = CDSALCs.atom_irreps[center_i] |
360
CDSALCs.atom_irreps[center_j] |
361
CDSALCs.atom_irreps[center_k] |
362
CDSALCs.atom_irreps[center_l];
363
/* Determine the number of all SALC derivative operators which give nonzero when applied to the SO quartet */
369
for(int cd=0; cd<num_coords; cd++)
370
salc_all2thisquartet[cd] = -1;
371
for(int c=0; c<4; c++) {
372
int cart_der = 3*nuc[c];
373
for(int xyz=0; xyz<3; xyz++,cart_der++) {
374
const CDSALC_t::cd2salc_map_t& cd2salc_map = CDSALCs.cd2salc_map[cart_der];
375
const int nsalcs = cd2salc_map.nsalcs;
376
for(int s=0; s<nsalcs; s++) {
377
const int salc = cd2salc_map.salcs[s];
378
if(salc_all2thisquartet[salc] == -1) {
379
salc_all2thisquartet[salc] = salc_count;
380
salc_thisquartet2all[salc_count] = salc;
386
const int nsalcders_for_this_quartet = salc_count;
388
np_i = BasisSet.shells[si].n_prims;
389
np_j = BasisSet.shells[sjj].n_prims;
390
np_k = BasisSet.shells[skk].n_prims;
391
np_l = BasisSet.shells[sll].n_prims;
393
orig_am[0] = BasisSet.shells[si].am-1;
394
orig_am[1] = BasisSet.shells[sjj].am-1;
395
orig_am[2] = BasisSet.shells[skk].am-1;
396
orig_am[3] = BasisSet.shells[sll].am-1;
397
am = orig_am[0] + orig_am[1] + orig_am[2] + orig_am[3];
399
/*----------------------------------
400
Compute the nonredundant quartets
401
----------------------------------*/
402
for(plquartet=0;plquartet<num_unique_quartets;plquartet++) {
403
sj = sj_arr[plquartet];
404
sk = sk_arr[plquartet];
405
sl = sl_arr[plquartet];
407
int center_j = BasisSet.shells[sj].center-1;
408
int center_k = BasisSet.shells[sk].center-1;
409
int center_l = BasisSet.shells[sl].center-1;
411
sp_ij = &(BasisSet.shell_pairs[si][sj]);
412
sp_kl = &(BasisSet.shell_pairs[sk][sl]);
414
Libderiv.AB[0] = sp_ij->AB[0];
415
Libderiv.AB[1] = sp_ij->AB[1];
416
Libderiv.AB[2] = sp_ij->AB[2];
417
Libderiv.CD[0] = sp_kl->AB[0];
418
Libderiv.CD[1] = sp_kl->AB[1];
419
Libderiv.CD[2] = sp_kl->AB[2];
421
AB2 = Libderiv.AB[0]*Libderiv.AB[0]+Libderiv.AB[1]*Libderiv.AB[1]+Libderiv.AB[2]*Libderiv.AB[2];
422
CD2 = Libderiv.CD[0]*Libderiv.CD[0]+Libderiv.CD[1]*Libderiv.CD[1]+Libderiv.CD[2]*Libderiv.CD[2];
424
/*--- Compute data for primitive quartets here ---*/
426
const double pfac = lambda_T;
44
double coef; // contribution of this cartesian derivative to this SALC
45
int cart_der; // cartesian derivative (for this quartet) [0,3*num_unique_atoms)
46
int salc; // SALC index [0,num_atoms*3)
52
const double toler = UserOptions.cutoff;
53
const int num_coords = 3*Molecule.num_atoms; // total number of coordinates, symmetry-adapted or otherwise
54
// max number of nonzero derivatives for a SO shell quartet = 4 (centers) * 3 (x,y,z) * maximum multiplicity of a nucleus
55
const int max_num_cdsalcs_per_quartet = 12*Symmetry.max_stab_index;
57
/*--- ASCII file to print integrals ---*/
60
/*--- Various data structures ---*/
61
struct iwlbuf* D1ERIOUT; /* IWL buffer for target integrals */
62
struct tebuf** tot_data; /* accum. for contracted integrals */
63
vector<int> num_of_ints_in_totdata; /* counts how many integrals are in each tot_data */
64
struct shell_pair *sp_ij, *sp_kl;
65
struct unique_shell_pair *usp_ij,*usp_kl;
69
double_array_t fjt_table;
72
std::vector<int> unique_center; unique_center.reserve(4);
73
std::vector<int> nuc(4);
75
PSI_INT_LEAST64 total_te_count = 0;
76
vector<PSI_INT_LEAST64> te_count_per_coord(num_coords,0); // keeps track of how many integrals were written out
77
int ij, kl, ik, jl, ijkl;
78
int ioffset, joffset, koffset, loffset;
83
int pkblock_end_index = -1;
84
int i, j, k, l, m, ii, jj, kk, ll;
86
int sii, sjj, skk, sll , slll;
89
int upk, num_unique_pk;
90
int usi_arr[3], usj_arr[3], usk_arr[3], usl_arr[3];
91
int *sj_arr, *sk_arr, *sl_arr;
92
int *sj_fbf_arr, *sk_fbf_arr, *sl_fbf_arr;
94
int stab_i,stab_j,stab_k,stab_l,stab_ij,stab_kl;
95
int *R_list, *S_list, *T_list;
97
int dcr_ij, dcr_kl, dcr_ijkl;
99
int num_unique_quartets;
101
int max_num_unique_quartets;
102
int max_num_prim_comb;
104
int size, class_size;
105
int max_cart_class_size;
107
int bf_i, bf_j, bf_k, bf_l, so_i, so_j, so_k, so_l, s;
108
int np_i, np_j, np_k, np_l;
112
int iimax, jjmax, kkmax, llmax;
113
int irrep, npi_ij, npi_kl, npi_ik, npi_jl, ind_offset;
115
int num_prim_comb, p;
118
double pkblock_end_value = 0.0;
121
vector<double> so_int;
123
const int max_num_cdsalc_per_quartet = min(max_num_cdsalcs_per_quartet,CDSALCs.nsalcs);
124
so_int.reserve(max_num_cdsalc_per_quartet);
131
eriout = fopen("d1eriout.dat","w");
133
D1ERIOUT = new struct iwlbuf[num_coords];
134
for(int c=0; c<num_coords; c++)
135
iwl_buf_init(&D1ERIOUT[c], IOUnits.itapD1ERI_SO+c, toler, 0, 0);
137
init_Taylor_Fm_Eval(BasisSet.max_am*4-4+DERIV_LVL,UserOptions.cutoff);
139
init_fjt(BasisSet.max_am*4+DERIV_LVL);
140
init_fjt_table(&fjt_table);
142
init_libderiv_base();
144
/*-------------------------
145
Allocate data structures
146
-------------------------*/
147
max_cart_class_size = (ioff[BasisSet.max_am])*
148
(ioff[BasisSet.max_am])*
149
(ioff[BasisSet.max_am])*
150
(ioff[BasisSet.max_am]);
151
max_num_unique_quartets = Symmetry.max_stab_index*
152
Symmetry.max_stab_index*
153
Symmetry.max_stab_index;
155
// Final integrals are stored here
156
tot_data = new struct tebuf*[num_coords];
157
for(int c=0; c<num_coords; c++) {
158
tot_data[c] = new struct tebuf[max_num_unique_quartets*max_cart_class_size];
160
num_of_ints_in_totdata.resize(num_coords);
161
for(int c=0; c<num_coords; c++)
162
num_of_ints_in_totdata[c] = 0;
164
// These arrays are used to hold cartesian AO derivative integrals
165
double* cart_ints[12];
166
for(int i=0; i<12; i++)
167
cart_ints[i] = new double[max_cart_class_size];
168
// plist_ints holds all symmetry-unique AO shell quartets for a given SO shell quartet
169
// plist_ints[i][j] is the pointer to j-th *total* derivative of i-th AO shell quartet which contributes to the current SO quartet
170
// note that only total derivatives are stored, i.e. partial derivatives produced by libderiv are combined
171
// to yield total derivatives
172
double*** plist_ints = new double**[max_num_unique_quartets];
173
for(int i=0; i<max_num_unique_quartets; i++) {
174
plist_ints[i] = new double*[12];
175
for(int j=0; j<12; j++) {
176
plist_ints[i][j] = new double[max_cart_class_size];
179
// For every SO shell quartet we need the following information:
180
// 1) irreps of all total derivative operators which give nonzero when applied to the SO quartet
181
// 2) given an irrep, which total derivative operators contribute
182
// For every AO shell quartet in a petit list for a given SO shell quartet we need the following information:
183
// 1) number of nonzero total derivatives (same as number of distinct centers, n, times 3, 1 <= n <= 4)
184
// 2) irreps of all total derivative operators which give nonzero when applied to the AO quartet
185
// 3) given an irrep, which total derivative operators contribute
187
// For a set of SALCs, we need to be able to select coefficients of all nonzero derivatives
188
// of a given shell quartet. It is best done when the relevant subset of the (sparse) SALC coefficient
189
// matrix is pre-arranged in an array
190
// plist_salcs[s][g][i] is an i-th nonzero contribution to a SALC of irrep g
191
// which results in nonzero when applied to member s of a petite list
192
struct cdsalc_elem_vec {
197
cdsalc_elem_vec** plist_salcs = new cdsalc_elem_vec*[max_num_unique_quartets];
198
for(int i=0; i<max_num_unique_quartets; i++) {
199
plist_salcs[i] = new cdsalc_elem_vec[Symmetry.nirreps];
200
for(int j=0; j<Symmetry.nirreps; j++) {
201
plist_salcs[i][j].nelems=0;
202
plist_salcs[i][j].elems = new cdsalc_elem[max_num_cdsalcs_per_quartet];
206
int* salc_all2thisquartet = new int[num_coords]; // maps absolute SALC index to the SALC index for this quartet
207
int* salc_thisquartet2all = new int[max_num_cdsalcs_per_quartet]; // the reverse of the above
209
sj_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
210
sk_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
211
sl_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
212
if (Symmetry.nirreps > 1) {
213
sj_fbf_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
214
sk_fbf_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
215
sl_fbf_arr = (int *)malloc(sizeof(int)*max_num_unique_quartets);
218
max_num_prim_comb = (BasisSet.max_num_prims*
219
BasisSet.max_num_prims)*
220
(BasisSet.max_num_prims*
221
BasisSet.max_num_prims);
223
init_libderiv1(&Libderiv, BasisSet.max_am-1, max_num_prim_comb, max_cart_class_size);
225
/*------------------------------------
226
generate all unique shell quartets
227
------------------------------------*/
228
if(UserOptions.print_lvl >= PRINT_DEBUG) {
229
fprintf(outfile," -Electron repulsion integrals:\n\n");
232
for (int usii=0; usii<Symmetry.num_unique_shells; usii++)
233
for (int usjj=0; usjj<=usii; usjj++)
234
for (int uskk=0; uskk<Symmetry.num_unique_shells; uskk++) {
235
const int usll_max = (usii==uskk ? usjj : uskk);
236
for (int usll=0; usll<=usll_max; usll++){
243
/* place in "ascending" angular mom-
244
my simple way of optimizing PHG recursion (VRR) */
245
/* these first two are good for the HRR */
246
if(BasisSet.shells[Symmetry.us2s[usi]].am < BasisSet.shells[Symmetry.us2s[usj]].am){
251
if(BasisSet.shells[Symmetry.us2s[usk]].am < BasisSet.shells[Symmetry.us2s[usl]].am){
256
/* this should be /good/ for the VRR */
257
if(BasisSet.shells[Symmetry.us2s[usi]].am + BasisSet.shells[Symmetry.us2s[usj]].am >
258
BasisSet.shells[Symmetry.us2s[usk]].am + BasisSet.shells[Symmetry.us2s[usl]].am){
267
si = Symmetry.us2s[usi];
268
sjj = Symmetry.us2s[usj];
269
skk = Symmetry.us2s[usk];
270
sll = Symmetry.us2s[usl];
272
int center_i = BasisSet.shells[si].center-1;
273
int center_j = BasisSet.shells[sjj].center-1;
274
int center_k = BasisSet.shells[skk].center-1;
275
int center_l = BasisSet.shells[sll].center-1;
277
if (Symmetry.nirreps > 1) { /*--- Non-C1 symmetry case ---*/
278
/*--- Generate the petite list of shell quadruplets using DCD approach of Davidson ---*/
279
usp_ij = &(Symmetry.us_pairs[usi][usj]);
280
usp_kl = &(Symmetry.us_pairs[usk][usl]);
281
stab_i = Symmetry.atom_positions[center_i];
282
stab_j = Symmetry.atom_positions[center_j];
283
stab_k = Symmetry.atom_positions[center_k];
284
stab_l = Symmetry.atom_positions[center_l];
285
stab_ij = Symmetry.GnG[stab_i][stab_j];
286
stab_kl = Symmetry.GnG[stab_k][stab_l];
287
R_list = Symmetry.dcr[stab_i][stab_j];
288
S_list = Symmetry.dcr[stab_k][stab_l];
289
T_list = Symmetry.dcr[stab_ij][stab_kl];
290
lambda_T = Symmetry.nirreps/Symmetry.dcr_deg[stab_ij][stab_kl];
291
ni = (BasisSet.puream ? 2*BasisSet.shells[si].am - 1 : ioff[BasisSet.shells[si].am]);
292
nj = (BasisSet.puream ? 2*BasisSet.shells[sjj].am - 1 : ioff[BasisSet.shells[sjj].am]);
293
nk = (BasisSet.puream ? 2*BasisSet.shells[skk].am - 1 : ioff[BasisSet.shells[skk].am]);
294
nl = (BasisSet.puream ? 2*BasisSet.shells[sll].am - 1 : ioff[BasisSet.shells[sll].am]);
296
memset(sj_arr,0,sizeof(int)*max_num_unique_quartets);
297
memset(sk_arr,0,sizeof(int)*max_num_unique_quartets);
298
memset(sl_arr,0,sizeof(int)*max_num_unique_quartets);
299
memset(sj_fbf_arr,0,sizeof(int)*max_num_unique_quartets);
300
memset(sk_fbf_arr,0,sizeof(int)*max_num_unique_quartets);
301
memset(sl_fbf_arr,0,sizeof(int)*max_num_unique_quartets);
303
for(dcr_ij=0;dcr_ij<Symmetry.dcr_dim[stab_i][stab_j];dcr_ij++){
305
sj = BasisSet.shells[sjj].trans_vec[R]-1;
306
for(dcr_ijkl=0;dcr_ijkl<Symmetry.dcr_dim[stab_ij][stab_kl];dcr_ijkl++){
307
T = T_list[dcr_ijkl];
308
sk = BasisSet.shells[skk].trans_vec[T]-1;
309
slll = BasisSet.shells[sll].trans_vec[T]-1;
310
for(dcr_kl=0;dcr_kl<Symmetry.dcr_dim[stab_k][stab_l];dcr_kl++) {
312
sl = BasisSet.shells[slll].trans_vec[S]-1;
314
total_am = BasisSet.shells[si].am +
315
BasisSet.shells[sj].am +
316
BasisSet.shells[sk].am +
317
BasisSet.shells[sl].am;
318
/*-------------------------------------------------------------
319
Obviously redundant or zero cases should be eliminated here!
320
Right now only zero case is eliminated. Redundancies arising
321
in DCD approach when usi == usj etc. may be eliminated too
322
but lambda_T will have to be replaced by an array (it won't
323
the same for every shell quartet in petite list anymore).
324
-------------------------------------------------------------*/
326
(BasisSet.shells[si].center!=BasisSet.shells[sj].center)||
327
(BasisSet.shells[sj].center!=BasisSet.shells[sk].center)||
328
(BasisSet.shells[sk].center!=BasisSet.shells[sl].center)) {
332
sj_fbf_arr[count] = BasisSet.shells[sj].fbf-1;
333
sk_fbf_arr[count] = BasisSet.shells[sk].fbf-1;
334
sl_fbf_arr[count] = BasisSet.shells[sl].fbf-1;
340
} /* petite list is ready to be used */
341
num_unique_quartets = count;
343
else { /*--- C1 symmetry case ---*/
344
num_unique_quartets = 1;
348
ni = (BasisSet.puream ? 2*BasisSet.shells[usi].am - 1 : ioff[BasisSet.shells[usi].am]);
349
nj = (BasisSet.puream ? 2*BasisSet.shells[usj].am - 1 : ioff[BasisSet.shells[usj].am]);
350
nk = (BasisSet.puream ? 2*BasisSet.shells[usk].am - 1 : ioff[BasisSet.shells[usk].am]);
351
nl = (BasisSet.puream ? 2*BasisSet.shells[usl].am - 1 : ioff[BasisSet.shells[usl].am]);
352
ioffset = BasisSet.shells[usi].fbf - 1;
353
joffset = BasisSet.shells[usj].fbf - 1;
354
koffset = BasisSet.shells[usk].fbf - 1;
355
loffset = BasisSet.shells[usl].fbf - 1;
357
class_size = ni*nj*nk*nl;
359
/* Determine irreps of all derivative operators whose application to this SO quartet is not identically zero */
360
/* assume Abelian groups only, i.e. at most 8 irreps */
361
int irreps_of_allowed_derivatives = CDSALCs.atom_irreps[center_i] |
362
CDSALCs.atom_irreps[center_j] |
363
CDSALCs.atom_irreps[center_k] |
364
CDSALCs.atom_irreps[center_l];
365
/* Determine the number of all SALC derivative operators which give nonzero when applied to the SO quartet */
371
for(int cd=0; cd<num_coords; cd++)
372
salc_all2thisquartet[cd] = -1;
373
for(int c=0; c<4; c++) {
374
int cart_der = 3*nuc[c];
375
for(int xyz=0; xyz<3; xyz++,cart_der++) {
376
const CDSALC_t::cd2salc_map_t& cd2salc_map = CDSALCs.cd2salc_map[cart_der];
377
const int nsalcs = cd2salc_map.nsalcs;
378
for(int s=0; s<nsalcs; s++) {
379
const int salc = cd2salc_map.salcs[s];
380
if(salc_all2thisquartet[salc] == -1) {
381
salc_all2thisquartet[salc] = salc_count;
382
salc_thisquartet2all[salc_count] = salc;
388
const int nsalcders_for_this_quartet = salc_count;
390
np_i = BasisSet.shells[si].n_prims;
391
np_j = BasisSet.shells[sjj].n_prims;
392
np_k = BasisSet.shells[skk].n_prims;
393
np_l = BasisSet.shells[sll].n_prims;
395
orig_am[0] = BasisSet.shells[si].am-1;
396
orig_am[1] = BasisSet.shells[sjj].am-1;
397
orig_am[2] = BasisSet.shells[skk].am-1;
398
orig_am[3] = BasisSet.shells[sll].am-1;
399
am = orig_am[0] + orig_am[1] + orig_am[2] + orig_am[3];
401
/*----------------------------------
402
Compute the nonredundant quartets
403
----------------------------------*/
404
for(plquartet=0;plquartet<num_unique_quartets;plquartet++) {
405
sj = sj_arr[plquartet];
406
sk = sk_arr[plquartet];
407
sl = sl_arr[plquartet];
409
int center_j = BasisSet.shells[sj].center-1;
410
int center_k = BasisSet.shells[sk].center-1;
411
int center_l = BasisSet.shells[sl].center-1;
413
sp_ij = &(BasisSet.shell_pairs[si][sj]);
414
sp_kl = &(BasisSet.shell_pairs[sk][sl]);
416
Libderiv.AB[0] = sp_ij->AB[0];
417
Libderiv.AB[1] = sp_ij->AB[1];
418
Libderiv.AB[2] = sp_ij->AB[2];
419
Libderiv.CD[0] = sp_kl->AB[0];
420
Libderiv.CD[1] = sp_kl->AB[1];
421
Libderiv.CD[2] = sp_kl->AB[2];
423
AB2 = Libderiv.AB[0]*Libderiv.AB[0]+Libderiv.AB[1]*Libderiv.AB[1]+Libderiv.AB[2]*Libderiv.AB[2];
424
CD2 = Libderiv.CD[0]*Libderiv.CD[0]+Libderiv.CD[1]*Libderiv.CD[1]+Libderiv.CD[2]*Libderiv.CD[2];
426
/*--- Compute data for primitive quartets here ---*/
428
const double pfac = lambda_T;
427
429
#define NO_PERM_SYMM 0
429
for (pi = 0; pi < np_i; pi++) {
430
for (pj = 0; pj < np_j; pj++) {
431
for (pk = 0; pk < np_k; pk++) {
432
for (pl = 0; pl < np_l; pl++){
431
for (pi = 0; pi < np_i; pi++) {
432
for (pj = 0; pj < np_j; pj++) {
433
for (pk = 0; pk < np_k; pk++) {
434
for (pl = 0; pl < np_l; pl++){
435
for (pi = 0; pi < np_i; pi++) {
436
max_pj = (si == sj) ? pi+1 : np_j;
437
for (pj = 0; pj < max_pj; pj++) {
438
m = (1 + (si == sj && pi != pj));
439
for (pk = 0; pk < np_k; pk++) {
440
max_pl = (sk == sl) ? pk+1 : np_l;
441
for (pl = 0; pl < max_pl; pl++){
442
const int n = m * (1 + (sk == sl && pk != pl));
437
for (pi = 0; pi < np_i; pi++) {
438
max_pj = (si == sj) ? pi+1 : np_j;
439
for (pj = 0; pj < max_pj; pj++) {
440
m = (1 + (si == sj && pi != pj));
441
for (pk = 0; pk < np_k; pk++) {
442
max_pl = (sk == sl) ? pk+1 : np_l;
443
for (pl = 0; pl < max_pl; pl++){
444
const int n = m * (1 + (sk == sl && pk != pl));
444
446
#ifdef USE_TAYLOR_FM
445
447
deriv1_quartet_data(&(Libderiv.PrimQuartet[num_prim_comb++]),