~ubuntu-branches/ubuntu/karmic/psicode/karmic

« back to all changes in this revision

Viewing changes to src/lib/libqt/slaterdset.cc

  • Committer: Bazaar Package Importer
  • Author(s): Michael Banck, Michael Banck, Daniel Leidert
  • Date: 2009-02-23 00:12:02 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20090223001202-rutldoy3dimfpesc
Tags: 3.4.0-1
* New upstream release.

[ Michael Banck ]
* debian/patches/01_DESTDIR.dpatch: Refreshed.
* debian/patches/02_FHS.dpatch: Removed, applied upstream.
* debian/patches/03_debian_docdir: Likewise.
* debian/patches/04_man.dpatch: Likewise.
* debian/patches/06_466828_fix_gcc_43_ftbfs.dpatch: Likewise.
* debian/patches/07_464867_move_executables: Fixed and refreshed.
* debian/patches/00list: Adjusted.
* debian/control: Improved description.
* debian/patches-held: Removed.
* debian/rules (install/psi3): Do not ship the ruby bindings for now.

[ Daniel Leidert ]
* debian/rules: Fix txtdir via DEB_MAKE_INSTALL_TARGET.
* debian/patches/01_DESTDIR.dpatch: Refreshed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 
 
2
/*!
 
3
** \file
 
4
** \brief Utility functions for importing/exporting sets of Slater determinants
 
5
**   from the CI codes
 
6
** \ingroup QT
 
7
**
 
8
** Edward Valeev, June 2002
 
9
*/
 
10
 
 
11
#include <cstdio>
 
12
#include <cstdlib>
 
13
#include <cstring>
 
14
#include <libpsio/psio.h>
 
15
#include <libciomr/libciomr.h>
 
16
#include "slaterdset.h"
 
17
 
 
18
extern "C" {
 
19
        
 
20
#define PSIO_INIT if (!psio_state()) { \
 
21
    psio_init(); psio_ipv1_config(); \
 
22
    need_to_init_psio = 1; \
 
23
  }
 
24
 
 
25
#define PSIO_OPEN(u,n) if (!psio_open_check(u)) { \
 
26
    psio_open((u),n); \
 
27
    unit_opened = 0; \
 
28
  }
 
29
 
 
30
#define PSIO_CLOSE(u) if (!unit_opened) \
 
31
    psio_close((u),1);
 
32
 
 
33
#define PSIO_DONE if (need_to_init_psio) \
 
34
    psio_done();
 
35
 
 
36
 
 
37
/*! 
 
38
** stringset_init(): Initialize a set of alpha/beta strings
 
39
**
 
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!)
 
45
**
 
46
** Returns: none
 
47
** \ingroup QT
 
48
*/
 
49
void stringset_init(StringSet *sset, int size, int nelec, int nfzc,
 
50
  short int *frozen_occ)
 
51
{
 
52
  int i;
 
53
 
 
54
  sset->size = size;
 
55
  sset->nelec = nelec;
 
56
  sset->nfzc = nfzc;
 
57
  sset->strings = (String *) malloc(size*sizeof(String));
 
58
  memset(sset->strings,0,size*sizeof(String));
 
59
  if (nfzc > 0) {
 
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];  
 
63
    }
 
64
  }
 
65
}
 
66
 
 
67
 
 
68
/*! 
 
69
** stringset_delete(): Delete a StringSet
 
70
** 
 
71
** \param sset = pointer to StringSet to delete
 
72
** 
 
73
** Returns: none
 
74
**
 
75
** \ingroup QT
 
76
*/
 
77
void stringset_delete(StringSet *sset)
 
78
{
 
79
  if (sset->nfzc > 0) free(sset->fzc_occ);
 
80
  sset->size = 0;
 
81
  sset->nelec = 0;
 
82
  sset->nfzc = 0;
 
83
  if (sset->strings) free(sset->strings);
 
84
  sset->strings = NULL;
 
85
}
 
