~ubuntu-branches/ubuntu/precise/psicode/precise

« back to all changes in this revision

Viewing changes to src/bin/cscf/formg2.cc

  • 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
/*! \file
 
2
    \ingroup CSCF
 
3
    \brief Enter brief description of file here 
 
4
*/
 
5
/* $Log$
 
6
 * Revision 1.2  2001/06/29 20:39:28  evaleev
 
7
 * Modified cscf to use libpsio to store supermatrix files.
 
8
 *
 
9
/* Revision 1.1.1.1  2000/02/04 22:52:30  evaleev
 
10
/* Started PSI 3 repository
 
11
/*
 
12
/* Revision 1.2  1999/08/17 19:04:15  evaleev
 
13
/* Changed the default symmetric orthogonalization to the canonical
 
14
/* orthogonalization. Now, if near-linear dependencies in the basis are found,
 
15
/* eigenvectors of the overlap matrix with eigenvalues less than 1E-6 will be
 
16
/* left out. This will lead to num_mo != num_so, i.e. SCF eigenvector is no
 
17
/* longer a square matrix. Had to rework some routines in libfile30, and add some.
 
18
/* The progrem prints out a warning if near-linear dependencies are found. TRANSQT
 
19
/* and a whole bunch of other codes has to be fixed to work with such basis sets.
 
20
/*
 
21
/* Revision 1.1.1.1  1999/04/12 16:59:26  evaleev
 
22
/* Added a version of CSCF that can work with CINTS.
 
23
/* -Ed
 
24
 * */
 
25
 
 
26
#define EXTERN
 
27
#include "includes.h"
 
28
#include "common.h"
 
