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

« back to all changes in this revision

Viewing changes to src/bin/cscf/formgo.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:
1
 
/* $Log$
2
 
 * Revision 1.2  2001/06/29 20:39:29  evaleev
3
 
 * Modified cscf to use libpsio to store supermatrix files.
4
 
 *
5
 
/* Revision 1.1.1.1  2000/02/04 22:52:30  evaleev
6
 
/* Started PSI 3 repository
7
 
/*
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..
10
 
/*
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.
13
 
/*
14
 
/* 1.  Added the capability to do UHF.  All of the features available with the
15
 
/* other refrences have been added for UHF.
16
 
/*
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.
22
 
/*
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.
29
 
/*
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.
38
 
/*
39
 
/* Revision 1.1.1.1  1999/04/12 16:59:26  evaleev
40
 
/* Added a version of CSCF that can work with CINTS.
41
 
/* -Ed
42
 
 * */
43
 
 
44
 
static char *rcsid = "$Id: formgo.c 430 2001-06-29 20:39:29Z evaleev $";
45
 
 
46
 
#define EXTERN
47
 
#include "includes.h"
48
 
#include "common.h"
49
 
 
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 {
53
 
         int ij;
54
 
         int kl;
55
 
         double pval;
56
 
         } *c_outbuf;
57
 
extern struct o_pkints {
58
 
         int ij;
59
 
         int kl;
60
 
         double pval;
61
 
         double qval;
62
 
         } *o_outbuf;
63
 
 
64
 
extern int lasto,lastc;
65
 
int wherec=0;
66
 
int whereo=0;
67
 
int *int_nums_c;
68
 
int *int_nums_o;
69
 
 
70
 
void formg_open()
71
 
{
72
 
   register int i,j,k,joff,nn;
73
 
   register int ij,kl;
74
 
   int ilast,num;
75
 
   int tmpsiz;
76
 
   double dotest,tmpval;
77
 
   struct o_pkints *o_temp;
78
 
   struct c_pkints *c_temp;
79
 
 
80
 
   tmpsiz=ioff[nbasis];
81
 
 
82
 
   if(gtmp == NULL) {
83
 
       gtmp = (double *) init_array(tmpsiz);
84
 
       gtmpo = (double *) init_array(tmpsiz);
85
 
       ptmp = (double *) init_array(tmpsiz);
86
 
       ptmpo = (double *) init_array(tmpsiz);
87
 
       if(uhf){
88
 
           gtmpo2 = (double *) init_array(tmpsiz);
89
 
           ptmpo2 = (double *) init_array(tmpsiz);
90
 
       }
91
 
   }
92
 
   else {
93
 
       bzero(gtmp,sizeof(double)*tmpsiz);
94
 
       bzero(gtmpo,sizeof(double)*tmpsiz);
95
 
       if(uhf)
96
 
           bzero(gtmpo2,sizeof(double)*tmpsiz); 
97
 
   }
98
 
   
99
 
   for(k=joff=0; k < num_ir ; k++) {
100
 
       if(nn=scf_info[k].num_so) {
101
 
           for(i=0; i < nn ; i++) {
102
 
               if(twocon) {
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];
108
 
                   }
109
 
               }
110
 
               else if(uhf){
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];
118
 
                   } 
119
 
               }
120
 
               else {
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];
126
 
                   }
127
 
               }
128
 
           }
129
 
           joff += nn;
130
 
       }
131
 
   }
132
 
 
133
 
   if(!wherec) {
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;
142
 
      whereo=num_bufs_o;
143
 
      wherec=num_bufs_c;
144
 
      }
145
 
 
146
 
   num=int_nums_o[whereo];
147
 
   for (j=0; j < num_bufs_o ; j++) {
148
 
      o_temp = o_outbuf;
149
 
 
150
 
      for (i=num; i ; i--,o_temp++) {
151
 
         ij = (*o_temp).ij;
152
 
         kl = (*o_temp).kl;
153
 
         tmpval = (*o_temp).pval;
154
 
         dotest = (*o_temp).qval;
155
 
         
156
 
         if(uhf){
157
 
             gtmp[ij] += ptmp[kl]*tmpval;
158
 
             gtmpo[ij] += ptmpo[kl]*dotest;
159
 
             gtmpo2[ij] += ptmpo2[kl]*dotest;
160
 
             if(ij!=kl){
161
 
                 gtmp[kl] += ptmp[ij]*tmpval;
162
 
                 gtmpo[kl] += ptmpo[ij]*dotest;
163
 
                 gtmpo2[kl] += ptmpo2[ij]*dotest;
164
 
             }
165
 
         }
166
 
         else{
167
 
             gtmp[ij] += ptmp[kl]*tmpval;
168
 
             gtmp[kl] += ptmp[ij]*tmpval;
169
 
             gtmpo[ij] += ptmpo[kl]*dotest;
170
 
             gtmpo[kl] += ptmpo[ij]*dotest;
171
 
         }
172
 
      }
173
 
   
174
 
      if (readflgo && j < num_bufs_o-1) {
175
 
         if(whereo==num_bufs_o) {
176
 
            PKmat.bufpos = PSIO_ZERO;
177
 
            whereo=0;
178
 
            }
179
 
         whereo++;
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));
183
 
         }
184
 
      }
185
 
 
186
 
   num=int_nums_c[wherec];
187
 
   for (j=0; j < num_bufs_c ; j++) {
188
 
      c_temp = c_outbuf;
189
 
 
190
 
      for (i=num; i ; i--,c_temp++) {
191
 
         ij = (*c_temp).ij;
192
 
         kl = (*c_temp).kl;
193
 
         tmpval = (*c_temp).pval;
194
 
 
195
 
         gtmp[ij] += ptmp[kl]*tmpval;
196
 
         gtmp[kl] += ptmp[ij]*tmpval;
197
 
         }
198
 
   
199
 
      if (readflgc && j < num_bufs_c-1) {
200
 
         if(wherec==num_bufs_c) {
201
 
            Pmat.bufpos = PSIO_ZERO;
202
 
            wherec=0;
203
 
            }
204
 
         wherec++;
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));
208
 
         }
209
 
      }
210
 
 
211
 
   for(k=joff=0; k < num_ir ; k++) {
212
 
      if(nn=scf_info[k].num_so) {
213
 
         for(i=0; i < nn ; i++) {
214
 
            if(twocon) {
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];
220
 
                  }
221
 
               }
222
 
            else if(uhf){
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];
230
 
                   }
231
 
            }
232
 
            else {
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];
238
 
                }
239
 
            }
240
 
         }
241
 
         joff += nn;
242
 
      }
243
 
   }
244
 
}