86
 
 
87
/*! 
 
88
** stringset_add(): Add a string (in Pitzer order, given by Occ) to 
 
89
** the StringSet, writing to position index.
 
90
**
 
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
 
94
**
 
95
** Returns: none
 
96
** \ingroup QT
 
97
*/
 
98
void stringset_add(StringSet *sset, int index, unsigned char *Occ)
 
99
{
 
100
  int i;
 
101
  int nact = sset->nelec - sset->nfzc;
 
102
  String *s;
 
103
 
 
104
  if (index < sset->size && index >= 0) {
 
105
    s = sset->strings + index;
 
106
  }
 
107
  s->index = index;
 
108
  s->occ = (short int*) malloc(nact*sizeof(short int));
 
109
  for(i=0;i<nact;i++)
 
110
    s->occ[i] = Occ[i];
 
111
}
 
112
 
 
113
/*! 
 
114
** stringset_reindex(): Remap orbital occupations from one ordering to
 
115
** another.
 
116
**
 
117
** \param sset   = pointer to StringSet
 
118
** \param mo_map = mapping array from original orbital order to new order
 
119
**
 
120
** Returns: none
 
121
** \ingroup QT
 
122
*/
 
123
void stringset_reindex(StringSet* sset, short int* mo_map)
 
124
{
 
125
  int s, mo, core;
 
126
  short int* occ;
 
127
  int nstrings = sset->size;
 
128
  int nact = sset->nelec - sset->nfzc;
 
129
 
 
130
  for (core=0; core<sset->nfzc; core++) {
 
131
    sset->fzc_occ[core] = mo_map[sset->fzc_occ[core]];
 
132
  }
 
133
 
 
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]];
 
138
  }
 
139
}
 
140
 
 
141
/*!
 
142
** stringset_write(): Write a stringset to a PSI file
 
143
**
 
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
 
147
**
 
148
** Returns: none
 
149
** \ingroup QT
 
150
*/
 
151
void stringset_write(ULI unit, const char *prefix, StringSet *sset)
 
152
{
 
153
  int i, size, nact;
 
154
  int need_to_init_psio = 0;
 
155
  int unit_opened = 1;
 
156
  char *size_key, *nelec_key, *nfzc_key, *strings_key, *fzc_occ_key;
 
157
  psio_address ptr;
 
158
 
 
159
PSIO_INIT
 
160
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
161
 
 
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);
 
173
 
 
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));
 
177
  if (sset->nfzc) {
 
178
    psio_write_entry( unit, fzc_occ_key, (char *)sset->fzc_occ, 
 
179
      sset->nfzc*sizeof(short int));
 
180
  }
 
181
 
 
182
  ptr = PSIO_ZERO;
 
183
  size = sset->size;
 
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);
 
190
  }
 
191
 
 
192
PSIO_CLOSE(unit)
 
193
PSIO_DONE
 
194
 
 
195
  free(size_key);
 
196
  free(nelec_key);
 
197
  free(nfzc_key);
 
198
  free(strings_key);
 
199
  free(fzc_occ_key);
 
200
}
 
201
 
 
202
 
 
203
/*!
 
204
** stringset_read(): Read a StringSet from disk
 
205
**
 
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
 
209
**
 
210
** Returns: none
 
211
** \ingroup QT
 
212
*/
 
213
void stringset_read(ULI unit, const char *prefix, StringSet **stringset)
 
214
{
 
215
  int i, size, nelec, nfzc, nact;
 
216
  int need_to_init_psio = 0;
 
217
  int unit_opened = 1;
 
218
  char *size_key, *nelec_key, *nfzc_key, *fzc_occ_key, *strings_key;
 
219
  short int *fzc_occ;
 
220
  psio_address ptr;
 
221
  StringSet *sset = (StringSet *) malloc(sizeof(StringSet));
 
222
 
 
223
PSIO_INIT
 
224
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
225
 
 
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)
 
236
    + 3);
 
237
  sprintf(strings_key,":%s:%s",prefix,STRINGSET_KEY_STRINGS);
 
