4
** \brief Utility functions for importing/exporting sets of Slater determinants
8
** Edward Valeev, June 2002
14
#include <libpsio/psio.h>
15
#include <libciomr/libciomr.h>
16
#include "slaterdset.h"
20
#define PSIO_INIT if (!psio_state()) { \
21
psio_init(); psio_ipv1_config(); \
22
need_to_init_psio = 1; \
25
#define PSIO_OPEN(u,n) if (!psio_open_check(u)) { \
30
#define PSIO_CLOSE(u) if (!unit_opened) \
33
#define PSIO_DONE if (need_to_init_psio) \
38
** stringset_init(): Initialize a set of alpha/beta strings
40
** \param sset = pointer to StringSet (contains occs in Pitzer order)
41
** \param size = number of strings
42
** \param nelec = number of electrons
43
** \param nfzc = number of frozen core orbitals
44
** \param frozen_occ = array of frozen occupied orbitals (Pitzer numbering!)
49
void stringset_init(StringSet *sset, int size, int nelec, int nfzc,
50
short int *frozen_occ)
57
sset->strings = (String *) malloc(size*sizeof(String));
58
memset(sset->strings,0,size*sizeof(String));
60
sset->fzc_occ = (short int *) malloc(nfzc * sizeof(short int));
61
for (i=0; i<nfzc; i++) {
62
sset->fzc_occ[i] = frozen_occ[i];
69
** stringset_delete(): Delete a StringSet
71
** \param sset = pointer to StringSet to delete
77
void stringset_delete(StringSet *sset)
79
if (sset->nfzc > 0) free(sset->fzc_occ);
83
if (sset->strings) free(sset->strings);
88
** stringset_add(): Add a string (in Pitzer order, given by Occ) to
89
** the StringSet, writing to position index.
91
** \param sset = StringSet to add to
92
** \param index = location in StringSet to add to
93
** \param Occ = orbital occupations (Pitzer order) of the string to add
98
void stringset_add(StringSet *sset, int index, unsigned char *Occ)
101
int nact = sset->nelec - sset->nfzc;
104
if (index < sset->size && index >= 0) {
105
s = sset->strings + index;
108
s->occ = (short int*) malloc(nact*sizeof(short int));
114
** stringset_reindex(): Remap orbital occupations from one ordering to
117
** \param sset = pointer to StringSet
118
** \param mo_map = mapping array from original orbital order to new order
123
void stringset_reindex(StringSet* sset, short int* mo_map)
127
int nstrings = sset->size;
128
int nact = sset->nelec - sset->nfzc;
130
for (core=0; core<sset->nfzc; core++) {
131
sset->fzc_occ[core] = mo_map[sset->fzc_occ[core]];
134
for(s=0; s<nstrings; s++) {
135
occ = (sset->strings + s)->occ;
136
for(mo=0; mo<nact; mo++)
137
occ[mo] = mo_map[occ[mo]];
142
** stringset_write(): Write a stringset to a PSI file
144
** \param unit = file number to write to
145
** \param prefix = prefix string to come before libpsio entry keys
146
** \param sset = pointer to StringSet to write
151
void stringset_write(ULI unit, const char *prefix, StringSet *sset)
154
int need_to_init_psio = 0;
156
char *size_key, *nelec_key, *nfzc_key, *strings_key, *fzc_occ_key;
160
PSIO_OPEN(unit,PSIO_OPEN_OLD)
162
size_key = (char *) malloc(strlen(prefix) + strlen(STRINGSET_KEY_SIZE) + 3);
163
sprintf(size_key,":%s:%s",prefix,STRINGSET_KEY_SIZE);
164
nelec_key = (char *) malloc(strlen(prefix) + strlen(STRINGSET_KEY_NELEC) + 3);
165
sprintf(nelec_key,":%s:%s",prefix,STRINGSET_KEY_NELEC);
166
nfzc_key = (char *) malloc(strlen(prefix) + strlen(STRINGSET_KEY_NFZC) + 3);
167
sprintf(nfzc_key,":%s:%s",prefix,STRINGSET_KEY_NFZC);
168
fzc_occ_key = (char *) malloc(strlen(prefix) +
169
strlen(STRINGSET_KEY_FZC_OCC) + 3);
170
sprintf(fzc_occ_key,":%s:%s",prefix,STRINGSET_KEY_FZC_OCC);
171
strings_key = (char *) malloc(strlen(prefix) + strlen(STRINGSET_KEY_STRINGS) + 3);
172
sprintf(strings_key,":%s:%s",prefix,STRINGSET_KEY_STRINGS);
174
psio_write_entry( unit, size_key, (char *)&sset->size, sizeof(int));
175
psio_write_entry( unit, nelec_key, (char *)&sset->nelec, sizeof(int));
176
psio_write_entry( unit, nfzc_key, (char *)&sset->nfzc, sizeof(int));
178
psio_write_entry( unit, fzc_occ_key, (char *)sset->fzc_occ,
179
sset->nfzc*sizeof(short int));
184
nact = sset->nelec - sset->nfzc;
185
for(i=0; i<size; i++) {
186
psio_write( unit, strings_key, (char *) &(sset->strings[i].index),
187
sizeof(int), ptr, &ptr);
188
psio_write( unit, strings_key, (char *) sset->strings[i].occ,
189
nact*sizeof(short int), ptr, &ptr);
204
** stringset_read(): Read a StringSet from disk
206
** \param unit = file number to read from
207
** \param prefix = prefix string to come before libpsio entry keys
208
** \param stringset = double pointer to StringSet allocated by this function
213
void stringset_read(ULI unit, const char *prefix, StringSet **stringset)
215
int i, size, nelec, nfzc, nact;
216
int need_to_init_psio = 0;
218
char *size_key, *nelec_key, *nfzc_key, *fzc_occ_key, *strings_key;
221
StringSet *sset = (StringSet *) malloc(sizeof(StringSet));
224
PSIO_OPEN(unit,PSIO_OPEN_OLD)
226
size_key = (char *) malloc( strlen(prefix) + strlen(STRINGSET_KEY_SIZE) + 3);
227
sprintf(size_key,":%s:%s",prefix,STRINGSET_KEY_SIZE);
228
nelec_key = (char *) malloc( strlen(prefix) + strlen(STRINGSET_KEY_NELEC)+ 3);
229
sprintf(nelec_key,":%s:%s",prefix,STRINGSET_KEY_NELEC);
230
nfzc_key = (char *) malloc( strlen(prefix) + strlen(STRINGSET_KEY_NFZC) + 3);
231
sprintf(nfzc_key,":%s:%s",prefix,STRINGSET_KEY_NFZC);
232
fzc_occ_key = (char *) malloc(strlen(prefix) +
233
strlen(STRINGSET_KEY_FZC_OCC) + 3);
234
sprintf(fzc_occ_key,":%s:%s",prefix,STRINGSET_KEY_FZC_OCC);
235
strings_key = (char *) malloc( strlen(prefix) + strlen(STRINGSET_KEY_STRINGS)
237
sprintf(strings_key,":%s:%s",prefix,STRINGSET_KEY_STRINGS);
239
psio_read_entry( unit, size_key, (char *)&size, sizeof(int));
240
psio_read_entry( unit, nelec_key, (char *)&nelec, sizeof(int));
241
psio_read_entry( unit, nfzc_key, (char *)&nfzc, sizeof(int));
243
fzc_occ = (short int *) malloc(nfzc*sizeof(short int));
244
psio_read_entry( unit, fzc_occ_key, (char *)fzc_occ,
245
nfzc*sizeof(short int));
249
stringset_init(sset, size, nelec, nfzc, fzc_occ);
253
for(i=0; i<size; i++) {
254
psio_read( unit, strings_key, (char *) &(sset->strings[i].index),
255
sizeof(int), ptr, &ptr);
256
sset->strings[i].occ = (short int*) malloc(nact*sizeof(short int));
257
psio_read( unit, strings_key, (char *) sset->strings[i].occ,
258
nact*sizeof(short int), ptr, &ptr);
269
if (nfzc > 0) free(fzc_occ);
275
** slaterdetset_init(): Initialize a Slater Determinant Set
277
** \param sdset = pointer to SlaterDetSet being initialized
278
** \param size = number of SlaterDets to be held
279
** \param alphastrings = pointer to StringSet of alpha strings
280
** \param betastrings = pointer to StringSet of beta strings
285
void slaterdetset_init(SlaterDetSet *sdset, int size, StringSet *alphastrings,
286
StringSet *betastrings)
289
sdset->dets = (SlaterDet *) malloc(size*sizeof(SlaterDet));
290
memset(sdset->dets,0,size*sizeof(SlaterDet));
291
sdset->alphastrings = alphastrings;
292
sdset->betastrings = betastrings;
296
** slaterdetset_delete(): Delete a Slater Determinant Set.
298
** Does not free the members alphastrings and betastrings. See also:
299
** slaterdetset_delete_full() which does this.
301
** \param sdset = pointer to SlaterDetSet to be de-allocated
306
void slaterdetset_delete(SlaterDetSet *sdset)
313
sdset->alphastrings = NULL;
314
sdset->betastrings = NULL;
318
** slaterdetset_delete_full(): De-allocate a Slater Determinant Set.
320
** Frees memory including alpha and beta strings. See
321
** slaterdetset_delete() for a similar version which does not free the
322
** alpha and beta strings.
324
** \param sdset = pointer to SlaterDetSet to be de-allocated
329
void slaterdetset_delete_full(SlaterDetSet *sdset)
336
if (sdset->alphastrings) {
337
stringset_delete(sdset->alphastrings);
338
sdset->alphastrings = NULL;
340
if (sdset->betastrings) {
341
stringset_delete(sdset->betastrings);
342
sdset->betastrings = NULL;
347
** slaterdetset_add(): Add info for a particular Slater determinant to
350
** \param sdset = pointer to SlaterDetSet to add to
351
** \param index = location in the set to add to
352
** \param alphastring = alpha string ID for the new determinant
353
** \param betastring = beta string ID for the new determinant
358
void slaterdetset_add(SlaterDetSet *sdset, int index, int alphastring,
362
StringSet *alphaset = sdset->alphastrings;
363
StringSet *betaset = sdset->betastrings;
365
if (index < sdset->size && index >= 0) {
366
det = sdset->dets + index;
369
if (alphastring < alphaset->size && alphastring >= 0)
370
det->alphastring = alphastring;
371
if (betastring < betaset->size && betastring >= 0)
372
det->betastring = betastring;
376
** slaterdetset_write(): Write a Slater Determinant Set to disk.
378
** \param unit = file number to write to
379
** \param prefix = prefix string to come before libpsio entry keys
380
** \param sdset = pointer to SlaterDetSet to write
385
void slaterdetset_write(ULI unit, const char *prefix, SlaterDetSet *sdset)
388
int need_to_init_psio = 0;
390
char *size_key, *set_key;
391
char *alphaprefix, *betaprefix;
395
PSIO_OPEN(unit,PSIO_OPEN_OLD)
397
alphaprefix = (char *) malloc( strlen(prefix) +
398
strlen(SDSET_KEY_ALPHASTRINGS) + 2);
399
sprintf(alphaprefix,"%s:%s",prefix,SDSET_KEY_ALPHASTRINGS);
400
betaprefix = (char *) malloc( strlen(prefix) +
401
strlen(SDSET_KEY_BETASTRINGS) + 2);
402
sprintf(betaprefix,"%s:%s",prefix,SDSET_KEY_BETASTRINGS);
404
stringset_write( unit, alphaprefix, sdset->alphastrings);
405
stringset_write( unit, betaprefix, sdset->betastrings);
410
size_key = (char *) malloc( strlen(prefix) + strlen(SDSET_KEY_SIZE) + 3);
411
sprintf(size_key,":%s:%s",prefix,SDSET_KEY_SIZE);
412
set_key = (char *) malloc( strlen(prefix) + strlen(SDSET_KEY_DETERMINANTS)
414
sprintf(set_key,":%s:%s",prefix,SDSET_KEY_DETERMINANTS);
416
psio_write_entry( unit, size_key, (char *)&sdset->size, sizeof(int));
417
psio_write_entry( unit, set_key, (char *)sdset->dets,
418
sdset->size*sizeof(SlaterDet));
428
** slaterdetset_read(): Read a Slater Determinant Set
430
** \param unit = file number of the PSIO file
431
** \param prefix = prefix string to come before libpsio entry keys
432
** \param sdset = pointer to SlaterDetSet to read into
437
void slaterdetset_read(ULI unit, const char *prefix, SlaterDetSet **slaterdetset)
440
int need_to_init_psio = 0;
442
char *size_key, *set_key;
443
char *alphaprefix, *betaprefix;
445
StringSet *alphastrings, *betastrings;
446
SlaterDetSet *sdset = (SlaterDetSet *) malloc(sizeof(SlaterDetSet));
449
PSIO_OPEN(unit,PSIO_OPEN_OLD)
451
alphaprefix = (char *) malloc( strlen(prefix) +
452
strlen(SDSET_KEY_ALPHASTRINGS) + 2);
453
sprintf(alphaprefix,"%s:%s",prefix,SDSET_KEY_ALPHASTRINGS);
454
betaprefix = (char *) malloc( strlen(prefix) +
455
strlen(SDSET_KEY_BETASTRINGS) + 2);
456
sprintf(betaprefix,"%s:%s",prefix,SDSET_KEY_BETASTRINGS);
458
stringset_read( unit, alphaprefix, &alphastrings);
459
stringset_read( unit, betaprefix, &betastrings);
464
size_key = (char *) malloc( strlen(prefix) + strlen(SDSET_KEY_SIZE) + 3);
465
sprintf(size_key,":%s:%s",prefix,SDSET_KEY_SIZE);
466
set_key = (char *) malloc( strlen(prefix) + strlen(SDSET_KEY_DETERMINANTS)
468
sprintf(set_key,":%s:%s",prefix,SDSET_KEY_DETERMINANTS);
470
psio_read_entry( unit, size_key, (char *)&size, sizeof(int));
471
slaterdetset_init(sdset,size,alphastrings,betastrings);
472
psio_read_entry( unit, set_key, (char *)sdset->dets,
473
sdset->size*sizeof(SlaterDet));
481
*slaterdetset = sdset;
486
** slaterdetvector_init(): Initialize a vector of coefficients
487
** corresponding to a Slater Determinant set
489
** \param sdvector = pointer to SlaterDetVector to initialize (coeffs
490
** member will be allocated)
491
** \param sdset = pointer to SlaterDetSet the vector is associated with
496
void slaterdetvector_init(SlaterDetVector *sdvector, SlaterDetSet *sdset)
498
sdvector->size = sdset->size;
499
sdvector->sdset = sdset;
500
sdvector->coeffs = init_array(sdvector->size);
504
** slaterdetvector_delete(): De-allocate a SlaterDetVector
506
** \param sdvector = pointer to SlaterDetVector to de-allocate
508
** Note: does NOT fully free the associated SlaterDetSet. For that, see
509
** function slaterdetvector_delete_full()
514
void slaterdetvector_delete(SlaterDetVector *sdvector)
517
sdvector->sdset = NULL;
518
if (sdvector->coeffs) {
519
free(sdvector->coeffs);
520
sdvector->coeffs = NULL;
526
** slaterdetvector_delete_full(): De-allocate a SlaterDetVector and its
527
** associated SlaterDetSet.
529
** To keep the SlaterDetSet itself, use similar function
530
** slaterdetvector_delete().
532
** \param sdvector = pointer to SlaterDetVector to delete
537
void slaterdetvector_delete_full(SlaterDetVector *sdvector)
540
if (sdvector->sdset) {
541
slaterdetset_delete_full(sdvector->sdset);
542
sdvector->sdset = NULL;
544
if (sdvector->coeffs) {
545
free(sdvector->coeffs);
546
sdvector->coeffs = NULL;
552
** slaterdetvector_add(): Add a coefficient to a SlaterDetVector
554
** \param sdvector = Pointer to SlaterDetVector to add to
555
** \param index = location in vector for writing the coefficient
556
** \param coeff = the coefficient to write to location index
561
void slaterdetvector_add(SlaterDetVector *sdvector, int index, double coeff)
563
if (index < sdvector->size && index >= 0) {
564
sdvector->coeffs[index] = coeff;
570
** slaterdetvector_set(): Set a SlaterDetVector's vector to a set of
571
** coefficients supplied by array coeffs
573
** \param sdvector = pointer to SlaterDetVector for writing coefficients
574
** \param coeffs = array of coefficients to write to sdvector
578
void slaterdetvector_set(SlaterDetVector *sdvector, double *coeffs)
581
const int size = sdvector->size;
582
double *v = sdvector->coeffs;
584
for(i=0; i<size; i++)
591
** slaterdetvector_write(): Write a SlaterDetVector to disk.
593
** This writes a vector in the space of Slater determinants, along with
594
** the set of determinants itself, to a PSIO file.
596
** Use this if we only need to write a single vector. Otherwise, call
597
** slaterdetset_write(); slaterdetset_write_vect();
598
** to allow for multiple vectors per slaterdetset to be written to disk.
600
** \param unit = file number of the UNINITIALIZED PSIO file
601
** \param prefix = prefix string to come before libpsio entry keys
602
** \param vector = SlaterDetVector to write to disk
607
void slaterdetvector_write(ULI unit, const char *prefix, SlaterDetVector *vector)
609
int need_to_init_psio = 0;
613
PSIO_OPEN(unit,PSIO_OPEN_OLD)
615
slaterdetset_write(unit, prefix, vector->sdset);
616
slaterdetset_write_vect(unit, prefix, vector->coeffs, vector->size, 0);
625
** slaterdetset_write_vect(): Write to disk the coefficients for a single
626
** vector associated with a set of Slater determinants.
628
** This function already assumes we've already called slaterdetset_write()
629
** to write out the string and determinant information. This is only
630
** going to write out the coefficients. This has been split out because
631
** we might want to write several roots for a given determinant setup.
632
** This does not actually dpend on the presence of a SlaterDetVector object
633
** so it is called a SlaterDetSet function.
635
** \param unit = file number of the UNINITIALIZED PSIO file
636
** \param prefix = prefix string to come before libpsio entry keys
637
** \param coeffs = array of coefficients to write
638
** \param size = number of elements in coeffs array
639
** \param vectnum = the vector number (to make a PSIO key). Start
640
** numbering from zero.
647
void slaterdetset_write_vect(ULI unit, const char *prefix,
648
double *coeffs, int size, int vectnum)
650
int need_to_init_psio = 0;
655
PSIO_OPEN(unit,PSIO_OPEN_OLD)
657
if (vectnum < 0 || vectnum > 99) {
658
fprintf(stderr, "(slaterdetset_write_vect): vectnum out of bounds\n");
662
vector_key = (char *) malloc(strlen(prefix)+strlen(SDVECTOR_KEY_VECTOR)+5);
663
sprintf(vector_key,":%s:%s%2d",prefix,SDVECTOR_KEY_VECTOR,vectnum);
665
psio_write_entry(unit, vector_key, (char *)coeffs, size*sizeof(double));
676
** slaterdetvector_read(): Read a SlaterDetVector from disk
678
** Use this if we only need to read a single vector. Otherwise, call
679
** slaterdetset_read(); slaterdetset_read_vect();
680
** to allow for multiple vectors per slaterdetset to be read from disk.
682
** \param unit = file number to read from
683
** \param prefix = prefix string to come before libpsio entry keys
684
** \param sdvector = pointer to hold pointer to SlaterDetVector allocated
690
void slaterdetvector_read(ULI unit, const char *prefix, SlaterDetVector **sdvector)
692
int need_to_init_psio = 0;
695
SlaterDetVector *vector = (SlaterDetVector *) malloc(sizeof(SlaterDetVector));
698
PSIO_OPEN(unit,PSIO_OPEN_OLD)
700
slaterdetset_read(unit, prefix, &sdset);
701
slaterdetvector_init(vector,sdset);
702
slaterdetset_read_vect(unit, prefix, vector->coeffs, vector->size, 0);
712
** slaterdetset_read_vect(): Read in the coefficients for a single vector
713
** associated with a SlaterDetSet.
715
** This function already assumes we've already called slaterdetset_read()
716
** to read in the string and determinant information. This is only
717
** going to read in the coefficients. This has been split out because
718
** we might want to read several roots for a given determinant setup.
719
** This does not actually depend on the presence of a SlaterDetVector
720
** object and is called a SlaterDetSet function.
722
** \param unit = file number of the UNINITIALIZED PSIO file
723
** \param prefix = prefix string to come before libpsio entry keys
724
** \param coeffs = array to hold coefficients read
725
** \param size = number of elements in coeffs array
726
** \param vectnum = the vector number (for the PSIO key). Start from 0.
733
void slaterdetset_read_vect(ULI unit, const char *prefix, double *coeffs,
734
int size, int vectnum)
736
int need_to_init_psio = 0;
741
PSIO_OPEN(unit,PSIO_OPEN_OLD)
743
vector_key = (char *) malloc(strlen(prefix)+strlen(SDVECTOR_KEY_VECTOR)+5);
744
sprintf(vector_key,":%s:%s%2d",prefix,SDVECTOR_KEY_VECTOR,vectnum);
746
psio_read_entry(unit, vector_key, (char *)coeffs, size*sizeof(double));