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

« back to all changes in this revision

Viewing changes to src/lib/libiwl/buf_rd_all.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
/*!
 
2
  \file
 
3
  \ingroup IWL
 
4
*/
 
5
#include <cstdio>
 
6
#include <cmath>
 
7
#include <libciomr/libciomr.h>
 
8
#include "iwl.h"
 
9
#include "iwl.hpp"
 
10
 
 
11
using namespace psi;
 
12
  
 
13
#define MIN0(a,b) (((a)<(b)) ? (a) : (b))
 
14
#define MAX0(a,b) (((a)>(b)) ? (a) : (b))
 
15
#define INDEX(i,j) ((i>j) ? (ioff[(i)]+(j)) : (ioff[(j)]+(i)))
 
16
 
 
17
int IWL::read_all(double *ints, int *ioff_lt, int *ioff_rt, int no_pq_perm,
 
18
    int *ioff, int printflg, FILE *outfile)
 
19
{
 
20
    int lastbuf;
 
21
    Label *lblptr;
 
22
    Value *valptr;
 
23
    int idx, p, q, r, s, pq, rs, pqrs;
 
24
 
 
25
    lblptr = labels_;
 
26
    valptr = values_;
 
27
 
 
28
    lastbuf = lastbuf_;
 
29
 
 
30
    for (idx=4*idx_; idx_ < inbuf_; idx_++) {
 
31
        p = fabs((int) lblptr[idx++]);
 
32
        q = (int) lblptr[idx++];
 
33
        r = (int) lblptr[idx++];
 
34
        s = (int) lblptr[idx++];
 
35
 
 
36
        if(no_pq_perm) { /*! I _think_ this will work */
 
37
            pq = ioff_lt[p] + q;
 
38
            rs = ioff_rt[r] + s;
 
39
        }
 
40
        else {
 
41
            pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
42
            rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
43
        }
 
44
 
 
45
        pqrs = INDEX(pq,rs);
 
46
 
 
47
        ints[pqrs] = (double) valptr[idx_];
 
48
 
 
49
        if (printflg) 
 
50
            fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] [[%3d]] = %20.10f\n",
 
51
            p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
 
52
 
 
53
    } /*! end loop through current buffer */
 
54
 
 
55
    /*! read new PSI buffers */
 
56
    while (!lastbuf) {
 
57
        fetch();
 
58
        lastbuf = lastbuf_;
 
59
 
 
60
        for (idx=4*idx_; idx_ < inbuf_; idx_++) {
 
61
            p = fabs((int) lblptr[idx++]);
 
62
            q = (int) lblptr[idx++];
 
63
            r = (int) lblptr[idx++];
 
64
            s = (int) lblptr[idx++];
 
65
 
 
66
            if(no_pq_perm) { /*! I _think_ this will work */
 
67
                pq = ioff_lt[p] + q;
 
68
                rs = ioff_rt[r] + s;
 
69
            }
 
70
            else {
 
71
                pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
72
                rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
73
            }
 
74
 
 
75
            pqrs = INDEX(pq,rs);
 
76
 
 
77
            ints[pqrs] = (double) valptr[idx_];
 
78
 
 
79
            if (printflg) 
 
80
                fprintf(outfile, "<%d %d %d %d [%d][%d] [[%d]] = %20.10f\n",
 
81
                p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
 
82
 
 
83
        } /*! end loop through current buffer */
 
84
 
 
85
    } /*! end loop over reading buffers */
 
86
 
 
87
    return(0); /*! we must have reached the last buffer at this point */
 
88
}
 
89
 
 
90
int IWL::read_all2(double **ints, int *ioff_lt, int *ioff_rt, int no_pq_perm, 
 
91
    int *ioff, int printflg, FILE *outfile)
 
92
{
 
93
    int lastbuf;
 
94
    Label *lblptr;
 
95
    Value *valptr;
 
96
    int idx, p, q, r, s, pq, rs;
 
97
 
 
98
    lblptr = labels_;
 
99
    valptr = values_;
 
100
 
 
101
    lastbuf = lastbuf_;
 
102
 
 
103
    for (idx=4*idx_; idx_ < inbuf_; idx_++) {
 
104
        p = fabs((int) lblptr[idx++]);
 
105
        q = (int) lblptr[idx++];
 
106
        r = (int) lblptr[idx++];
 
107
        s = (int) lblptr[idx++];
 
108
 
 
109
        if(no_pq_perm) { /*! I _think_ this will work */
 
110
            pq = ioff_lt[p] + q;
 
111
            rs = ioff_rt[r] + s;
 
112
        }
 
113
        else {
 
114
            pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
115
            rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
116
        }
 
117
 
 
118
        ints[pq][rs] = (double) valptr[idx_];
 
119
 
 
120
        if (printflg) 
 
121
            fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] = %20.10f\n",
 
122
            p, q, r, s, pq, rs, ints[pq][rs]) ;
 