238
 
 
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));
 
242
  if (nfzc > 0) {
 
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));
 
246
  }
 
247
  else fzc_occ = NULL;
 
248
 
 
249
  stringset_init(sset, size, nelec, nfzc, fzc_occ);
 
250
 
 
251
  nact = nelec - nfzc;
 
252
  ptr = PSIO_ZERO;
 
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);
 
259
  }
 
260
 
 
261
PSIO_CLOSE(unit)
 
262
PSIO_DONE
 
263
 
 
264
  free(size_key);
 
265
  free(nelec_key);
 
266
  free(nfzc_key);
 
267
  free(fzc_occ_key);
 
268
  free(strings_key);
 
269
  if (nfzc > 0) free(fzc_occ);
 
270
  *stringset = sset;
 
271
}
 
272
 
 
273
 
 
274
/*! 
 
275
** slaterdetset_init(): Initialize a Slater Determinant Set
 
276
**
 
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
 
281
** 
 
282
** Returns: none
 
283
** \ingroup QT
 
284
*/
 
285
void slaterdetset_init(SlaterDetSet *sdset, int size, StringSet *alphastrings, 
 
286
  StringSet *betastrings)
 
287
{
 
288
  sdset->size = size;
 
289
  sdset->dets = (SlaterDet *) malloc(size*sizeof(SlaterDet));
 
290
  memset(sdset->dets,0,size*sizeof(SlaterDet));
 
291
  sdset->alphastrings = alphastrings;
 
292
  sdset->betastrings = betastrings;
 
293
}
 
294
 
 
295
/*! 
 
296
** slaterdetset_delete(): Delete a Slater Determinant Set.
 
297
**
 
298
** Does not free the members alphastrings and betastrings.  See also:
 
299
**  slaterdetset_delete_full() which does this.
 
300
**
 
301
** \param sdset = pointer to SlaterDetSet to be de-allocated
 
302
**
 
303
** Returns: none
 
304
** \ingroup QT
 
305
*/
 
306
void slaterdetset_delete(SlaterDetSet *sdset)
 
307
{
 
308
  sdset->size = 0;
 
309
  if (sdset->dets) {
 
310
    free(sdset->dets);
 
311
    sdset->dets = NULL;
 
312
  }
 
313
  sdset->alphastrings = NULL;
 
314
  sdset->betastrings = NULL;
 
315
}
 
316
 
 
317
/*! 
 
318
** slaterdetset_delete_full(): De-allocate a Slater Determinant Set.
 
319
**
 
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.
 
323
**
 
324
** \param sdset = pointer to SlaterDetSet to be de-allocated
 
325
**
 
326
** Returns: none
 
327
** \ingroup QT
 
328
*/
 
329
void slaterdetset_delete_full(SlaterDetSet *sdset)
 
330
{
 
331
  sdset->size = 0;
 
332
  if (sdset->dets) {
 
333
    free(sdset->dets);
 
334
    sdset->dets = NULL;
 
335
  }
 
336
  if (sdset->alphastrings) {
 
337
    stringset_delete(sdset->alphastrings);
 
338
    sdset->alphastrings = NULL;
 
339
  }
 
340
  if (sdset->betastrings) {
 
341
    stringset_delete(sdset->betastrings);
 
342
    sdset->betastrings = NULL;
 
343
  }
 
344
}
 
345
 
 
346
/*! 
 
347
** slaterdetset_add(): Add info for a particular Slater determinant to
 
348
** a SlaterDetSet.
 
349
**
 
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
 
354
**
 
355
** Returns: none
 
356
** \ingroup QT
 
357
*/
 
358
void slaterdetset_add(SlaterDetSet *sdset, int index, int alphastring, 
 
359
  int betastring)
 
