5
int dpd_buf4_mat_irrep_row_wrt(dpdbuf4 *Buf, int irrep, int pq)
7
int method, filerow, all_buf_irrep;
8
int rs; /* dpdfile row and column indices */
9
int p, q, r, s; /* orbital indices */
10
int bufpq, bufrs; /* Input dpdbuf row and column indices */
12
int rowtot, coltot; /* dpdfile row and column dimensions */
13
int b_perm_pq, b_perm_rs, b_peq, b_res;
14
int f_perm_pq, f_perm_rs, f_peq, f_res;
18
all_buf_irrep = Buf->file.my_irrep;
19
/* Row and column dimensions in the DPD file */
20
rowtot = Buf->file.params->rowtot[irrep];
21
coltot = Buf->file.params->coltot[irrep^all_buf_irrep];
23
/* Index packing information */
24
b_perm_pq = Buf->params->perm_pq; b_perm_rs = Buf->params->perm_rs;
25
f_perm_pq = Buf->file.params->perm_pq; f_perm_rs = Buf->file.params->perm_rs;
26
b_peq = Buf->params->peq; b_res = Buf->params->res;
27
f_peq = Buf->file.params->peq; f_res = Buf->file.params->res;
29
/* Exit if buffer is antisymmetrized */
31
fprintf(stderr, "\n\tCannot write antisymmetrized buffer\n");
32
fprintf(stderr, "\tback to original DPD file!\n");
33
exit(PSI_RETURN_FAILURE);
36
if((b_perm_pq == f_perm_pq) && (b_perm_rs == f_perm_rs) &&
37
(b_peq == f_peq) && (b_res == f_res)) method = 12;
38
else if((b_perm_pq != f_perm_pq) && (b_perm_rs == f_perm_rs) &&
40
if(f_perm_pq && !b_perm_pq) method = 21;
41
else if(!f_perm_pq && b_perm_pq) method = 23;
43
fprintf(stderr, "\n\tInvalid second-level method!\n");
44
exit(PSI_RETURN_FAILURE);
47
else if((b_perm_pq == f_perm_pq) && (b_perm_rs != f_perm_rs) &&
49
if(f_perm_rs && !b_perm_rs) method = 31;
50
else if(!f_perm_rs && b_perm_rs) method = 33;
52
fprintf(stderr, "\n\tInvalid third-level method!\n");
53
exit(PSI_RETURN_FAILURE);
56
else if((b_perm_pq != f_perm_pq) && (b_perm_rs != f_perm_rs)) {
57
if(f_perm_pq && !b_perm_pq) {
58
if(f_perm_rs && !b_perm_rs) method = 41;
59
else if(!f_perm_rs && b_perm_rs) method = 42;
61
else if(!f_perm_pq && b_perm_pq) {
62
if(f_perm_rs && !b_perm_rs) method = 43;
63
else if(!f_perm_rs && b_perm_rs) method = 45;
66
fprintf(stderr, "\n\tInvalid fourth-level method!\n");
67
exit(PSI_RETURN_FAILURE);
71
fprintf(stderr, "\n\tInvalid method in dpd_buf_mat_irrep_rd!\n");
72
exit(PSI_RETURN_FAILURE);
77
case 12: /* No change in pq or rs */
79
if(Buf->file.incore) {
80
for(rs=0; rs < rowtot; rs++)
81
Buf->file.matrix[irrep][pq][rs] = Buf->matrix[irrep][0][rs];
82
dpd_file4_cache_dirty(&(Buf->file));
85
Buf->file.matrix[irrep] = Buf->matrix[irrep];
86
dpd_file4_mat_irrep_row_wrt(&(Buf->file), irrep, pq);
90
case 21: /* Pack pq; no change in rs */
91
/* Prepare the output buffer for the output DPD file */
92
dpd_file4_mat_irrep_row_init(&(Buf->file), irrep);
94
p = Buf->file.params->roworb[irrep][pq][0];
95
q = Buf->file.params->roworb[irrep][pq][1];
96
filepq = Buf->file.params->rowidx[p][q];
98
filerow = Buf->file.incore ? filepq : 0;
100
/* Loop over the columns in the dpdbuf */
101
for(rs=0; rs < coltot; rs++) {
104
value = Buf->matrix[irrep][0][bufrs];
106
/* Assign the value */
107
Buf->file.matrix[irrep][filerow][rs] = value;
110
/* Write out the row */
111
dpd_file4_mat_irrep_row_wrt(&(Buf->file), irrep, filepq);
113
/* Close the input buffer */
114
dpd_file4_mat_irrep_row_close(&(Buf->file), irrep);
117
case 23: /* Unpack pq; no change in rs */
118
/* I don't know if I'll ever use this, so I'll avoid it for now */
119
fprintf(stderr, "\n\tShould you be using method %d?\n", method);
120
exit(PSI_RETURN_FAILURE);
123
case 31: /* No change in pq; pack rs */
124
/* Prepare the output buffer for the output DPD file */
125
dpd_file4_mat_irrep_row_init(&(Buf->file), irrep);
127
filerow = Buf->file.incore ? pq : 0;
129
/* Loop over the columns in the dpdfile */
130
for(rs=0; rs < coltot; rs++) {
131
r = Buf->file.params->colorb[irrep^all_buf_irrep][rs][0];
132
s = Buf->file.params->colorb[irrep^all_buf_irrep][rs][1];
133
bufrs = Buf->params->colidx[r][s];
135
value = Buf->matrix[irrep][0][bufrs];
137
/* Assign the value */
138
Buf->file.matrix[irrep][filerow][rs] = value;
141
/* Write out the row */
142
dpd_file4_mat_irrep_row_wrt(&(Buf->file), irrep, pq);
144
/* Close the input buffer */
145
dpd_file4_mat_irrep_row_close(&(Buf->file), irrep);
148
case 33: /* No change in pq; unpack rs */
149
/* I'm not sure if I'll ever need this, so I'm removing it for now */
150
fprintf(stderr, "\n\tShould you be using method %d?\n", method);
151
exit(PSI_RETURN_FAILURE);
154
case 41: /* Pack pq and rs */
155
/* Prepare the output buffer for the output DPD file */
156
dpd_file4_mat_irrep_row_init(&(Buf->file), irrep);
158
p = Buf->file.params->roworb[irrep][pq][0];
159
q = Buf->file.params->roworb[irrep][pq][1];
160
filepq = Buf->file.params->rowidx[p][q];
162
filerow = Buf->file.incore ? filepq : 0;
165
/* Loop over the columns in the dpdfile */
166
for(rs=0; rs < coltot; rs++) {
167
r = Buf->file.params->colorb[irrep^all_buf_irrep][rs][0];
168
s = Buf->file.params->colorb[irrep^all_buf_irrep][rs][1];
169
bufrs = Buf->params->colidx[r][s];
171
value = Buf->matrix[irrep][0][bufrs];
173
/* Assign the value */
174
Buf->file.matrix[irrep][filerow][rs] = value;
177
/* Write out the row */
178
dpd_file4_mat_irrep_row_wrt(&(Buf->file), irrep, filepq);
180
/* Close the input buffer */
181
dpd_file4_mat_irrep_row_close(&(Buf->file), irrep);
184
case 42: /* Pack pq; unpack rs */
185
fprintf(stderr, "\n\tHaven't programmed method 42 yet!\n");
186
exit(PSI_RETURN_FAILURE);
189
case 43: /* Unpack pq; pack rs */
190
fprintf(stderr, "\n\tHaven't programmed method 43 yet!\n");
191
exit(PSI_RETURN_FAILURE);
194
case 45: /* Unpack pq and rs */
195
/* I'm not sure if I'll ever need this, so I'm removing it for now */
196
fprintf(stderr, "\n\tShould you be using method %d?\n", method);
197
exit(PSI_RETURN_FAILURE);
200
default: /* Error trapping */
201
fprintf(stderr, "\n\tInvalid switch case in dpd_buf_mat_irrep_rd!\n");
202
exit(PSI_RETURN_FAILURE);
added
removed
src/lib/libdpd/buf4_mat_irrep_row_wrt.c
