2
* Revision 1.2 2001/06/29 20:39:29 evaleev
3
* Modified cscf to use libpsio to store supermatrix files.
5
/* Revision 1.1.1.1 2000/02/04 22:52:30 evaleev
6
/* Started PSI 3 repository
8
/* Revision 1.4 1999/11/17 19:40:46 evaleev
9
/* Made all the adjustments necessary to have direct UHF working. Still doesn't work though..
11
/* Revision 1.3 1999/11/02 23:55:57 localpsi
12
/* Shawn Brown - (11/2/99) Modified to the code in a few major ways.
14
/* 1. Added the capability to do UHF. All of the features available with the
15
/* other refrences have been added for UHF.
17
/* 2. For UHF, I had to alter the structure of file30. (See cleanup.c for a
18
/* map) This entailed adding a pointer array right after the header in the SCF
19
/* section of file30 that pointed to all of the data for the SCF caclulation.
20
/* Functions were added to libfile30 to account for this and they are
21
/* incorporated in this code.
23
/* 3. Updated and fixed all of the problems associated with my previous
24
/* guessing code. The code no longer uses OPENTYPE to specify the type of
25
/* occupation. The keword REFERENCE and MULTP can now be used to indicate any
26
/* type of calculation. (e.g. ROHF with MULTP of 1 is an open shell singlet
27
/* ROHF calculation) This code was moved to occ_fun.c. The code can also
28
/* guess at any multplicity in a highspin case, provided enough electrons.
30
/* Revision 1.2 1999/08/17 19:04:15 evaleev
31
/* Changed the default symmetric orthogonalization to the canonical
32
/* orthogonalization. Now, if near-linear dependencies in the basis are found,
33
/* eigenvectors of the overlap matrix with eigenvalues less than 1E-6 will be
34
/* left out. This will lead to num_mo != num_so, i.e. SCF eigenvector is no
35
/* longer a square matrix. Had to rework some routines in libfile30, and add some.
36
/* The progrem prints out a warning if near-linear dependencies are found. TRANSQT
37
/* and a whole bunch of other codes has to be fixed to work with such basis sets.
39
/* Revision 1.1.1.1 1999/04/12 16:59:26 evaleev
40
/* Added a version of CSCF that can work with CINTS.
44
static char *rcsid = "$Id: formgo.c 430 2001-06-29 20:39:29Z evaleev $";
50
static double *gtmp,*gtmpo,*gtmpo2,*ptmp,*ptmpo,*ptmpo2;
51
extern int num_bufs_c,num_bufs_o,readflgc,readflgo;
52
extern struct c_pkints {
57
extern struct o_pkints {
64
extern int lasto,lastc;
72
register int i,j,k,joff,nn;
77
struct o_pkints *o_temp;
78
struct c_pkints *c_temp;
83
gtmp = (double *) init_array(tmpsiz);
84
gtmpo = (double *) init_array(tmpsiz);
85
ptmp = (double *) init_array(tmpsiz);
86
ptmpo = (double *) init_array(tmpsiz);
88
gtmpo2 = (double *) init_array(tmpsiz);
89
ptmpo2 = (double *) init_array(tmpsiz);
93
bzero(gtmp,sizeof(double)*tmpsiz);
94
bzero(gtmpo,sizeof(double)*tmpsiz);
96
bzero(gtmpo2,sizeof(double)*tmpsiz);
99
for(k=joff=0; k < num_ir ; k++) {
100
if(nn=scf_info[k].num_so) {
101
for(i=0; i < nn ; i++) {
103
for(j=0; j <= i ; j++) {
104
ptmp[ioff[i+joff]+j+joff] =
105
scf_info[k].pmat2[ioff[i]+j];
106
ptmpo[ioff[i+joff]+j+joff] =
107
scf_info[k].pmato2[ioff[i]+j];
111
for(j=0; j <= i ; j++) {
112
ptmp[ioff[i+joff]+j+joff] =
113
scf_info[k].dpmat[ioff[i]+j];
114
ptmpo[ioff[i+joff]+j+joff] =
115
-spin_info[0].scf_spin[k].dpmat[ioff[i]+j];
116
ptmpo2[ioff[i+joff]+j+joff] =
117
-spin_info[1].scf_spin[k].dpmat[ioff[i]+j];
121
for(j=0; j <= i ; j++) {
122
ptmp[ioff[i+joff]+j+joff] =
123
scf_info[k].dpmat[ioff[i]+j];
124
ptmpo[ioff[i+joff]+j+joff] =
125
scf_info[k].dpmato[ioff[i]+j];
134
/* int_nums_o = (int *) init_array(num_bufs_o+1); */
135
int_nums_o = (int *) init_int_array(num_bufs_o+1);
136
/* int_nums_c = (int *) init_array(num_bufs_c+1); */
137
int_nums_c = (int *) init_int_array(num_bufs_c+1);
138
for(i=1; i < num_bufs_o ; i++) int_nums_o[i]=maxbuf;
139
for(i=1; i < num_bufs_c ; i++) int_nums_c[i]=maxbuf;
140
int_nums_o[num_bufs_o]=lasto;
141
int_nums_c[num_bufs_c]=lastc;
146
num=int_nums_o[whereo];
147
for (j=0; j < num_bufs_o ; j++) {
150
for (i=num; i ; i--,o_temp++) {
153
tmpval = (*o_temp).pval;
154
dotest = (*o_temp).qval;
157
gtmp[ij] += ptmp[kl]*tmpval;
158
gtmpo[ij] += ptmpo[kl]*dotest;
159
gtmpo2[ij] += ptmpo2[kl]*dotest;
161
gtmp[kl] += ptmp[ij]*tmpval;
162
gtmpo[kl] += ptmpo[ij]*dotest;
163
gtmpo2[kl] += ptmpo2[ij]*dotest;
167
gtmp[ij] += ptmp[kl]*tmpval;
168
gtmp[kl] += ptmp[ij]*tmpval;
169
gtmpo[ij] += ptmpo[kl]*dotest;
170
gtmpo[kl] += ptmpo[ij]*dotest;
174
if (readflgo && j < num_bufs_o-1) {
175
if(whereo==num_bufs_o) {
176
PKmat.bufpos = PSIO_ZERO;
180
num=int_nums_o[whereo];
181
psio_read(PKmat.unit, PKmat.key, (char *) o_outbuf, sizeof(struct o_pkints)*num,
182
PKmat.bufpos, &(PKmat.bufpos));
186
num=int_nums_c[wherec];
187
for (j=0; j < num_bufs_c ; j++) {
190
for (i=num; i ; i--,c_temp++) {
193
tmpval = (*c_temp).pval;
195
gtmp[ij] += ptmp[kl]*tmpval;
196
gtmp[kl] += ptmp[ij]*tmpval;
199
if (readflgc && j < num_bufs_c-1) {
200
if(wherec==num_bufs_c) {
201
Pmat.bufpos = PSIO_ZERO;
205
num=int_nums_c[wherec];
206
psio_read(Pmat.unit, Pmat.key, (char *) c_outbuf, sizeof(struct c_pkints)*num,
207
Pmat.bufpos, &(Pmat.bufpos));
211
for(k=joff=0; k < num_ir ; k++) {
212
if(nn=scf_info[k].num_so) {
213
for(i=0; i < nn ; i++) {
215
for(j=0; j <= i ; j++) {
216
scf_info[k].dpmat[ioff[i]+j] =
217
gtmp[ioff[i+joff]+j+joff];
218
scf_info[k].dpmato[ioff[i]+j] =
219
gtmpo[ioff[i+joff]+j+joff];
223
for(j=0; j <=i; j++){
224
spin_info[0].scf_spin[k].gmat[ioff[i]+j] +=
225
gtmp[ioff[i+joff]+j+joff]
226
+gtmpo[ioff[i+joff]+j+joff];
227
spin_info[1].scf_spin[k].gmat[ioff[i]+j] +=
228
gtmp[ioff[i+joff]+j+joff]
229
+gtmpo2[ioff[i+joff]+j+joff];
233
for(j=0; j <= i ; j++) {
234
scf_info[k].gmat[ioff[i]+j] +=
235
gtmp[ioff[i+joff]+j+joff];
236
scf_info[k].gmato[ioff[i]+j] +=
237
gtmpo[ioff[i+joff]+j+joff];