123
 
 
124
    } /*! end loop through current buffer */
 
125
 
 
126
     /*! read new PSI buffers */
 
127
    while (!lastbuf) {
 
128
        fetch();
 
129
        lastbuf = lastbuf_;
 
130
 
 
131
        for (idx=4*idx_; idx_ < inbuf_; idx_++) {
 
132
            p = fabs((int) lblptr[idx++]);
 
133
            q = (int) lblptr[idx++];
 
134
            r = (int) lblptr[idx++];
 
135
            s = (int) lblptr[idx++];
 
136
 
 
137
            if(no_pq_perm) { /*! I _think_ this will work */
 
138
                pq = ioff_lt[p] + q;
 
139
                rs = ioff_rt[r] + s;
 
140
            }
 
141
            else {
 
142
                pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
143
                rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
144
            }
 
145
 
 
146
            ints[pq][rs] = (double) valptr[idx_];
 
147
 
 
148
            if (printflg) 
 
149
                fprintf(outfile, "<%d %d %d %d [%d][%d] = %20.10f\n",
 
150
                p, q, r, s, pq, rs, ints[pq][rs]) ;
 
151
 
 
152
        } /*! end loop through current buffer */
 
153
 
 
154
    } /*! end loop over reading buffers */
 
155
 
 
156
    return(0); /*! we must have reached the last buffer at this point */
 
157
}
 
158
 
 
159
extern "C" {
 
160
 
 
161
/*!
 
162
** iwl_buf_rd_all()
 
163
**
 
164
** Read from an Integrals With Labels formatted buffer.
 
165
** The buffer must have been initialized with iwl_buf_init().
 
166
**
 
167
** Arguments:
 
168
**    \param Buf           =  IWL Buffer to read from (already initialized)
 
169
**    \param ints          =  memory buffer to put integrals into
 
170
**    \param ioff_lt       =  ioff array for the left pair of indices (p and q)
 
171
**    \param ioff_rt       =  ioff array for the right pair of indices (r and s)
 
172
**    \param no_pq_perm    =  if 1, do not use p/q or r/s permutational symmetry
 
173
**    \param ioff          =  the ioff array to figure the total index pqrs from
 
174
**                     the pair indices pq and rs
 
175
**    \param printflg      =  if 1, print integrals as they are read
 
176
**    \param outfile       =  pointer to output file for printing
 
177
**
 
178
** Returns: 0 if end of file, otherwise 1
 
179
** \ingroup IWL
 
180
*/
 
181
int iwl_buf_rd_all(struct iwlbuf *Buf, double *ints,
 
182
                   int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff,
 
183
                   int printflg, FILE *outfile)
 
184
{
 
185
  int lastbuf;
 
186
  Label *lblptr;
 
187
  Value *valptr;
 
188
  int idx, p, q, r, s, pq, rs, pqrs;
 
189
  
 
190
  lblptr = Buf->labels;
 
191
  valptr = Buf->values;
 
192
  
 
193
  lastbuf = Buf->lastbuf;
 
194
  
 
195
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
 
196
    p = fabs((int) lblptr[idx++]);
 
197
    q = (int) lblptr[idx++];
 
198
    r = (int) lblptr[idx++];
 
199
    s = (int) lblptr[idx++];
 
200
 
 
201
    if(no_pq_perm) { /*! I _think_ this will work */
 
202
      pq = ioff_lt[p] + q;
 
203
      rs = ioff_rt[r] + s;
 
204
    }
 
205
    else {
 
206
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
207
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
208
    }
 
209
    
 
210
    pqrs = INDEX(pq,rs);
 
211
 
 
212
    ints[pqrs] = (double) valptr[Buf->idx];
 
213
    
 
214
    if (printflg) 
 
215
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] [[%3d]] = %20.10lf\n",
 
216
              p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
 
217
    
 
218
  } /*! end loop through current buffer */
 
219
  
 
220
  /*! read new PSI buffers */
 
