~ubuntu-branches/ubuntu/quantal/psicode/quantal

« back to all changes in this revision

Viewing changes to src/lib/libiwl/buf_rd_all.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
 
/*!
2
 
  \file buf_rd_all.c
3
 
  \ingroup (IWL)
4
 
*/
5
 
#include <stdio.h>
6
 
#include <math.h>
7
 
#include <libciomr/libciomr.h>
8
 
#include "iwl.h"
9
 
 
10
 
#define MIN0(a,b) (((a)<(b)) ? (a) : (b))
11
 
#define MAX0(a,b) (((a)>(b)) ? (a) : (b))
12
 
#define INDEX(i,j) ((i>j) ? (ioff[(i)]+(j)) : (ioff[(j)]+(i)))
13
 
 
14
 
 
15
 
/*!
16
 
** iwl_buf_rd_all()
17
 
**
18
 
** Read from an Integrals With Labels formatted buffer.
19
 
** The buffer must have been initialized with iwl_buf_init().
20
 
**
21
 
** Arguments:
22
 
**    \param Buf           =  IWL Buffer to read from (already initialized)
23
 
**    \param ints          =  memory buffer to put integrals into
24
 
**    \param ioff_lt       =  ioff array for the left pair of indices (p and q)
25
 
**    \param ioff_rt       =  ioff array for the right pair of indices (r and s)
26
 
**    \param no_pq_perm    =  if 1, do not use p/q or r/s permutational symmetry
27
 
**    \param ioff          =  the ioff array to figure the total index pqrs from
28
 
**                     the pair indices pq and rs
29
 
**    \param printflg      =  if 1, print integrals as they are read
30
 
**    \param outfile       =  pointer to output file for printing
31
 
**
32
 
** Returns: 0 if end of file, otherwise 1
33
 
** \ingroup (IWL)
34
 
*/
35
 
int iwl_buf_rd_all(struct iwlbuf *Buf, double *ints,
36
 
                   int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff,
37
 
                   int printflg, FILE *outfile)
38
 
{
39
 
  int lastbuf;
40
 
  Label *lblptr;
41
 
  Value *valptr;
42
 
  int idx, p, q, r, s, pq, rs, pqrs;
43
 
  
44
 
  lblptr = Buf->labels;
45
 
  valptr = Buf->values;
46
 
  
47
 
  lastbuf = Buf->lastbuf;
48
 
  
49
 
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
50
 
    p = fabs((int) lblptr[idx++]);
51
 
    q = (int) lblptr[idx++];
52
 
    r = (int) lblptr[idx++];
53
 
    s = (int) lblptr[idx++];
54
 
 
55
 
    if(no_pq_perm) { /*! I _think_ this will work */
56
 
      pq = ioff_lt[p] + q;
57
 
      rs = ioff_rt[r] + s;
58
 
    }
59
 
    else {
60
 
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
61
 
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
62
 
    }
63
 
    
64
 
    pqrs = INDEX(pq,rs);
65
 
 
66
 
    ints[pqrs] = (double) valptr[Buf->idx];
67
 
    
68
 
    if (printflg) 
69
 
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] [[%3d]] = %20.10lf\n",
70
 
              p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
71
 
    
72
 
  } /*! end loop through current buffer */
73
 
  
74
 
  /*! read new PSI buffers */
75
 
  while (!lastbuf) {
76
 
    iwl_buf_fetch(Buf);
77
 
    lastbuf = Buf->lastbuf;
78
 
    
79
 
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
80
 
      p = fabs((int) lblptr[idx++]);
81
 
      q = (int) lblptr[idx++];
82
 
      r = (int) lblptr[idx++];
83
 
      s = (int) lblptr[idx++];
84
 
 
85
 
      if(no_pq_perm) { /*! I _think_ this will work */
86
 
        pq = ioff_lt[p] + q;
87
 
        rs = ioff_rt[r] + s;
88
 
      }
89
 
      else {
90
 
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
91
 
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
92
 
      }
93
 
      
94
 
      pqrs = INDEX(pq,rs);
95
 
 
96
 
      ints[pqrs] = (double) valptr[Buf->idx];
97
 
      
98
 
      if (printflg) 
99
 
        fprintf(outfile, "<%d %d %d %d [%d][%d] [[%d]] = %20.10lf\n",
100
 
                p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
101
 
      
102
 
    } /*! end loop through current buffer */
103
 
    
104
 
  } /*! end loop over reading buffers */