360
{
 
361
  SlaterDet *det;
 
362
  StringSet *alphaset = sdset->alphastrings;
 
363
  StringSet *betaset = sdset->betastrings;
 
364
 
 
365
  if (index < sdset->size && index >= 0) {
 
366
    det = sdset->dets + index;
 
367
  }
 
368
  det->index = index;
 
369
  if (alphastring < alphaset->size && alphastring >= 0)
 
370
    det->alphastring = alphastring;
 
371
  if (betastring < betaset->size && betastring >= 0)
 
372
    det->betastring = betastring;
 
373
}
 
374
 
 
375
/*!
 
376
** slaterdetset_write(): Write a Slater Determinant Set to disk.
 
377
**
 
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  
 
381
**
 
382
** Returns: none
 
383
** \ingroup QT
 
384
*/
 
385
void slaterdetset_write(ULI unit, const char *prefix, SlaterDetSet *sdset)
 
386
{
 
387
  int i;
 
388
  int need_to_init_psio = 0;
 
389
  int unit_opened = 1;
 
390
  char *size_key, *set_key;
 
391
  char *alphaprefix, *betaprefix;
 
392
  psio_address ptr;
 
393
 
 
394
PSIO_INIT
 
395
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
396
 
 
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);
 
403
 
 
404
  stringset_write( unit, alphaprefix, sdset->alphastrings);
 
405
  stringset_write( unit, betaprefix, sdset->betastrings);
 
406
  
 
407
  free(alphaprefix);
 
408
  free(betaprefix);
 
409
 
 
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) 
 
413
    + 3);
 
414
  sprintf(set_key,":%s:%s",prefix,SDSET_KEY_DETERMINANTS);
 
415
 
 
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));
 
419
 
 
420
PSIO_CLOSE(unit)
 
421
PSIO_DONE
 
422
 
 
423
  free(size_key);
 
424
  free(set_key);
 
425
}
 
426
 
 
427
/*!
 
428
** slaterdetset_read(): Read a Slater Determinant Set
 
429
**
 
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
 
433
**
 
434
** Returns: none
 
435
** \ingroup QT
 
436
*/
 
437
void slaterdetset_read(ULI unit, const char *prefix, SlaterDetSet **slaterdetset)
 
438
{
 
439
  int i, size;
 
440
  int need_to_init_psio = 0;
 
441
  int unit_opened = 1;
 
442
  char *size_key, *set_key;
 
443
  char *alphaprefix, *betaprefix;
 
444
  psio_address ptr;
 
445
  StringSet *alphastrings, *betastrings;
 
446
  SlaterDetSet *sdset = (SlaterDetSet *) malloc(sizeof(SlaterDetSet));
 
447
 
 
448
PSIO_INIT
 
449
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
450
 
 
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);
 
457
 
 
458
  stringset_read( unit, alphaprefix, &alphastrings);
 
459
  stringset_read( unit, betaprefix, &betastrings);
 
460
  
 
461
  free(alphaprefix);
 
462
  free(betaprefix);
 
463
 
 
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) 
 
467
    + 3);
 
468
  sprintf(set_key,":%s:%s",prefix,SDSET_KEY_DETERMINANTS);
 
469
 
 
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));
 
474
 
 
475
PSIO_CLOSE(unit)
 
476
PSIO_DONE
 
477
 
 
478
  free(size_key);
 
479
  free(set_key);
 
480
 
 
481
  *slaterdetset = sdset;
 
482
}
 
483
 
 
484
 
 
485
/*! 
 
486
** slaterdetvector_init(): Initialize a vector of coefficients
 
487
**   corresponding to a Slater Determinant set 
 
488
** 
 
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
 
492
**
 
493
** Returns: none
 
494
** \ingroup QT
 
495
*/
 
496
void slaterdetvector_init(SlaterDetVector *sdvector, SlaterDetSet *sdset)
 
497
{
 
498
  sdvector->size = sdset->size;
 
499
  sdvector->sdset = sdset;
 
500
  sdvector->coeffs = init_array(sdvector->size);
 
501
}
 
