← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/bin/ccdensity/dump_ROHF.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/ccdensity/dump_ROHF.c
1
 
#include <stdio.h>
2
 
#include <libciomr/libciomr.h>
3
 
#include <libiwl/iwl.h>
4
 
#include <libdpd/dpd.h>
5
 
#include <psifiles.h>
6
 
#define EXTERN
7
 
#include "globals.h"
8
 
 
9
 
EXTERN dpd_gbl dpd_main;
10
 
 
11
 
 
12
 
/* DUMP_ROHF(): Mulliken-order the ROHF-CCSD two-electron density and
13
 
** dump it to a file for subsequent backtransformation.  Basically all
14
 
** we have to do is swap indices two and three, e.g.
15
 
**
16
 
** G'(pr,qs) = G(pq,rs)
17
 
**
18
 
** In order for the Mulliken-ordered density to be valid for the
19
 
** backtransformation algorithm used in TRANSQT, the final density
20
 
** must have eight-fold permutational symmetry like the original
21
 
** integrals.  Unfortunately, there are a couple of complications
22
 
** introduced by the redundant storage I use for open-shell orbitals
23
 
** (useful for spin-restricted references --- see the CCSORT code). In
24
 
** particular, if the Mulliken-ordered density is not bra-ket
25
 
** symmetric, specific elements of the final density must be
26
 
** multiplied by two or they will not appear with the correct
27
 
** prefactor in the backtransformation.  This only affects the IJKA,
28
 
** IAJB, and ABCI Dirac-ordered densities, since the remaining three
29
 
** components are bra-ket symmetric in Mulliken order.
30
 
**
31
 
** I really need to give an example of this problem using specific
32
 
** elements of GIJKA so that the code below will be clearer.*/
33
 
 
34
 
void dump_ROHF(struct iwlbuf *OutBuf, struct RHO_Params rho_params)
35
 