29
 
 
30
namespace psi { namespace cscf {
 
31
 
 
32
static double *gtmp2,*gtmpo2,*ptmp2,*ptmpo2;
 
33
extern int num_bufs_c,num_bufs_o,readflgc,readflgo;
 
34
extern struct c_pkints {
 
35
         int ij;
 
36
         int kl;
 
37
         double pval;
 
38
         } *c_outbuf;
 
39
extern struct o_pkints {
 
40
         int ij;
 
41
         int kl;
 
42
         double pval;
 
43
         double qval;
 
44
         } *o_outbuf;
 
45
 
 
46
extern int lasto,lastc;
 
47
extern int wherec;
 
48
extern int whereo;
 
49
extern int *int_nums_c;
 
50
extern int *int_nums_o;
 
51
 
 
52
void formg_two(int iju, int* optest)
 
53
{
 
54
   register int i,j,k,joff,nn;
 
55
   register int ij,kl;
 
56
   int ilast,num;
 
57
   int tmpsiz;
 
58
   double dotest,tmpval,qtemp;
 
59
   struct o_pkints *o_temp;
 
60
   struct c_pkints *c_temp;
 
61
 
 
62
   tmpsiz=ioff[nbasis];
 
63
 
 
64
   if(gtmp2 == NULL) {
 
65
      gtmp2 = (double *) init_array(tmpsiz);
 
66
      gtmpo2 = (double *) init_array(tmpsiz);
 
67
      ptmp2 = (double *) init_array(tmpsiz);
 
68
      ptmpo2 = (double *) init_array(tmpsiz);
 
69
      }
 
70
   else {
 
71
      //bzero(gtmp2,sizeof(double)*tmpsiz);
 
72
      memset(gtmp2,'\0',sizeof(double)*tmpsiz);
 
73
      //bzero(gtmpo2,sizeof(double)*tmpsiz);
 
74
      memset(gtmpo2,'\0',sizeof(double)*tmpsiz);
 
75
      }
 
76
 
 
77
   for(k=joff=0; k < num_ir ; k++) {
 
78
      if(nn=scf_info[k].num_so) {
 
79
         for(i=0; i < nn ; i++)
 
80
            for(j=0; j <= i ; j++) {
 
81
#if NEW2C
 
82
               ptmp2[ioff[i+joff]+j+joff] = scf_info[k].dpmat[ioff[i]+j];
 
83
               ptmpo2[ioff[i+joff]+j+joff] = scf_info[k].dpmato[ioff[i]+j];
 
84
#else
 
85
               ptmp2[ioff[i+joff]+j+joff] = scf_info[k].pmat[ioff[i]+j];
 
86
               ptmpo2[ioff[i+joff]+j+joff] = scf_info[k].pmato[ioff[i]+j];
 
87
#endif
 
88
               }
 
89
         joff += nn;
 
90
         }
 
91
      }
 
92
 
 
93
   if(!wherec) {
 
94
      /* int_nums_o = (int *) init_array(num_bufs_o+1); */
 
95
      int_nums_o = (int *) init_int_array(num_bufs_o+1);
 
96
      /* int_nums_c = (int *) init_array(num_bufs_c+1); */
 
97
      int_nums_c = (int *) init_int_array(num_bufs_c+1);
 
98
      for(i=1; i < num_bufs_o ; i++) int_nums_o[i]=maxbuf;
 
99
      for(i=1; i < num_bufs_c ; i++) int_nums_c[i]=maxbuf;
 
100
      int_nums_o[num_bufs_o]=lasto;
 
101
      int_nums_c[num_bufs_c]=lastc;
 
102
      whereo=num_bufs_o;
 
103
      wherec=num_bufs_c;
 
104
      }
 
105
 
 
106
   num=int_nums_o[whereo];
 
107
   for (j=0; j < num_bufs_o ; j++) {
 
108
      o_temp = o_outbuf;
 
109
 
 
110
      for (i=num; i ; i--,o_temp++) {
 
111
         ij = (*o_temp).ij;
 
112
         kl = (*o_temp).kl;
 
113
         tmpval = (*o_temp).pval;
 
114
         dotest = (*o_temp).qval;
 
115
 
 
116
         gtmp2[ij] += ptmp2[kl]*tmpval;
 
117
         gtmp2[kl] += ptmp2[ij]*tmpval;
 
118
         if(optest[ij] && optest[kl]) {
 
119
            if (ij < iju) {
 
120
               gtmpo2[ij] += alpha1*ptmpo2[kl]*tmpval;
 
121
               gtmpo2[kl] += alpha1*ptmpo2[ij]*tmpval;
 
122
               }
 
123
            else if (kl < iju) {
 
124
               qtemp = tmpval + alpha2*dotest;
 
125
               gtmpo2[ij] += ptmpo2[kl]*qtemp;
 
126
               gtmpo2[kl] += ptmpo2[ij]*qtemp;
 
127
               }
 
128
            else {
 
129
               gtmpo2[ij] += alpha3*ptmpo2[kl]*tmpval;
 
130
               gtmpo2[kl] += alpha3*ptmpo2[ij]*tmpval;
 
131
               }
 
132
            }
 
133
         }
 
134
   
 
135
      if (readflgo && j < num_bufs_o-1) {
 
136
         if(whereo==num_bufs_o) {
 
137
            PKmat.bufpos = PSIO_ZERO;
 
138
            whereo=0;
 
139
            }
 
140
         whereo++;
 
141
         num=int_nums_o[whereo];
 
142
         psio_read(PKmat.unit, PKmat.key, (char *) o_outbuf, sizeof(struct o_pkints)*num,
 
143
                   PKmat.bufpos, &(PKmat.bufpos));
 
144
         }
 
145
      }
 
146
 
 
147
   num=int_nums_c[wherec];
 
148
   for (j=0; j < num_bufs_c ; j++) {
 
149
      c_temp = c_outbuf;
 
150
 
 
151
      for (i=num; i ; i--,c_temp++) {
 
152
         ij = (*c_temp).ij;
 
153
         kl = (*c_temp).kl;
 
154
         tmpval = (*c_temp).pval;
 
155
 
 
156
         gtmp2[ij] += ptmp2[kl]*tmpval;
 
157
         gtmp2[kl] += ptmp2[ij]*tmpval;
 
158
         if(optest[ij] && optest[kl]) {
 
159
            if (ij < iju) {
 
160
               gtmpo2[ij] += alpha1*ptmpo2[kl]*tmpval;
 
161
               gtmpo2[kl] += alpha1*ptmpo2[ij]*tmpval;
 
162
               }
 
163
            else if (kl < iju) {
 
164
               gtmpo2[ij] += ptmpo2[kl]*tmpval;
 
165
               gtmpo2[kl] += ptmpo2[ij]*tmpval;
 
166
               }
 
167
            else {
 
168
               gtmpo2[ij] += alpha3*ptmpo2[kl]*tmpval;
 
169
               gtmpo2[kl] += alpha3*ptmpo2[ij]*tmpval;
 
170
               }
 
171
            }
 
172
         }
 
173
 
 
174
      if (readflgc && j < num_bufs_c-1) {
 
175
         if(wherec==num_bufs_c) {
 
176
            Pmat.bufpos = PSIO_ZERO;
 
177
            wherec=0;
 
178
            }
 
179
         wherec++;
 
180
         num=int_nums_c[wherec];
 
181
         psio_read(Pmat.unit, Pmat.key, (char *) c_outbuf, sizeof(struct c_pkints)*num,
 
182
                   Pmat.bufpos, &(Pmat.bufpos));
 
183
         }
 
184
      }
 
185
 
 
186
   for(k=joff=0; k < num_ir ; k++) {
 
187
      if(nn=scf_info[k].num_so) {
 
188
         for(i=0; i < nn ; i++)
 
189
            for(j=0; j <= i ; j++) {
 
190
#if NEW2C
 
191
               scf_info[k].gmat[ioff[i]+j] += gtmp2[ioff[i+joff]+j+joff];
 
192
               scf_info[k].gmato[ioff[i]+j] += gtmpo2[ioff[i+joff]+j+joff];
 
193
#else
 
194
               scf_info[k].gmat[ioff[i]+j] = gtmp2[ioff[i+joff]+j+joff];
 
195
               scf_info[k].gmato[ioff[i]+j] = gtmpo2[ioff[i+joff]+j+joff];
 
196
#endif
 
197
               }
 
198
         joff += nn;
 
199
         if(print & 32) {
 
200
            fprintf(outfile,"\n gmat for irrep %s\n",scf_info[k].irrep_label);
 
201
            print_array(scf_info[k].gmat,nn,outfile);
 
202
            fprintf(outfile,"\n gmato for irrep %s\n",scf_info[k].irrep_label);
 
203
            print_array(scf_info[k].gmato,nn,outfile);
 
204
            }
 
205
         }
 
206
      }
 
207
   }
 
208
 
 
209
}} // namespace psi::cscf