502
 
 
503
/*! 
 
504
** slaterdetvector_delete(): De-allocate a SlaterDetVector
 
505
**
 
506
** \param sdvector = pointer to SlaterDetVector to de-allocate
 
507
**
 
508
** Note: does NOT fully free the associated SlaterDetSet.  For that, see
 
509
** function slaterdetvector_delete_full()
 
510
**
 
511
** Returns: none
 
512
** \ingroup QT
 
513
*/
 
514
void slaterdetvector_delete(SlaterDetVector *sdvector)
 
515
{
 
516
  sdvector->size = 0;
 
517
  sdvector->sdset = NULL;
 
518
  if (sdvector->coeffs) {
 
519
    free(sdvector->coeffs);
 
520
    sdvector->coeffs = NULL;
 
521
  }
 
522
}
 
523
 
 
524
 
 
525
/*! 
 
526
** slaterdetvector_delete_full(): De-allocate a SlaterDetVector and its
 
527
**   associated SlaterDetSet.  
 
528
**
 
529
** To keep the SlaterDetSet itself, use similar function 
 
530
** slaterdetvector_delete().
 
531
**
 
532
** \param sdvector = pointer to SlaterDetVector to delete
 
533
**
 
534
** Returns: none
 
535
** \ingroup QT
 
536
*/
 
537
void slaterdetvector_delete_full(SlaterDetVector *sdvector)
 
538
{
 
539
  sdvector->size = 0;
 
540
  if (sdvector->sdset) {
 
541
    slaterdetset_delete_full(sdvector->sdset);
 
542
    sdvector->sdset = NULL;
 
543
  }
 
544
  if (sdvector->coeffs) {
 
545
    free(sdvector->coeffs);
 
546
    sdvector->coeffs = NULL;
 
547
  }
 
548
}
 
549
 
 
550
 
 
551
/*! 
 
552
** slaterdetvector_add(): Add a coefficient to a SlaterDetVector
 
553
**
 
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 
 
557
** 
 
558
** Returns: none
 
559
** \ingroup QT
 
560
*/
 
561
void slaterdetvector_add(SlaterDetVector *sdvector, int index, double coeff)
 
562
{
 
563
  if (index < sdvector->size && index >= 0) {
 
564
    sdvector->coeffs[index] = coeff;
 
565
  }
 
566
}
 
567
 
 
568
 
 
569
/*! 
 
570
** slaterdetvector_set(): Set a SlaterDetVector's vector to a set of
 
571
**   coefficients supplied by array coeffs
 
572
**
 
573
** \param sdvector = pointer to SlaterDetVector for writing coefficients
 
574
** \param coeffs   = array of coefficients to write to sdvector
 
575
**
 
576
** \ingroup QT
 
577
*/
 
578
void slaterdetvector_set(SlaterDetVector *sdvector, double *coeffs)
 
579
{
 
580
  int i;
 
581
  const int size = sdvector->size;
 
582
  double *v = sdvector->coeffs;
 
583
  if (v) {
 
584
    for(i=0; i<size; i++)
 
585
      v[i] = coeffs[i];
 
586
  }
 
587
}
 
588
 
 
589
 
 
590
/*!
 
591
** slaterdetvector_write(): Write a SlaterDetVector to disk.
 
592
**
 
593
** This writes a vector in the space of Slater determinants, along with
 
594
** the set of determinants itself, to a PSIO file.
 
595
**
 
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.
 
599
**
 
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
 
603
** 
 
604
** Returns: none
 
605
** \ingroup QT
 
606
*/
 
607
void slaterdetvector_write(ULI unit, const char *prefix, SlaterDetVector *vector)
 
608
{
 
609
  int need_to_init_psio = 0;
 
610
  int unit_opened = 1;
 
611
 
 
612
PSIO_INIT
 
613
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
614
 
 
615
  slaterdetset_write(unit, prefix, vector->sdset);
 
616
  slaterdetset_write_vect(unit, prefix, vector->coeffs, vector->size, 0);
 
617
 
 
618
PSIO_CLOSE(unit)
 
619
PSIO_DONE
 
620
 
 
621
}
 