{
36
 
  int nirreps, nmo, nfzv;
37
 
  int *qt_occ, *qt_vir;
38
 
  int h, row, col, p, q, r, s;
39
 
  PSI_FPTR next;
40
 
  dpdbuf4 G;
41
 
 
42
 
  qt_occ = moinfo.qt_occ;  qt_vir = moinfo.qt_vir;
43
 
  nirreps = moinfo.nirreps;
44
 
  nmo = moinfo.nmo;
45
 
  nfzv = moinfo.nfzv;
46
 
 
47
 
  psio_open(PSIF_MO_OPDM, PSIO_OPEN_OLD);
48
 
 /*  psio_write_entry(PSIF_MO_OPDM, "MO-basis OPDM", (char *) moinfo.opdm[0], */
49
 
  psio_write_entry(PSIF_MO_OPDM, rho_params.opdm_lbl, (char *) moinfo.opdm[0],
50
 
                   sizeof(double)*(nmo-nfzv)*(nmo-nfzv));
51
 
  psio_close(PSIF_MO_OPDM, 1);
52
 
 
53
 
if (!params.onepdm) {
54
 
  psio_open(PSIF_MO_LAG, PSIO_OPEN_OLD);
55
 
  psio_write_entry(PSIF_MO_LAG, "MO-basis Lagrangian", (char *) moinfo.I[0],
56
 
                   sizeof(double)*nmo*nmo);
57
 
  psio_close(PSIF_MO_LAG, 1);
58
 
 
59
 
  dpd_buf4_init(&G, CC_GAMMA, 0, 0, 0, 0, 0, 0, "GIjKl");
60
 
  dpd_buf4_sort(&G, CC_TMP0, prqs, 0, 0, "G(IK,JL)");
61
 
  dpd_buf4_close(&G);
62
 
  dpd_buf4_init(&G, CC_TMP0, 0, 0, 0, 0, 0, 0, "G(IK,JL)");
63
 
  dpd_buf4_dump(&G, OutBuf, qt_occ, qt_occ, qt_occ, qt_occ, 1, 0);
64
 
  dpd_buf4_close(&G);
65
 
 
66
 
  dpd_buf4_init(&G, CC_GAMMA, 0, 0, 10, 0, 10, 0, "GIjKa");
67
 
  dpd_buf4_sort(&G, CC_TMP0, prqs, 0, 10, "G(IK,JA)");
68
 
  dpd_buf4_close(&G);
69
 
  dpd_buf4_init(&G, CC_TMP0, 0, 0, 10, 0, 10, 0, "G(IK,JA)");
70
 
  
71
 
  for(h=0; h < nirreps; h++) {
72
 
    dpd_buf4_mat_irrep_init(&G, h);
73
 
    dpd_buf4_mat_irrep_rd(&G, h);
74
 
 
75
 
    for(row=0; row < G.params->rowtot[h]; row++) {
76
 
      p = G.params->roworb[h][row][0];
77
 
      q = G.params->roworb[h][row][1];
78
 
      for(col=0; col < G.params->coltot[h]; col++) {
79
 
        r = G.params->colorb[h][col][0];
80
 
        s = G.params->colorb[h][col][1];
81
 
 
82
 
        if((qt_occ[q] == qt_vir[s]) && (p == r))
83
 
          G.matrix[h][row][col] *= 2;
84
 
      }
85
 
    }
86
 
 
87
 
    dpd_buf4_mat_irrep_wrt(&G, h);
88
 
    dpd_buf4_mat_irrep_close(&G, h);
89
 
  }
90
 
 
91
 
  dpd_buf4_dump(&G, OutBuf, qt_occ, qt_occ, qt_occ, qt_vir, 0, 0);
92
 
  dpd_buf4_close(&G);
93
 
 
94
 
  dpd_buf4_init(&G, CC_GAMMA, 0, 0, 5, 0, 5, 0, "GIjAb");
95
 
  dpd_buf4_sort(&G, CC_TMP9, prqs, 10, 10, "G(IA,JB)");
96
 
  dpd_buf4_close(&G);
97
 
  dpd_buf4_init(&G, CC_TMP9, 0, 10, 10, 10, 10, 0, "G(IA,JB)");
98
 
  dpd_buf4_symm(&G);
99
 
  dpd_buf4_dump(&G, OutBuf, qt_occ, qt_vir, qt_occ, qt_vir, 1, 0);
100
 
  dpd_buf4_close(&G);
101
 
 
102
 
  dpd_buf4_init(&G, CC_GAMMA, 0, 10, 10, 10, 10, 0, "GIBJA");
103
 
  dpd_buf4_sort(&G, CC_TMP0, prqs, 0, 5, "G(IJ,AB)");
104
 
  dpd_buf4_close(&G);
105
 
  dpd_buf4_init(&G, CC_TMP0, 0, 0, 5, 0, 5, 0, "G(IJ,AB)");
106
 
  dpd_buf4_scm(&G, 0.5);
107
 
 
108
 
  for(h=0; h < nirreps; h++) {
109
 
    dpd_buf4_mat_irrep_init(&G, h);
110
 
    dpd_buf4_mat_irrep_rd(&G, h);
111
 
 
112
 
    for(row=0; row < G.params->rowtot[h]; row++) {
113
 
      p = G.params->roworb[h][row][0];
114
 
      q = G.params->roworb[h][row][1];
115
 
      for(col=0; col < G.params->coltot[h]; col++) {
116
 
        r = G.params->colorb[h][col][0];
117
 
        s = G.params->colorb[h][col][1];
118
 
 
119
 
        if((qt_occ[p] == qt_vir[r]) && (qt_occ[q] == qt_vir[s]))
120
 
          G.matrix[h][row][col] *= 2;
121
 
      }
122
 
    }
123
 
 
124
 
    dpd_buf4_mat_irrep_wrt(&G, h);
125
 
    dpd_buf4_mat_irrep_close(&G, h);
126
 
  }
127
 
  
128
 
  dpd_buf4_dump(&G, OutBuf, qt_occ, qt_occ, qt_vir, qt_vir, 0, 0);
129
 
  dpd_buf4_close(&G);
130
 
 
131
 
  dpd_buf4_init(&G, CC_GAMMA, 0, 11, 5, 11, 5, 0, "GCiAb");
132
 
  dpd_buf4_sort(&G, CC_TMP0, prqs, 5, 10, "G(ca,IB)");
133
 
  dpd_buf4_close(&G);
134
 
  dpd_buf4_init(&G, CC_TMP0, 0, 5, 10, 5, 10, 0, "G(ca,IB)");
135
 
 
136
 
  for(h=0; h < nirreps; h++) {
137
 
    dpd_buf4_mat_irrep_init(&G, h);
138
 
    dpd_buf4_mat_irrep_rd(&G, h);
139
 
 
140
 
    for(row=0; row < G.params->rowtot[h]; row++) {
141
 
      p = G.params->roworb[h][row][0];
142
 
      q = G.params->roworb[h][row][1];
143
 
      for(col=0; col < G.params->coltot[h]; col++) {
144
 
        r = G.params->colorb[h][col][0];
145
 
        s = G.params->colorb[h][col][1];
146
 
 
147
 
        if((qt_vir[p] == qt_occ[r]) && (q == s))
148
 
          G.matrix[h][row][col] *= 2;
149
 
      }
150
 
    }
151
 
 
152
 
    dpd_buf4_mat_irrep_wrt(&G, h);
153
 
    dpd_buf4_mat_irrep_close(&G, h);
154
 
  }
155
 
 
156
 
  dpd_buf4_dump(&G, OutBuf, qt_vir, qt_vir, qt_occ, qt_vir, 0, 0);
157
 
  dpd_buf4_close(&G);
158
 
  dpd_buf4_init(&G, CC_GAMMA, 0, 5, 5, 5, 5, 0, "GAbCd");
159
 
  dpd_buf4_sort(&G, CC_TMP0, prqs, 5, 5, "G(AC,BD)");
160
 
  dpd_buf4_close(&G);
161
 
  dpd_buf4_init(&G, CC_TMP0, 0, 5, 5, 5, 5, 0, "G(AC,BD)");
162
 
  dpd_buf4_dump(&G, OutBuf, qt_vir, qt_vir, qt_vir, qt_vir, 1, 0);
163
 
  dpd_buf4_close(&G);
164
 
 
165
 
  }
166
 
}