← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/bin/ccsort/cphf_F.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/ccsort/cphf_F.c
1
 
#include <stdio.h>
2
 
#include <stdlib.h>
3
 
#include <string.h>
4
 
#include <libqt/qt.h>
5
 
#include <libdpd/dpd.h>
6
 
#include <libciomr/libciomr.h>
7
 
#include <psifiles.h>
8
 
#include "MOInfo.h"
9
 
#define EXTERN
10
 
#include "globals.h"
11
 
 
12
 
void cphf_F(char *cart)
13
 
{
14
 
  int irrep, row, a, i, asym, isym, num_ai, info, *ipiv;
15
 
  double *vector;
16
 
  dpdbuf4 A;
17
 
  dpdfile2 mu;
18
 
 
19
 
  psio_open(PSIF_MO_HESS, 1);
20
 
  dpd_buf4_init(&A, PSIF_MO_HESS, 0, 11, 11, 11, 11, 0, "A(AI,BJ)");
21
 
 
22
 
  if (!strcmp(cart,"X")) {
23
 
    irrep = moinfo.irrep_x;
24
 
 
25
 
    /* sort Mu elements into a single vector for lineq solver */
26
 
    dpd_file2_init(&mu, CC_OEI, irrep, 0, 1, "Mu_X_IA");
27
 
    dpd_file2_mat_init(&mu);
28
 
    dpd_file2_mat_rd(&mu);
29
 
    num_ai = A.params->rowtot[irrep];
30
 
    vector = init_array(num_ai);
31
 
    for(row=0; row < num_ai; row++) {
32
 
      i = A.params->roworb[irrep][row][0];
33
 
      a = A.params->roworb[irrep][row][1];
34
 
      isym = A.params->psym[i];
35
 
      asym = A.params->qsym[a];
36
 
      vector[row] = -mu.matrix[asym][a-A.params->qoff[asym]][i-A.params->poff[isym]];
37
 
    }
38
 
    dpd_file2_mat_close(&mu);
39
 
    dpd_file2_close(&mu);
40
 
 
41
 
    /* grab current irrep of MO Hessian */
42
 
    dpd_buf4_mat_irrep_init(&A, irrep);
43
 
    dpd_buf4_mat_irrep_rd(&A, irrep);
44
 
 
45
 
 
46
 
    /* solve CPHF equations */
47
 
    ipiv = init_int_array(num_ai);
48
 
    info = C_DGESV(num_ai, 1, &(A.matrix[irrep][0][0]), num_ai, ipiv, vector, num_ai);
49
 
    if(info) {
50
 
      fprintf(outfile, "CCSORT: cphf_F: Error in C_DGESV.  Info = %d.  Cart = X. Exiting.\n", info);
51
 
      exit(PSI_RETURN_FAILURE);
52
 
    }
53
 
    free(ipiv);
54
 
 
55
 
    dpd_buf4_mat_irrep_close(&A, irrep);
56
 
 
57
 
    /* sort CPHF solution to DPD format */
58
 
    dpd_file2_init(&mu, CC_OEI, irrep, 1, 0, "CPHF Uf_X_AI");
59
 
    dpd_file2_mat_init(&mu);
60
 
    for(row=0; row < num_ai; row++) {
61
 
      a = A.params->roworb[irrep][row][0];
62
 
      i = A.params->roworb[irrep][row][1];
63
 
      asym = A.params->psym[a];
64
 
      isym = A.params->qsym[i];
65
 
      mu.matrix[asym][a-A.params->poff[asym]][i-A.params->qoff[isym]] = vector[row];
66
 
    }
67
 
    dpd_file2_mat_wrt(&mu);
68
 
    dpd_file2_close(&mu);
69
 
  }
70
 
 
71
 
  if (!strcmp(cart,"Y")) {
72
 
    irrep = moinfo.irrep_y;
73
 
 
74
 
    /* sort Mu elements into a single vector for lineq solver */
75
 
    dpd_file2_init(&mu, CC_OEI, irrep, 0, 1, "Mu_Y_IA");
76
 
    dpd_file2_mat_init(&mu);
77
 
    dpd_file2_mat_rd(&mu);
78
 
    num_ai = A.params->rowtot[irrep];
79
 
    vector = init_array(num_ai);
80
 
    for(row=0; row < num_ai; row++) {
81
 
      i = A.params->roworb[irrep][row][0];
82
 
      a = A.params->roworb[irrep][row][1];
83
 
      isym = A.params->psym[i];
84
 
      asym = A.params->qsym[a];
85
 
      vector[row] = -mu.matrix[asym][a-A.params->qoff[asym]][i-A.params->poff[isym]];
86
 
    }
87
 
    dpd_file2_mat_close(&mu);
88
 
    dpd_file2_close(&mu);
89
 
 
90
 
    /* grab current irrep of MO Hessian */
91
 
    dpd_buf4_mat_irrep_init(&A, irrep);
92
 
    dpd_buf4_mat_irrep_rd(&A, irrep);
93
 
 
94
 
 
95
 
    /* solve CPHF equations */
96
 
    ipiv = init_int_array(num_ai);
97
 
    info = C_DGESV(num_ai, 1, &(A.matrix[irrep][0][0]), num_ai, ipiv, vector, num_ai);
98
 
    if(info) {
99
 
      fprintf(outfile, "CCSORT: cphf_F: Error in C_DGESV.  Info = %d.  Cart = Y. Exiting.\n", info);
100
 
      exit(PSI_RETURN_FAILURE);
101
 
    }
102
 
    free(ipiv);
103
 
 
104
 
    dpd_buf4_mat_irrep_close(&A, irrep);
105
 
 
106
 
    /* sort CPHF solution to DPD format */
107
 
    dpd_file2_init(&mu, CC_OEI, irrep, 1, 0, "CPHF Uf_Y_AI");
108
 
    dpd_file2_mat_init(&mu);
109
 
    for(row=0; row < num_ai; row++) {
110
 
      a = A.params->roworb[irrep][row][0];
111
 
      i = A.params->roworb[irrep][row][1];
112
 
      asym = A.params->psym[a];
113
 
      isym = A.params->qsym[i];
114
 
      mu.matrix[asym][a-A.params->poff[asym]][i-A.params->qoff[isym]] = vector[row];
115
 
    }
116
 
    dpd_file2_mat_wrt(&mu);
117
 
    dpd_file2_close(&mu);
118
 
  }
119
 
 
120
 
  if (!strcmp(cart,"Z")) {
121
 
    irrep = moinfo.irrep_z;
122
 
 
123
 
    /* sort Mu elements into a single vector for lineq solver */
124
 
    dpd_file2_init(&mu, CC_OEI, irrep, 0, 1, "Mu_Z_IA");
125
 
    dpd_file2_mat_init(&mu);
126
 
    dpd_file2_mat_rd(&mu);
127
 
    num_ai = A.params->rowtot[irrep];
128
 
    vector = init_array(num_ai);
129
 
    for(row=0; row < num_ai; row++) {
130
 
      i = A.params->roworb[irrep][row][0];
131
 
      a = A.params->roworb[irrep][row][1];
132
 
      isym = A.params->psym[i];
133
 
      asym = A.params->qsym[a];
134
 
      vector[row] = -mu.matrix[asym][a-A.params->qoff[asym]][i-A.params->poff[isym]];
135
 
    }
136
 
    dpd_file2_mat_close(&mu);
137
 
    dpd_file2_close(&mu);
138
 
 
139
 
    /* grab current irrep of MO Hessian */
140
 
    dpd_buf4_mat_irrep_init(&A, irrep);
141
 
    dpd_buf4_mat_irrep_rd(&A, irrep);
142
 
 
143
 
    /* solve CPHF equations */
144
 
    ipiv = init_int_array(num_ai);
145
 
    info = C_DGESV(num_ai, 1, &(A.matrix[irrep][0][0]), num_ai, ipiv, vector, num_ai);
146
 
    if(info) {
147
 
      fprintf(outfile, "CCSORT: cphf_F: Error in C_DGESV.  Info = %d.  Cart = Z. Exiting.\n", info);
148
 
      exit(PSI_RETURN_FAILURE);
149
 
    }
150
 
    free(ipiv);
151
 
 
152
 
    dpd_buf4_mat_irrep_close(&A, irrep);
153
 
 
154
 
    /* sort CPHF solution to DPD format */
155
 
    dpd_file2_init(&mu, CC_OEI, irrep, 1, 0, "CPHF Uf_Z_AI");
156
 
    dpd_file2_mat_init(&mu);
157
 
    for(row=0; row < num_ai; row++) {
158
 
      a = A.params->roworb[irrep][row][0];
159
 
      i = A.params->roworb[irrep][row][1];
160
 
      asym = A.params->psym[a];
161
 
      isym = A.params->qsym[i];
162
 
      mu.matrix[asym][a-A.params->poff[asym]][i-A.params->qoff[isym]] = vector[row];
163
 
    }
164
 
    dpd_file2_mat_wrt(&mu);
165
 
    dpd_file2_close(&mu);
166
 
  }
167
 
 
168
 
  dpd_buf4_close(&A);
169
 
 
170
 
  if (!strcmp(cart,"Z"))
171
 
    psio_close(PSIF_MO_HESS, 0);
172
 
  else
173
 
    psio_close(PSIF_MO_HESS, 1);
174
 
}