622
 
 
623
 
 
624
/*!
 
625
** slaterdetset_write_vect(): Write to disk the coefficients for a single 
 
626
** vector associated with a set of Slater determinants.
 
627
**
 
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.
 
634
**
 
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.
 
641
**
 
642
** Returns: none
 
643
**
 
644
** CDS 8/03
 
645
** \ingroup QT
 
646
*/
 
647
void slaterdetset_write_vect(ULI unit, const char *prefix, 
 
648
  double *coeffs, int size, int vectnum)
 
649
{
 
650
  int need_to_init_psio = 0;
 
651
  int unit_opened = 1;
 
652
  char *vector_key;
 
653
 
 
654
PSIO_INIT
 
655
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
656
 
 
657
  if (vectnum < 0 || vectnum > 99) {
 
658
    fprintf(stderr, "(slaterdetset_write_vect): vectnum out of bounds\n");
 
659
    abort();
 
660
  }
 
661
 
 
662
  vector_key = (char *) malloc(strlen(prefix)+strlen(SDVECTOR_KEY_VECTOR)+5);
 
663
  sprintf(vector_key,":%s:%s%2d",prefix,SDVECTOR_KEY_VECTOR,vectnum);
 
664
 
 
665
  psio_write_entry(unit, vector_key, (char *)coeffs, size*sizeof(double));
 
666
 
 
667
PSIO_CLOSE(unit)
 
668
PSIO_DONE
 
669
 
 
670
  free(vector_key);
 
671
}
 
672
 
 
673
 
 
674
 
 
675
/*!
 
676
** slaterdetvector_read(): Read a SlaterDetVector from disk
 
677
**
 
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.
 
681
**
 
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
 
685
**                    by this function
 
686
**
 
687
** Returns: none
 
688
** \ingroup QT
 
689
*/
 
690
void slaterdetvector_read(ULI unit, const char *prefix, SlaterDetVector **sdvector)
 
691
{
 
692
  int need_to_init_psio = 0;
 
693
  int unit_opened = 1;
 
694
  SlaterDetSet *sdset;
 
695
  SlaterDetVector *vector = (SlaterDetVector *) malloc(sizeof(SlaterDetVector));
 
696
 
 
697
PSIO_INIT
 
698
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
699
 
 
700
  slaterdetset_read(unit, prefix, &sdset);
 
701
  slaterdetvector_init(vector,sdset);
 
702
  slaterdetset_read_vect(unit, prefix, vector->coeffs, vector->size, 0);
 
703
 
 
704
PSIO_CLOSE(unit)
 
705
PSIO_DONE
 
706
  
 
707
  *sdvector = vector;
 
708
}
 
709
 
 
710
 
 
711
/*!
 
712
** slaterdetset_read_vect(): Read in the coefficients for a single vector
 
713
** associated with a SlaterDetSet.
 
714
**
 
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.
 
721
**
 
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.
 
727
**
 
728
** Returns: none
 
729
**
 
730
** CDS 8/03
 
731
** \ingroup QT
 
732
*/
 
733
void slaterdetset_read_vect(ULI unit, const char *prefix, double *coeffs, 
 
734
  int size, int vectnum)
 
735
{
 
736
  int need_to_init_psio = 0;
 
737
  int unit_opened = 1;
 
738
  char *vector_key;
 
739
 
 
740
PSIO_INIT
 
741
PSIO_OPEN(unit,PSIO_OPEN_OLD)
 
742
 
 
743
  vector_key = (char *) malloc(strlen(prefix)+strlen(SDVECTOR_KEY_VECTOR)+5);
 
744
  sprintf(vector_key,":%s:%s%2d",prefix,SDVECTOR_KEY_VECTOR,vectnum);
 
745
 
 
746
  psio_read_entry(unit, vector_key, (char *)coeffs, size*sizeof(double));
 
747
 
 
748
PSIO_CLOSE(unit)
 
749
PSIO_DONE
 
750
  
 
751
  free(vector_key);
 
752
 
 
753
}
 
754
 
 
755
} /* extern "C" */