221
  while (!lastbuf) {
 
222
    iwl_buf_fetch(Buf);
 
223
    lastbuf = Buf->lastbuf;
 
224
    
 
225
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
 
226
      p = fabs((int) lblptr[idx++]);
 
227
      q = (int) lblptr[idx++];
 
228
      r = (int) lblptr[idx++];
 
229
      s = (int) lblptr[idx++];
 
230
 
 
231
      if(no_pq_perm) { /*! I _think_ this will work */
 
232
        pq = ioff_lt[p] + q;
 
233
        rs = ioff_rt[r] + s;
 
234
      }
 
235
      else {
 
236
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
237
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
238
      }
 
239
      
 
240
      pqrs = INDEX(pq,rs);
 
241
 
 
242
      ints[pqrs] = (double) valptr[Buf->idx];
 
243
      
 
244
      if (printflg) 
 
245
        fprintf(outfile, "<%d %d %d %d [%d][%d] [[%d]] = %20.10lf\n",
 
246
                p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
 
247
      
 
248
    } /*! end loop through current buffer */
 
249
    
 
250
  } /*! end loop over reading buffers */
 
251
  
 
252
  return(0); /*! we must have reached the last buffer at this point */
 
253
}
 
254
 
 
255
/*!
 
256
** IWL_BUF_RD_ALL2(): This routine works exactly like
 
257
** iwl_buf_rd_all(), except that the integral list is not assumed to
 
258
** have bra-ket permutational symmetry.  The list is still required to
 
259
** have permutational symmetry WITHIN bra and ket, however, unless
 
260
** no_pq_perm is set.  This function requires that the input array be
 
261
** (double **) rather than (double *).  This routine is necessary, for
 
262
** example, for reading the alpha-beta two-electron integrals from the
 
263
** UHF transqt code.
 
264
**
 
265
** TDC, 6/01
 
266
** \ingroup IWL
 
267
*/
 
268
 
 
269
int iwl_buf_rd_all2(struct iwlbuf *Buf, double **ints,
 
270
                   int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff,
 
271
                   int printflg, FILE *outfile)
 
272
{
 
273
  int lastbuf;
 
274
  Label *lblptr;
 
275
  Value *valptr;
 
276
  int idx, p, q, r, s, pq, rs;
 
277
  
 
278
  lblptr = Buf->labels;
 
279
  valptr = Buf->values;
 
280
  
 
281
  lastbuf = Buf->lastbuf;
 
282
  
 
283
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
 
284
    p = fabs((int) lblptr[idx++]);
 
285
    q = (int) lblptr[idx++];
 
286
    r = (int) lblptr[idx++];
 
287
    s = (int) lblptr[idx++];
 
288
 
 
289
    if(no_pq_perm) { /*! I _think_ this will work */
 
290
      pq = ioff_lt[p] + q;
 
291
      rs = ioff_rt[r] + s;
 
292
    }
 
293
    else {
 
294
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
295
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
296
    }
 
297
    
 
298
    ints[pq][rs] = (double) valptr[Buf->idx];
 
299
    
 
300
    if (printflg) 
 
301
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] = %20.10lf\n",
 
302
              p, q, r, s, pq, rs, ints[pq][rs]) ;
 
303
    
 
304
  } /*! end loop through current buffer */
 
305
  
 
306
   /*! read new PSI buffers */
 
307
  while (!lastbuf) {
 
308
    iwl_buf_fetch(Buf);
 
309
    lastbuf = Buf->lastbuf;
 
310
    
 
311
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
 
312
      p = fabs((int) lblptr[idx++]);
 
313
      q = (int) lblptr[idx++];
 
314
      r = (int) lblptr[idx++];
 
315
      s = (int) lblptr[idx++];
 
316
 
 
317
      if(no_pq_perm) { /*! I _think_ this will work */
 
318
        pq = ioff_lt[p] + q;
 
319
        rs = ioff_rt[r] + s;
 
320
      }
 
321
      else {
 
322
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
 
323
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
 
324
      }
 
325
      
 
326
      ints[pq][rs] = (double) valptr[Buf->idx];
 
327
      
 
328
      if (printflg) 
 
329
        fprintf(outfile, "<%d %d %d %d [%d][%d] = %20.10lf\n",
 
330
                p, q, r, s, pq, rs, ints[pq][rs]) ;
 
331
      
 
332
    } /*! end loop through current buffer */
 
333
    
 
334
  } /*! end loop over reading buffers */
 
335
  
 
336
  return(0); /*! we must have reached the last buffer at this point */
 
337
}
 
338
 
 
339
} /* extern "C" */
 
 
b'\\ No newline at end of file'