← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/bin/detci/ssq.c

  • 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:
src/bin/detci/ssq.c
1
 
/*
2
 
** SSQ.C
3
 
**
4
 
** Routine for computing the expectation value of S^2.
5
 
** Useful for determining if spin-contamination (due to the davidson
6
 
** procedure) is a problem.
7
 
**
8
 
** 24 June 1997
9
 
**
10
 
*/
11
 
 
12
 
/* #define DEBUG */
13
 
#include <stdio.h>
14
 
#include <libciomr/libciomr.h>
15
 
#include "structs.h"
16
 
#define EXTERN
17
 
#include "globals.h"
18
 
 
19
 
#define MIN0(a,b) (((a)<(b)) ? (a) : (b))
20
 
#define MAX0(a,b) (((a)>(b)) ? (a) : (b))
21
 
#define INDEX(i,j) ((i>j) ? (ioff[(i)]+(j)) : (ioff[(j)]+(i)))
22
 
 
23
 
 
24
 
/*
25
 
** SSQ()
26
 
**
27
 
** Calculates the expectation value of S^2.
28
 
**
29
 
*/
30
 
double ssq(struct stringwr *alplist, struct stringwr *betlist,
31
 
     double **CL, double **CR, int nas, int nbs,
32
 
     int Ja_list, int Jb_list) 
33
 
{
34
 
   struct stringwr *Ia, *Ib ;
35
 
   unsigned int Ia_ex, Ib_ex;
36
 
   int Ia_idx, Ib_idx;
37
 
   int Ja_idx, Jb_idx;
38
 
   int Ja_sgn, Jb_sgn;
39
 
   int ij, ji, i1, j1, i2, j2;
40
 
   double tval, Ms, S2, smin_spls = 0.0;
41
 
 
42
 
   int Iacnt, Jbcnt, *Iaij, *Ibij;
43
 
   unsigned int *Iaridx, *Ibridx;
44
 
   signed char *Iasgn, *Ibsgn;
45
 
 
46
 
   /* <S^2> = <S_z> + <S_z>^2 + <S_S+> */
47
 
   /* First determine the expection value of <S_S+> */
48
 
 
49
 
   /* loop over Ia */
50
 
   #ifdef DEBUG
51
 
   fprintf(outfile,"number of alpha strings = %d\n",nas);
52
 
   #endif
53
 
   for (Ia=alplist,Ia_idx=0; Ia_idx < nas; Ia_idx++,Ia++) {
54
 
 
55
 
      /* loop over excitations E^a_{ji} from |A(I_a)> */
56
 
      Iacnt = Ia->cnt[Ja_list];
57
 
      Iaridx = Ia->ridx[Ja_list];
58
 
      Iasgn = Ia->sgn[Ja_list];
59
 
      Iaij = Ia->oij[Ja_list];
60
 
      for (Ia_ex=0; Ia_ex < Iacnt; Ia_ex++) {
61
 
         ji = *Iaij++;
62
 
         Ja_idx = *Iaridx++;
63
 
         Ja_sgn = *Iasgn++;
64
 
         i1 = ji/CalcInfo.num_ci_orbs;
65
 
         j1 = ji%CalcInfo.num_ci_orbs;
66
 
 
67
 
         /* loop over Ib */
68
 
         #ifdef DEBUG
69
 
         fprintf(outfile,"number of beta strings = %d\n",nbs);
70
 
         #endif
71
 
         for (Ib=betlist, Ib_idx=0; Ib_idx < nbs; Ib_idx++, Ib++) {
72
 
 
73
 
            /* loop over excitations E^b_{ij} from |B(I_b)> */
74
 
            Jbcnt = Ib->cnt[Jb_list];
75
 
            Ibridx = Ib->ridx[Jb_list];
76
 
            Ibsgn = Ib->sgn[Jb_list];
77
 
            Ibij = Ib->oij[Jb_list];
78
 
 
79
 
            tval = 0.0;
80
 
            for (Ib_ex=0; Ib_ex < Jbcnt; Ib_ex++) {
81
 
               ij = *Ibij++;
82
 
               Jb_idx = *Ibridx++;
83
 
               Jb_sgn = *Ibsgn++;
84
 
               i2 = ij/CalcInfo.num_ci_orbs;
85
 
               j2 = ij%CalcInfo.num_ci_orbs; 
86
 
               if (i1!=j2 || i2!=j1) continue;
87
 
               tval += CR[Ia_idx][Ib_idx] * CL[Ja_idx][Jb_idx] *
88
 
                   (double) Ja_sgn * (double) Jb_sgn;
89
 
               #ifdef DEBUG
90
 
               fprintf(outfile,"\n\nIa_idx = %d\n",Ia_idx);
91
 
               fprintf(outfile,"Ib_idx = %d\n",Ib_idx);
92
 
               fprintf(outfile,"Ja_idx = %d\n",Ja_idx);
93
 
               fprintf(outfile,"Jb_idx = %d\n",Jb_idx);
94
 
               fprintf(outfile,"tval_ssq = %lf\n",-tval);
95
 
               fprintf(outfile,"CR = %lf\n",CR[Ia_idx][Ib_idx]);
96
 
               fprintf(outfile,"LR = %lf\n",CL[Ja_idx][Jb_idx]);
97
 
               fprintf(outfile,"Ja_sgn = %lf\n",Ja_sgn);
98
 
               fprintf(outfile,"Jb_sgn = %lf\n",Jb_sgn);
99
 
               #endif
100
 
               }
101
 
            smin_spls += tval;
102
 
      
103
 
            } /* end loop over Ib */
104
 
         } /* end loop over Ia excitations */ 
105
 
     } /* end loop over Ia */ 
106
 
 
107
 
   S2 = -smin_spls;
108
 
 
109
 
   return(S2);
110
 
}
111