105
 
  
106
 
  return(0); /*! we must have reached the last buffer at this point */
107
 
}
108
 
 
109
 
/*!
110
 
** IWL_BUF_RD_ALL2(): This routine works exactly like
111
 
** iwl_buf_rd_all(), except that the integral list is not assumed to
112
 
** have bra-ket permutational symmetry.  The list is still required to
113
 
** have permutational symmetry WITHIN bra and ket, however, unless
114
 
** no_pq_perm is set.  This function requires that the input array be
115
 
** (double **) rather than (double *).  This routine is necessary, for
116
 
** example, for reading the alpha-beta two-electron integrals from the
117
 
** UHF transqt code.
118
 
**
119
 
** TDC, 6/01
120
 
** \ingroup (IWL)
121
 
*/
122
 
 
123
 
int iwl_buf_rd_all2(struct iwlbuf *Buf, double **ints,
124
 
                   int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff,
125
 
                   int printflg, FILE *outfile)
126
 
{
127
 
  int lastbuf;
128
 
  Label *lblptr;
129
 
  Value *valptr;
130
 
  int idx, p, q, r, s, pq, rs;
131
 
  
132
 
  lblptr = Buf->labels;
133
 
  valptr = Buf->values;
134
 
  
135
 
  lastbuf = Buf->lastbuf;
136
 
  
137
 
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
138
 
    p = fabs((int) lblptr[idx++]);
139
 
    q = (int) lblptr[idx++];
140
 
    r = (int) lblptr[idx++];
141
 
    s = (int) lblptr[idx++];
142
 
 
143
 
    if(no_pq_perm) { /*! I _think_ this will work */
144
 
      pq = ioff_lt[p] + q;
145
 
      rs = ioff_rt[r] + s;
146
 
    }
147
 
    else {
148
 
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
149
 
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
150
 
    }
151
 
    
152
 
    ints[pq][rs] = (double) valptr[Buf->idx];
153
 
    
154
 
    if (printflg) 
155
 
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] = %20.10lf\n",
156
 
              p, q, r, s, pq, rs, ints[pq][rs]) ;
157
 
    
158
 
  } /*! end loop through current buffer */
159
 
  
160
 
   /*! read new PSI buffers */
161
 
  while (!lastbuf) {
162
 
    iwl_buf_fetch(Buf);
163
 
    lastbuf = Buf->lastbuf;
164
 
    
165
 
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
166
 
      p = fabs((int) lblptr[idx++]);
167
 
      q = (int) lblptr[idx++];
168
 
      r = (int) lblptr[idx++];
169
 
      s = (int) lblptr[idx++];
170
 
 
171
 
      if(no_pq_perm) { /*! I _think_ this will work */
172
 
        pq = ioff_lt[p] + q;
173
 
        rs = ioff_rt[r] + s;
174
 
      }
175
 
      else {
176
 
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
177
 
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
178
 
      }
179
 
      
180
 
      ints[pq][rs] = (double) valptr[Buf->idx];
181
 
      
182
 
      if (printflg) 
183
 
        fprintf(outfile, "<%d %d %d %d [%d][%d] = %20.10lf\n",
184
 
                p, q, r, s, pq, rs, ints[pq][rs]) ;
185
 
      
186
 
    } /*! end loop through current buffer */
187
 
    
188
 
  } /*! end loop over reading buffers */
189
 
  
190
 
  return(0); /*! we must have reached the last buffer at this point */
191
 
}
192