3
\brief Enter brief description of file here
9
** File contains routines associated with printing CI space, vectors, etc.
12
** Center for Computational Quantum Chemistry
13
** University of Georgia
19
#include <cctype> // for toupper()
20
#include <libciomr/libciomr.h>
26
namespace psi { namespace detci {
28
#define CONFIG_STRING_MAX 200
29
#define FLAG_NONBLOCKS
30
#define MIN_COEFF 1.0E-13
32
void orb2lbl(int orbnum, char *label);
33
void print_config(int nbf, int num_alp_el, int num_bet_el,
34
struct stringwr *stralp, struct stringwr *strbet,
35
int num_fzc_orbs, char *outstring);
36
extern int str_rel2abs(int relidx, int listnum, struct olsen_graph *Graph);
42
** Print the Most Important Determinants in the CI vector
43
** David Sherrill, February 1995
45
void print_vec(unsigned int nprint, int *Ialist, int *Iblist,
46
int *Iaidx, int *Ibidx, double *coeff,
47
struct olsen_graph *AlphaG, struct olsen_graph *BetaG,
48
struct stringwr **alplist, struct stringwr **betlist,
53
double value, abs_value, minval=0.0;
54
unsigned int alp_idx, bet_idx;
55
char configstring[CONFIG_STRING_MAX];
62
/* print out the list of most important determinants */
63
fprintf(outfile, "\n\nThe %d most important determinants\n\n", nprint) ;
64
for (i=0; i<nprint; i++) {
66
if (fabs(coeff[i]) < MIN_COEFF) continue;
68
Ia_abs = str_rel2abs(Iaidx[i], Ialist[i], AlphaG);
69
Ib_abs = str_rel2abs(Ibidx[i], Iblist[i], BetaG);
72
for (j=0, found_inblock=0; j<H0block.size; j++) {
73
if (Iaidx[i] == H0block.alpidx[j] &&
74
Ibidx[i] == H0block.betidx[j] &&
75
Ialist[i] == H0block.alplist[j] &&
76
Iblist[i] == H0block.betlist[j]) {
81
fprintf(outfile, "%c", found_inblock ? ' ' : '*');
84
fprintf(outfile, "%4d %10.6lf (%5d,%5d) ", i+1, coeff[i],
87
print_config(AlphaG->num_orb, AlphaG->num_el_expl, BetaG->num_el_expl,
88
alplist[Ialist[i]] + Iaidx[i], betlist[Iblist[i]] + Ibidx[i],
89
AlphaG->num_fzc_orbs, configstring);
91
fprintf(outfile, "%s\n", configstring);
93
} /* end loop over important determinants */
95
fprintf(outfile, "\n\n");
104
** Function prints a configuration, given a list of
105
** alpha and beta string occupancies.
107
** David Sherrill, February 1995
110
void print_config(int nbf, int num_alp_el, int num_bet_el,
111
struct stringwr *stralp, struct stringwr *strbet, int num_fzc_orbs,
118
sprintf(outstring, "");
120
/* loop over orbitals */
121
for (j=0; j<nbf; j++) {
123
orb2lbl(j+num_fzc_orbs, olabel); /* get label for orbital j */
125
for (k=0,afound=0; k<num_alp_el; k++) {
126
if ((stralp->occs)[k] > j) break;
127
else if ((stralp->occs)[k] == j) {
132
for (k=0, bfound=0; k<num_bet_el; k++) {
133
if ((strbet->occs)[k] > j) break;
134
else if ((strbet->occs)[k] == j) {
139
if (afound || bfound) strcat(outstring, olabel);
141
if (afound && bfound) strcat(outstring, "X ");
142
else if (afound) strcat(outstring, "A ");
143
else if (bfound) strcat(outstring, "B ");
144
} /* end loop over orbitals */
152
** This function is for debugging purposes. It prints the
153
** CI space and the associated single-replacement lists.
156
** strlist = list of alpha/beta strings
157
** num_strings = number of strings in list
158
** nirreps = number of irreducible representations in molecular pt grp
159
** strtypes = number of possible string types (nirreps * ncodes)
160
** nel = number of electrons explicitly included
161
** outfile = file to print to
163
void print_ci_space(struct stringwr *strlist, int num_strings,
164
int nirreps, int strtypes, int nel, FILE *outfile)
166
int i, j, strsym, cnt=0 ;
168
while (cnt != num_strings) {
169
fprintf(outfile, "\nString %4d (", cnt++);
170
for (i=0; i<nel; i++)
171
fprintf(outfile, "%2d ", (int) (strlist->occs)[i]) ;
172
fprintf(outfile, ")\n");
174
if (!Parameters.repl_otf) {
175
fprintf(outfile, " Links:\n") ;
176
for (strsym=0; strsym < strtypes; strsym++) {
177
for (j=0; j<strlist->cnt[strsym]; j++) {
178
fprintf(outfile, " %3d [%3d] %c (%2d %3d) %d\n",
179
strlist->ij[strsym][j],
180
strlist->oij[strsym][j],
181
(strlist->sgn[strsym][j] == 1) ? '+' : '-',
182
strsym, strlist->ridx[strsym][j],
183
(int) strlist->sgn[strsym][j]);
185
} /* end loop over strsym */
193
** orb2lbl(): Function converts an absolute orbital number into a
194
** label such as 4A1, 2B2, etc.
197
** orbnum = orbital number in CI order (add frozen core!)
198
** label = place to put constructed label
200
** Needs Global (CalcInfo):
201
** orbs_per_irrep = number of orbitals per irrep
202
** order = ordering array which maps a CI orbital to a
203
** Pitzer orbital (the opposite mapping from the
205
** irreps = number of irreducible reps
206
** nmo = num of molecular orbitals
207
** labels = labels for all the irreps
210
** If there are frozen core (FZC) orbitals, they are not included in the
211
** CI numbering (unless they're "restricted" or COR orbitals). This
212
** is bothersome because some of the arrays constructed in the CI program
213
** do start numbering from FZC orbitals. Thus, pass orbnum as the CI
214
** orbital PLUS any frozen core orbitals.
216
** Updated 8/16/95 by CDS
217
** Allow it to handle more complex spaces...don't assume QT orbital order.
218
** It was getting labels all mixed up for RAS's.
220
void orb2lbl(int orbnum, char *label)
223
int ir, i, j, pitzer_orb, rel_orb;
225
/* get Pitzer ordering */
226
pitzer_orb = CalcInfo.order[orbnum];
228
if (pitzer_orb > CalcInfo.nmo) {
229
fprintf(outfile, "(orb2lbl): pitzer_orb > nmo!\n");
232
for (ir=0,j=0; ir<CalcInfo.nirreps; ir++) {
233
if (CalcInfo.orbs_per_irr[ir] == 0) continue;
234
if (j + CalcInfo.orbs_per_irr[ir] > pitzer_orb) break;
235
else j += CalcInfo.orbs_per_irr[ir];
237
rel_orb = pitzer_orb - j;
240
fprintf(outfile, "(orb2lbl): rel_orb < 0\n");
242
else if (rel_orb > CalcInfo.orbs_per_irr[ir]) {
243
fprintf(outfile, "(orb2lbl): rel_orb > orbs_per_irrep[ir]\n");
246
sprintf(label, "%d%s", rel_orb+1, CalcInfo.labels[ir]);
252
** lbl2orb(): Function converts a label such as 4A1, 2B2, etc., to
253
** an absolute orbital number. The reverse of the above function
257
** orbnum = orbital number in CI order (add frozen core!)
258
** label = place to put constructed label
261
** absolute orbital number for the correlated calc (less frozen)
264
int lbl2orb(char *orbstring)
267
int ir, i, j, pitzer_orb, rel_orb, corr_orb;
271
sscanf(orbstring, "%d%s", &rel_orb, orblbl);
274
for (i=0,ir=-1; i<CalcInfo.nirreps; i++) {
276
t = CalcInfo.labels[i];
278
while ((toupper(*s) == toupper(*t)) && (j < strlen(orblbl))) {
283
if (j == strlen(orblbl)) {
290
fprintf(outfile, "lbl2orb: can't find label %s!\n", orblbl);
294
/* get Pitzer ordering */
295
for (i=0,pitzer_orb=0; i<ir; i++) {
296
pitzer_orb += CalcInfo.orbs_per_irr[i];
298
pitzer_orb += rel_orb - 1; /* 1A1 is orbital 0 in A1 stack ... */
300
/* get correlated ordering */
301
corr_orb = CalcInfo.reorder[pitzer_orb];
303
/* probably need to subtract frozen here */
304
corr_orb -= CalcInfo.num_fzc_orbs;
306
if (corr_orb < 0 || corr_orb > CalcInfo.num_ci_orbs) {
307
fprintf(outfile, "lbl2orb: error corr_orb out of bounds, %d\n",
317
void eivout_t(double **a, double *b, int m, int n, FILE *out)
331
for (i=ii; i <= nn; i++) fprintf(out," %5d",i);
333
for (i=0; i < m; i++) {
334
fprintf (out,"\n%5d",i+1);
335
for (j=ii-1; j < nn; j++) {
336
fprintf (out,"%12.7f",a[j][i]);
341
for (j=ii-1; j < nn; j++) {
342
fprintf(out,"%12.7f",b[j]);
354
** PRINT_CIBLK_SUMMARY()
360
void print_ciblk_summary(FILE *outfile)
364
fprintf(outfile, "\nCI Block Summary:\n");
365
for (blk=0; blk<CIblks.num_blocks; blk++) {
366
fprintf(outfile,"Block %3d: Alp=%3d, Bet=%3d Size = %4d x %4d = %ld\n",
367
blk, CIblks.Ia_code[blk], CIblks.Ib_code[blk],
368
CIblks.Ia_size[blk], CIblks.Ib_size[blk],
369
(unsigned long) CIblks.Ia_size[blk] *
370
(unsigned long) CIblks.Ib_size[blk]);
377
** This routine writes out the energies to an ASCII file
379
void write_energy(int nroots, double *evals, double offset)
384
ffile(&efile,"detci_energies.dat",1);
385
for (i=0; i<nroots; i++) {
386
fprintf(efile, "%8.6lf ", evals[i]+offset);
388
fprintf(efile, "\n");
392
}} // namespace psi::detci