← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/bin/ccsort/idx_permute.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:
src/bin/ccsort/idx_permute.cc
 
1
/*! \file
 
2
    \ingroup CCSORT
 
3
    \brief Enter brief description of file here 
 
4
*/
 
5
#include <cstdio>
 
6
#include <cstdlib>
 
7
#include <libiwl/iwl.h>
 
8
#include <libdpd/dpd.h>
 
9
 
 
10
namespace psi { namespace ccsort {
 
11
 
 
12
void idx_error(const char *message, int p, int q, int r, int s, int pq, int rs,
 
13
               int pq_sym, int rs_sym, FILE *outfile);
 
14
void idx_permute(dpdfile4 *File, struct iwlbuf *OutBuf,
 
15
                 int **bucket_map, int p, int q, int r, int s,
 
16
                 int perm_pr, int perm_qs, int perm_prqs,
 
17
                 double value, FILE *outfile)
 
18
{
 
19
  int p_sym, q_sym, r_sym, s_sym;
 
20
  int pq_sym, rs_sym, rq_sym, ps_sym, qp_sym, sp_sym, sr_sym, qr_sym;
 
21
  int pq, rs, rq, ps, qp, sr, qr, sp;
 
22
  int perm_pq, perm_rs;
 
23
  dpdparams4 *Params;
 
24
  int this_bucket;
 
25
 
 
26
  Params = File->params;
 
27
  perm_pq = Params->perm_pq;
 
28
  perm_rs = Params->perm_rs;
 
29
  
 
30
  /* Get the orbital symmetries */
 
31
  p_sym = Params->psym[p]; q_sym = Params->qsym[q];
 
32
  r_sym = Params->rsym[r]; s_sym = Params->ssym[s];
 
33
 
 
34
  /* Go through the allowed permutations --- NB these are Dirac permutations */
 
35
 
 
36
  /* Get the left and right symmetry blocks */
 
37
  pq_sym = p_sym^q_sym;
 
38
  rs_sym = r_sym^s_sym;
 
39
 
 
40
  /* Get the row and column indices and assign the value */
 
41
  pq = Params->rowidx[p][q];
 
42
  rs = Params->colidx[r][s];
 
43
  if((pq >= Params->rowtot[pq_sym]) || (rs >= Params->coltot[rs_sym]))
 
44
      idx_error("Params_make: pq, rs", p,q,r,s,pq,rs,pq_sym,rs_sym,outfile);
 
45
 
 
46
  this_bucket = bucket_map[p][q];
 
47
  iwl_buf_wrt_val(&OutBuf[this_bucket], p, q, r, s, value, 0, outfile, 0);
 
48
 
 
49
  if(perm_pr) {
 
50
      rq_sym = r_sym^q_sym;
 
51
      ps_sym = p_sym^s_sym;
 
52
      rq = Params->rowidx[r][q];
 
53
      ps = Params->colidx[p][s];
 
54
      if((rq >= Params->rowtot[rq_sym]) || (ps >= Params->coltot[ps_sym]))
 
55
          idx_error("Params_make: rq, ps", p,q,r,s,rq,ps,rq_sym,ps_sym,outfile);
 
56
 
 
57
      this_bucket = bucket_map[r][q];
 
58
      iwl_buf_wrt_val(&OutBuf[this_bucket], r, q, p, s, value, 0, outfile, 0);
 
59
    }
 
60
 
 
61
  if(perm_qs) {
 
62
      ps_sym = p_sym^s_sym;
 
63
      rq_sym = r_sym^q_sym;
 
64
      ps = Params->rowidx[p][s];
 
65
      rq = Params->colidx[r][q];
 
66
      if((ps >= Params->rowtot[ps_sym]) || (rq >= Params->coltot[rq_sym]))
 
67
          idx_error("Params_make: ps, rq", p,q,r,s,ps,rq,ps_sym,rq_sym,outfile);
 
68
 
 
69
      this_bucket = bucket_map[p][s];
 
70
      iwl_buf_wrt_val(&OutBuf[this_bucket], p, s, r, q, value, 0, outfile, 0);
 
71
    }
 
72
 
 
73
  if(perm_pr && perm_qs) {
 
74
      rs_sym = r_sym^s_sym;
 
75
      pq_sym = p_sym^q_sym;
 
76
      rs = Params->rowidx[r][s];
 
77
      pq = Params->colidx[p][q];
 
78
      if((rs >= Params->rowtot[rs_sym]) || (pq >= Params->coltot[pq_sym]))
 
79
          idx_error("Params_make: rs, pq", p,q,r,s,rs,pq,rs_sym,pq_sym,outfile);
 
80
 
 
81
      this_bucket = bucket_map[r][s];
 
82
      iwl_buf_wrt_val(&OutBuf[this_bucket], r, s, p, q, value, 0, outfile, 0);
 
83
    }
 
84
 
 
85
  if(perm_prqs) {
 
86
      qp_sym = q_sym^p_sym;
 
87
      sr_sym = s_sym^r_sym;
 
88
      qp = Params->rowidx[q][p];
 
89
      sr = Params->colidx[s][r];
 
90
      if((qp >= Params->rowtot[qp_sym]) || (sr >= Params->coltot[sr_sym]))
 
91
          idx_error("Params_make: qp, sr", p,q,r,s,qp,sr,qp_sym,sr_sym,outfile);
 
92
 
 
93
      this_bucket = bucket_map[q][p];
 
94
      iwl_buf_wrt_val(&OutBuf[this_bucket], q, p, s, r, value, 0, outfile, 0);
 
95
      
 
96
 
 
97
      if(perm_pr) {
 
98
          qr_sym = q_sym^r_sym;
 
99
          sp_sym = s_sym^p_sym;
 
100
          qr = Params->rowidx[q][r];
 
101
          sp = Params->colidx[s][p];
 
102
          if((qr >= Params->rowtot[qr_sym])||(sp >= Params->coltot[sp_sym]))
 
103
              idx_error("Params_make: qr, sp", p,q,r,s,qr,sp,qr_sym,sp_sym,
 
104
                               outfile);
 
105
 
 
106
          this_bucket = bucket_map[q][r];
 
107
          iwl_buf_wrt_val(&OutBuf[this_bucket], q, r, s, p, value, 0, outfile, 0);
 
108
        }
 
109
 
 
110
      if(perm_qs) {
 
111
          sp_sym = s_sym^p_sym;
 
112
          qr_sym = q_sym^r_sym;
 
113
          sp = Params->rowidx[s][p];
 
114
          qr = Params->colidx[q][r];
 
115
          if((sp >= Params->rowtot[sp_sym])||(qr >= Params->coltot[qr_sym]))
 
116
              idx_error("Params_make: sp, qr", p,q,r,s,sp,qr,sp_sym,qr_sym,
 
117
                               outfile);
 
118
 
 
119
          this_bucket = bucket_map[s][p];
 
120
          iwl_buf_wrt_val(&OutBuf[this_bucket], s, p, q, r, value, 0, outfile, 0);
 
121
        }
 
122
      
 
123
      if(perm_pr && perm_qs) {
 
124
          sr_sym = s_sym^r_sym;
 
125
          qp_sym = q_sym^p_sym;
 
126
          sr = Params->rowidx[s][r];
 
127
          qp = Params->colidx[q][p];
 
128
          if((sr >= Params->rowtot[sr_sym])||(qp >= Params->coltot[qp_sym]))
 
129
              idx_error("Params_make: sr, qp", p,q,r,s,sr,qp,sr_sym,qp_sym,
 
130
                               outfile);
 
131
 
 
132
          this_bucket = bucket_map[s][r];
 
133
          iwl_buf_wrt_val(&OutBuf[this_bucket], s, r, q, p, value, 0, outfile, 0);
 
134
        }
 
135
    }
 
136
}
 
137
 
 
138
}} // namespace psi::ccsort