~ubuntu-branches/ubuntu/vivid/psicode/vivid

« back to all changes in this revision

Viewing changes to src/bin/ccsort/cphf_F.c

  • Committer: Bazaar Package Importer
  • Author(s): Michael Banck
  • Date: 2008-06-07 16:49:57 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080607164957-8pifvb133yjlkagn
Tags: 3.3.0-3
* debian/rules (DEB_MAKE_CHECK_TARGET): Do not abort test suite on
  failures.
* debian/rules (DEB_CONFIGURE_EXTRA_FLAGS): Set ${bindir} to /usr/lib/psi.
* debian/rules (install/psi3): Move psi3 file to /usr/bin.
* debian/patches/07_464867_move_executables.dpatch: New patch, add
  /usr/lib/psi to the $PATH, so that the moved executables are found.
  (closes: #464867)
* debian/patches/00list: Adjusted.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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
}