libiwl: I/O Library for Integrals with Labels

Files
file	buf_close.cc
file	buf_fetch.cc
file	buf_flush.cc
file	buf_init.cc
file	buf_put.cc
file	buf_rd.cc
file	buf_rd_all.cc
file	buf_rd_all_act.cc
file	buf_rd_all_mp2r12a.cc
file	buf_rd_arr.cc
file	buf_toend.cc
file	buf_wrt.cc
file	buf_wrt_all.cc
file	buf_wrt_arr.cc
file	buf_wrt_arr2.cc
file	buf_wrt_arr_SI.cc
file	buf_wrt_arr_SI_nocut.cc
file	buf_wrt_mat.cc
file	buf_wrt_mp2.cc
file	buf_wrt_mp2r12a.cc
file	buf_wrt_val.cc
file	buf_wrt_val_SI.cc
file	lib/libiwl/rdone.cc
file	lib/libiwl/rdtwo.cc
file	sortbuf.cc
file	wrtone.cc
file	wrttwo.cc
Functions
void	iwl_buf_close (struct iwlbuf *Buf, int keep)
void	iwl_buf_fetch (struct iwlbuf *Buf)
void	iwl_buf_flush (struct iwlbuf *Buf, int lastbuf)
void	iwl_buf_init (struct iwlbuf *Buf, int itape, double cutoff, int oldfile, int readflag)
void	iwl_buf_put (struct iwlbuf *Buf)
int	iwl_buf_rd (struct iwlbuf *Buf, int target_pq, double *ints, int *ioff_lt, int *ioff_rt, int mp2, int printflg, FILE *outfile)
int	iwl_buf_rd_all (struct iwlbuf *Buf, double *ints, int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff, int printflg, FILE *outfile)
int	iwl_buf_rd_all2 (struct iwlbuf *Buf, double **ints, int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff, int printflg, FILE *outfile)
int	iwl_buf_rd_all_act (struct iwlbuf *Buf, double *ints, int *ioff_lt, int *ioff_rt, int no_pq_perm, int *ioff, int fstact, int lstact, int printflg, FILE *outfile)
int	iwl_buf_rd_all_mp2r12a (struct iwlbuf *Buf, double *ints, int *ioff_lt, int *ioff_rt, int bra_ket_symm, int *ioff, int printflg, FILE *outfile)
int	iwl_buf_rd_arr (struct iwlbuf *Buf, int target_pq, double *ints, int *rlist, int *slist, int *size, int *ioff, int printflg, FILE *outfile)
void	iwl_buf_toend (struct iwlbuf *Buf)
void	iwl_buf_wrt (struct iwlbuf *Buf, int p, int q, int pq, int pqsym, double *arr, int rmax, int *active, int *ioff, int *orbsym, int *firsti, int *lasti, int sortby_rs, int printflag, FILE *outfile)
void	iwl_buf_wrt_all (struct iwlbuf *Buf, int nbfso, double *ints, int *ioff, int printflg, FILE *outfile)
void	iwl_buf_wrt_arr (struct iwlbuf *Buf, double *arr, int *p, int *q, int *r, int *s, long int size)
void	iwl_buf_wrt_arr2 (struct iwlbuf *Buf, double *arr, int p, int q, int *rlist, int *slist, int size, int printflag, FILE *outfile)
void	iwl_buf_wrt_arr_SI (struct iwlbuf *Buf, double *arr, short int *p, short int *q, short int *r, short int *s, int size)
void	iwl_buf_wrt_arr_SI_nocut (struct iwlbuf *Buf, double *arr, short int *p, short int *q, short int *r, short int *s, int size)
void	iwl_buf_wrt_mat (struct iwlbuf *Buf, int ptr, int qtr, double **mat, int rfirst, int rlast, int sfirst, int slast, int *reorder, int reorder_offset, int printflag, int *ioff, FILE *outfile)
void	iwl_buf_wrt_mat2 (struct iwlbuf *Buf, int ptr, int qtr, double **mat, int rfirst, int rlast, int sfirst, int slast, int *reorder, int reorder_offset, int printflag, int *ioff, FILE *outfile)
void	iwl_buf_wrt_mp2 (struct iwlbuf *Buf, int p, int q, int pq, int pqsym, double **arr, int rsym, int *firstr, int *lastr, int *firsts, int *lasts, int *occ, int *vir, int *ioff, int printflag, FILE *outfile)
void	iwl_buf_wrt_mp2r12a (struct iwlbuf *Buf, int p, int q, int pq, int pqsym, double **arr, int rsym, int *firstr, int *lastr, int *firsts, int *lasts, int *occ, int bra_ket_symm, int *ioff, int printflag, FILE *outfile)
void	iwl_buf_wrt_val (struct iwlbuf *Buf, int p, int q, int r, int s, double value, int printflag, FILE *outfile, int dirac)
void	iwl_buf_wrt_val_SI (struct iwlbuf *Buf, short int p, short int q, short int r, short int s, double value, int printflag, FILE *outfile, int dirac)
int	iwl_rdone (int itap, char *label, double *ints, int ntri, int erase, int printflg, FILE *outfile)
void	iwl_rdtwo (int itap, double *ints, int *ioff, int norbs, int nfzc, int nfzv, int printflg, FILE *outfile)
void	sortbuf (struct iwlbuf *Inbuf, struct iwlbuf *Outbuf, double *ints, int fpq, int lpq, int *ioff, int *ioff2, int nbfso, int elbert, int intermediate, int no_pq_perm, int qdim, int add, int printflg, FILE *outfile)
void	iwl_wrtone (int itap, char *label, int ntri, double *onel_ints)
void	iwl_wrttwo (int itap, int nbfso, double *ints, int *ioff, double toler, int printflg, FILE *outfile)

---

Detailed Description

---

Function Documentation

void iwl_buf_close	(	struct iwlbuf *	Buf,
		int	keep
	)

IWL_BUF_CLOSE()

Parameters:

	Buf	Buffer to be closed
	keep	Do not delete if keep==1

Close a Integrals With Labels Buffer

Definition at line 23 of file buf_close.cc.

Referenced by iwl_buf_toend(), iwl_rdtwo(), iwl_wrttwo(), main(), and psi::psimrcc::CCTransform::read_tei_mo_integrals_block().

{

   psio_close(Buf->itap, keep ? 1 : 0);
   free(Buf->labels);
   free(Buf->values);
}

void iwl_buf_fetch

(

struct iwlbuf *

Buf

)

iwl_buf_fetch()

Fetch an IWL buffer from disk David Sherrill, 26 June 1996

Definition at line 18 of file buf_fetch.cc.

References psio_read().

Referenced by iwl_buf_init(), iwl_buf_rd(), iwl_buf_rd_all(), iwl_buf_rd_all2(), iwl_buf_rd_all_act(), iwl_buf_rd_arr(), iwl_buf_rd_arr2(), psi::psimrcc::CCTransform::read_tei_mo_integrals_block(), and sortbuf().

{
  psio_read(Buf->itap, IWL_KEY_BUF, (char *) &(Buf->lastbuf), sizeof(int),
            Buf->bufpos, &Buf->bufpos);
  psio_read(Buf->itap, IWL_KEY_BUF, (char *) &(Buf->inbuf), sizeof(int),
            Buf->bufpos, &Buf->bufpos);
  psio_read(Buf->itap, IWL_KEY_BUF, (char *) Buf->labels, Buf->ints_per_buf * 
            4 * sizeof(Label), Buf->bufpos, &Buf->bufpos);
  psio_read(Buf->itap, IWL_KEY_BUF, (char *) Buf->values, Buf->ints_per_buf *
            sizeof(Value), Buf->bufpos, &Buf->bufpos);
  Buf->idx = 0;
}

void iwl_buf_flush	(	struct iwlbuf *	Buf,
		int	lastbuf
	)

iwl_buf_flush()

Parameters:

	Buf	To be flushed buffer
	lastbuf	Flag for the last buffer

Flush an Integrals With Labels Buffer All flushing should be done through this routine! David Sherrill, March 1995

Definition at line 22 of file buf_flush.cc.

References iwl_buf_put().

Referenced by iwl_wrttwo(), and main().

{
  int idx;
  Label *lblptr;
  Value *valptr;
  
  Buf->inbuf = Buf->idx;
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  idx = 4 * Buf->idx;

  while (Buf->idx < Buf->ints_per_buf) {
    lblptr[idx++] = 0;
    lblptr[idx++] = 0;
    lblptr[idx++] = 0;
    lblptr[idx++] = 0;
    valptr[Buf->idx] = 0.0;
    Buf->idx++;
  }
  
  if (lastbuf) Buf->lastbuf = 1;
  else Buf->lastbuf = 0;

  iwl_buf_put(Buf);
  Buf->idx = 0;
}

void iwl_buf_init	(	struct iwlbuf *	Buf,
		int	itape,
		double	cutoff,
		int	oldfile,
		int	readflag
	)

iwl_buf_init()

Parameters:

	Buf	Buffer to be initialised
	itape	Filenumber
	cutoff	Cutoff for keeping integral
	oldfile	If ==0 create file
	readflag	If ==1 fetch buffer

Prepare a PSI Buffer according to the Integrals With Labels format for reading or writing. Important to set readflag=1 if opening for reading, since other IWL buffer read routines anticipate that there is already data in the buffer.

David Sherrill, March 1995 Revised 6/26/96 by CDS for new format

set up buffer info

make room in the buffer

open the output file

Note that we assume that if oldfile isn't set, we O_CREAT the file

go ahead and read a buffer

Definition at line 32 of file buf_init.cc.

References iwl_buf_fetch(), psio_open(), psio_tocscan(), and PSIO_ZERO.

Referenced by iwl_rdtwo(), iwl_wrttwo(), main(), and psi::psimrcc::CCTransform::read_tei_mo_integrals_block().

{

  Buf->itap = itape;
  Buf->bufpos = PSIO_ZERO;
  Buf->ints_per_buf = IWL_INTS_PER_BUF;
  Buf->cutoff = cutoff;
  Buf->bufszc = 2 * sizeof(int) + Buf->ints_per_buf * 4 * sizeof(Label) +
    Buf->ints_per_buf * sizeof(Value);
  Buf->lastbuf = 0;
  Buf->inbuf = 0;
  Buf->idx = 0;

  Buf->labels = (Label *) malloc (4 * Buf->ints_per_buf * sizeof(Label));
  Buf->values = (Value *) malloc (Buf->ints_per_buf * sizeof(Value));

  psio_open(Buf->itap, oldfile ? PSIO_OPEN_OLD : PSIO_OPEN_NEW);
  if (oldfile && (psio_tocscan(Buf->itap, IWL_KEY_BUF) == NULL)) {
    fprintf(outfile,"iwl_buf_init: Can't open file %d\n", Buf->itap);
    psio_close(Buf->itap,0);
    return;
  } 

  if (readflag) iwl_buf_fetch(Buf);
  
}

void iwl_buf_put

(

struct iwlbuf *

Buf

)

iwl_buf_put(struct iwlbuf *Buf)

Put an IWL buffer to disk David Sherrill, 26 June 1996

Definition at line 18 of file buf_put.cc.

References psio_write().

Referenced by iwl_buf_flush(), iwl_buf_wrt(), iwl_buf_wrt_all(), iwl_buf_wrt_arr(), iwl_buf_wrt_arr2(), iwl_buf_wrt_arr_SI(), iwl_buf_wrt_arr_SI_nocut(), iwl_buf_wrt_mat(), iwl_buf_wrt_mat2(), iwl_buf_wrt_mp2(), iwl_buf_wrt_mp2r12a(), iwl_buf_wrt_val(), iwl_buf_wrt_val_SI(), and sortbuf().

{
  psio_write(Buf->itap, IWL_KEY_BUF, (char *) &(Buf->lastbuf), sizeof(int),
             Buf->bufpos, &(Buf->bufpos));
  psio_write(Buf->itap, IWL_KEY_BUF, (char *) &(Buf->inbuf), sizeof(int),
             Buf->bufpos, &(Buf->bufpos));
  psio_write(Buf->itap, IWL_KEY_BUF, (char *) Buf->labels, Buf->ints_per_buf * 
             4 * sizeof(Label), Buf->bufpos, &(Buf->bufpos));
  psio_write(Buf->itap, IWL_KEY_BUF, (char *) Buf->values, Buf->ints_per_buf *
             sizeof(Value), Buf->bufpos, &(Buf->bufpos));
}

int iwl_buf_rd	(	struct iwlbuf *	Buf,
		int	target_pq,
		double *	ints,
		int *	ioff_lt,
		int *	ioff_rt,
		int	mp2,
		int	printflg,
		FILE *	outfile
	)

iwl_buf_rd(struct iwlbuf *Buf, int target_pq, double *ints, int *ioff_lt, int *ioff_rt, int mp2, int printflg, FILE *outfile)

Read from an Integrals With Labels formatted PSI buffer. The buffer must have been initialized with iwl_buf_init(). David Sherrill, March 1995

Returns: 0 if end of file, otherwise 1

Altered such that if the current pq value does not equal the target_pq then routine returns. This may be dangerous in that if you don't know the order of pq's in the iwl_buf, you may skip integrals! -Daniel, November 9, 1995

Revised 6/26/96 by CDS for new format

I _think_ this will work

if (pq < target_pq) continue;

end loop through current buffer

read new buffers

I _think_ this will work

end loop through current buffer

end loop over reading buffers

we must have reached the last buffer at this point

Definition at line 35 of file buf_rd.cc.

References iwl_buf_fetch().

{
  int lastbuf;
  Value *valptr;
  Label *lblptr;
  int idx, p, q, r, s, pq, rs;
  
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  lastbuf = Buf->lastbuf;
  
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
    p = (int) lblptr[idx++];
    q = (int) lblptr[idx++];
    r = (int) lblptr[idx++];
    s = (int) lblptr[idx++];
    
    if(mp2) { 
      pq = ioff_lt[p] + q;
      rs = ioff_rt[r] + s;
    }
    else {
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
    }
    
    if (pq != target_pq) return(1);
    
    ints[rs] = (double) valptr[Buf->idx];
    
    if (printflg) 
      fprintf(outfile, "<%d %d %d %d [%d][%d] = %20.10lf\n",
              p, q, r, s, pq, rs, ints[rs]) ;
    
  } 
  while (!lastbuf) {
    iwl_buf_fetch(Buf);
    lastbuf = Buf->lastbuf;
    
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
      p = (int) lblptr[idx++];
      q = (int) lblptr[idx++];
      r = (int) lblptr[idx++];
      s = (int) lblptr[idx++];
      
      if(mp2) { 
        pq = ioff_lt[p] + q;
        rs = ioff_rt[r] + s;
      }
      else {
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
      }
      
      if (pq < target_pq) continue;
      if (pq > target_pq) return(1);
      
      ints[rs] = (double) valptr[Buf->idx];
      
      if (printflg) 
        fprintf(outfile, "<%d %d %d %d [%d][%d] = %20.10lf\n",
                p, q, r, s, pq, rs, ints[rs]) ;
      
    } 
  } 
  return(0); 
}

int iwl_buf_rd_all	(	struct iwlbuf *	Buf,
		double *	ints,
		int *	ioff_lt,
		int *	ioff_rt,
		int	no_pq_perm,
		int *	ioff,
		int	printflg,
		FILE *	outfile
	)

iwl_buf_rd_all()

Read from an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init().

Arguments:

Parameters:

	Buf	= IWL Buffer to read from (already initialized)
	ints	= memory buffer to put integrals into
	ioff_lt	= ioff array for the left pair of indices (p and q)
	ioff_rt	= ioff array for the right pair of indices (r and s)
	no_pq_perm	= if 1, do not use p/q or r/s permutational symmetry
	ioff	= the ioff array to figure the total index pqrs from the pair indices pq and rs
	printflg	= if 1, print integrals as they are read
	outfile	= pointer to output file for printing

Returns: 0 if end of file, otherwise 1

I _think_ this will work

end loop through current buffer

read new PSI buffers

I _think_ this will work

end loop through current buffer

end loop over reading buffers

we must have reached the last buffer at this point

Definition at line 36 of file buf_rd_all.cc.

References iwl_buf_fetch().

Referenced by iwl_rdtwo().

{
  int lastbuf;
  Label *lblptr;
  Value *valptr;
  int idx, p, q, r, s, pq, rs, pqrs;
  
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  lastbuf = Buf->lastbuf;
  
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
    p = fabs((int) lblptr[idx++]);
    q = (int) lblptr[idx++];
    r = (int) lblptr[idx++];
    s = (int) lblptr[idx++];

    if(no_pq_perm) { 
      pq = ioff_lt[p] + q;
      rs = ioff_rt[r] + s;
    }
    else {
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
    }
    
    pqrs = INDEX(pq,rs);

    ints[pqrs] = (double) valptr[Buf->idx];
    
    if (printflg) 
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] [[%3d]] = %20.10lf\n",
              p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
    
  } 
  while (!lastbuf) {
    iwl_buf_fetch(Buf);
    lastbuf = Buf->lastbuf;
    
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
      p = fabs((int) lblptr[idx++]);
      q = (int) lblptr[idx++];
      r = (int) lblptr[idx++];
      s = (int) lblptr[idx++];

      if(no_pq_perm) { 
        pq = ioff_lt[p] + q;
        rs = ioff_rt[r] + s;
      }
      else {
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
      }
      
      pqrs = INDEX(pq,rs);

      ints[pqrs] = (double) valptr[Buf->idx];
      
      if (printflg) 
        fprintf(outfile, "<%d %d %d %d [%d][%d] [[%d]] = %20.10lf\n",
                p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
      
    } 
  } 
  return(0); 
}

int iwl_buf_rd_all2	(	struct iwlbuf *	Buf,
		double **	ints,
		int *	ioff_lt,
		int *	ioff_rt,
		int	no_pq_perm,
		int *	ioff,
		int	printflg,
		FILE *	outfile
	)

IWL_BUF_RD_ALL2(): This routine works exactly like iwl_buf_rd_all(), except that the integral list is not assumed to have bra-ket permutational symmetry. The list is still required to have permutational symmetry WITHIN bra and ket, however, unless no_pq_perm is set. This function requires that the input array be (double **) rather than (double *). This routine is necessary, for example, for reading the alpha-beta two-electron integrals from the UHF transqt code.

TDC, 6/01

I _think_ this will work

end loop through current buffer

read new PSI buffers

I _think_ this will work

end loop through current buffer

end loop over reading buffers

we must have reached the last buffer at this point

Definition at line 124 of file buf_rd_all.cc.

References iwl_buf_fetch().

{
  int lastbuf;
  Label *lblptr;
  Value *valptr;
  int idx, p, q, r, s, pq, rs;
  
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  lastbuf = Buf->lastbuf;
  
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
    p = fabs((int) lblptr[idx++]);
    q = (int) lblptr[idx++];
    r = (int) lblptr[idx++];
    s = (int) lblptr[idx++];

    if(no_pq_perm) { 
      pq = ioff_lt[p] + q;
      rs = ioff_rt[r] + s;
    }
    else {
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
    }
    
    ints[pq][rs] = (double) valptr[Buf->idx];
    
    if (printflg) 
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] = %20.10lf\n",
              p, q, r, s, pq, rs, ints[pq][rs]) ;
    
  } 
  while (!lastbuf) {
    iwl_buf_fetch(Buf);
    lastbuf = Buf->lastbuf;
    
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
      p = fabs((int) lblptr[idx++]);
      q = (int) lblptr[idx++];
      r = (int) lblptr[idx++];
      s = (int) lblptr[idx++];

      if(no_pq_perm) { 
        pq = ioff_lt[p] + q;
        rs = ioff_rt[r] + s;
      }
      else {
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
      }
      
      ints[pq][rs] = (double) valptr[Buf->idx];
      
      if (printflg) 
        fprintf(outfile, "<%d %d %d %d [%d][%d] = %20.10lf\n",
                p, q, r, s, pq, rs, ints[pq][rs]) ;
      
    } 
  } 
  return(0); 
}

int iwl_buf_rd_all_act	(	struct iwlbuf *	Buf,
		double *	ints,
		int *	ioff_lt,
		int *	ioff_rt,
		int	no_pq_perm,
		int *	ioff,
		int	fstact,
		int	lstact,
		int	printflg,
		FILE *	outfile
	)

iwl_buf_rd_all_act()

Read from an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init(). Same as function iwl_buf_rd_all() except that we only keep the integrals with all-active labels.

Parameters:

	Buf	= IWL Buffer to read from (already initialized)
	ints	= memory buffer to put integrals into
	ioff_lt	= ioff array for the left pair of indices (p and q)
	ioff_rt	= ioff array for the right pair of indices (r and s)
	no_pq_perm	= if 1, do not use p/q or r/s permutational symmetry
	ioff	= the ioff array to figure the total index pqrs from the pair indices pq and rs
	fstact	= index of first active orbital
	lstact	= index of last active orbital
	printflg	= if 1, print integrals as they are read
	outfile	= pointer to output file for printing

Returns: 0 if end of file, otherwise 1

I _think_ this will work

end loop through current buffer

read new PSI buffers

I _think_ this will work

end loop through current buffer

end loop over reading buffers

we must have reached the last buffer at this point

Definition at line 39 of file buf_rd_all_act.cc.

References iwl_buf_fetch().

Referenced by iwl_rdtwo().

{
  int lastbuf;
  Label *lblptr;
  Value *valptr;
  int idx, p, q, r, s, pq, rs, pqrs;
  
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  lastbuf = Buf->lastbuf;
  
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
    p = (int) lblptr[idx++];
    q = (int) lblptr[idx++];
    r = (int) lblptr[idx++];
    s = (int) lblptr[idx++];

    if (p > lstact || q > lstact || r > lstact || s > lstact) continue;
    if (p < fstact || q < fstact || r < fstact || s < fstact) continue;
    p -= fstact;
    q -= fstact;
    r -= fstact;
    s -= fstact;

    if(no_pq_perm) { 
      pq = ioff_lt[p] + q;
      rs = ioff_rt[r] + s;
    }
    else {
      pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
      rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
    }
    
    pqrs = INDEX(pq,rs);

    ints[pqrs] = (double) valptr[Buf->idx];
    
    if (printflg) 
      fprintf(outfile, "<%2d %2d %2d %2d [%2d][%2d] [[%3d]] = %20.10lf\n",
              p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
    
  } 
  while (!lastbuf) {
    iwl_buf_fetch(Buf);
    lastbuf = Buf->lastbuf;
    
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
      p = (int) lblptr[idx++];
      q = (int) lblptr[idx++];
      r = (int) lblptr[idx++];
      s = (int) lblptr[idx++];

      if (p > lstact || q > lstact || r > lstact || s > lstact) continue;
      if (p < fstact || q < fstact || r < fstact || s < fstact) continue;
      p -= fstact;
      q -= fstact;
      r -= fstact;
      s -= fstact;

      if(no_pq_perm) { 
        pq = ioff_lt[p] + q;
        rs = ioff_rt[r] + s;
      }
      else {
        pq = ioff_lt[MAX0(p,q)] + MIN0(p,q);
        rs = ioff_rt[MAX0(r,s)] + MIN0(r,s);
      }
      
      pqrs = INDEX(pq,rs);

      ints[pqrs] = (double) valptr[Buf->idx];
      
      if (printflg) 
        fprintf(outfile, "<%d %d %d %d [%d][%d] [[%d]] = %20.10lf\n",
                p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
      
    } 
  } 
  return(0); 
}

int iwl_buf_rd_all_mp2r12a	(	struct iwlbuf *	Buf,
		double *	ints,
		int *	ioff_lt,
		int *	ioff_rt,
		int	bra_ket_symm,
		int *	ioff,
		int	printflg,
		FILE *	outfile
	)

iwl_buf_rd_all_mp2r12a()

Read from an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init().

Parameters:

	Buf	= IWL Buffer to read from (already initialized)
	ints	= memory buffer to put integrals into
	ioff_lt	= ioff array for the left pair of indices (p and q)
	ioff_rt	= ioff array for the right pair of indices (r and s)
	bra_ket_symm	= if 1, then these are ERI or R12 integrals, read them in as usual, else these are [r12,T2] integrals - form [T1+T2,r12] out of these.

WARNING - if bra_ket_symm = 0 - ints must be zeroed out!

Parameters:

	ioff	= the ioff array to figure the total index pqrs from the pair indices pq and rs
	printflg	= if 1, print integrals as they are read
	outfile	= pointer to output file for printing

Returns: 0 if end of file, otherwise 1

ERIs or R12-integrals

(ip|[T1+T2,r12]|jq) = -[(ip|[r12,T1]|jq) + (jq|[r12,T2]|ip)]

end loop through current buffer

read new PSI buffers

ERIs or R12-integrals

(ip|[T1+T2,r12]|jq) = -[(ip|[r12,T2]|jq)+(jq|[r12,T2]|ip)]

end loop through current buffer

end loop over reading buffers

we must have reached the last buffer at this point

Definition at line 40 of file buf_rd_all_mp2r12a.cc.

{
  int lastbuf;
  Label *lblptr;
  Value *valptr;
  int idx, p, q, r, s;
  long int pq, rs, pqrs;
  
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  lastbuf = Buf->lastbuf;
  
  for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
    p = (int) lblptr[idx++];
    q = (int) lblptr[idx++];
    r = (int) lblptr[idx++];
    s = (int) lblptr[idx++];

    pq = ioff_lt[p] + q;
    rs = ioff_rt[r] + s;

    pqrs = INDEX(pq,rs);

    if (bra_ket_symm) 
      ints[pqrs] = (double) valptr[Buf->idx];
    else { 
      if (pq != rs)
        ints[pqrs] -= (double) valptr[Buf->idx];
      else
        ints[pqrs] -= (double) 2.0*valptr[Buf->idx];
    }
    
    if (printflg) 
      fprintf(outfile, "<%2d %2d %2d %2d [%2ld][%2ld] [[%3ld]] = %20.10lf\n",
              p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
    
  } 
  while (!lastbuf) {
    iwl_buf_fetch(Buf);
    lastbuf = Buf->lastbuf;
    
    for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
      p = (int) lblptr[idx++];
      q = (int) lblptr[idx++];
      r = (int) lblptr[idx++];
      s = (int) lblptr[idx++];

      pq = ioff_lt[p] + q;
      rs = ioff_rt[r] + s;

      pqrs = INDEX(pq,rs);

      if (bra_ket_symm) 
        ints[pqrs] = (double) valptr[Buf->idx];
      else { 
        if (pq != rs)
          ints[pqrs] -= (double) valptr[Buf->idx];
        else
          ints[pqrs] -= (double) 2.0*valptr[Buf->idx];
      }
      
      if (printflg) 
        fprintf(outfile, "<%d %d %d %d [%ld][%ld] [[%ld]] = %20.10lf\n",
                p, q, r, s, pq, rs, pqrs, ints[pqrs]) ;
      
    } 
  } 
  return(0); 
}

int iwl_buf_rd_arr	(	struct iwlbuf *	Buf,
		int	target_pq,
		double *	ints,
		int *	rlist,
		int *	slist,
		int *	size,
		int *	ioff,
		int	printflg,
		FILE *	outfile
	)

iwl_buf_rd_arr()

Read from an Integrals With Labels formatted PSI buffer. The buffer must have been initialized with iwl_buf_init(). The integrals and their labels are returned in the arrays ints, rlist, and slist, and the size of these arrays is returned in 'size.' David Sherrill, March 1995

Returns: 0 if end of file, otherwise 1

Revised 6/27/96 by CDS for new format

end loop through current buffer

read new buffers

end loop through current buffer

end loop over reading buffers

we must have reached the last buffer at this point

Definition at line 30 of file buf_rd_arr.cc.

References iwl_buf_fetch().

{
   int lastbuf;
   int idx, p, q, r, s, pq;
   double value;
   Value *valptr;
   Label *lblptr;

   lblptr = Buf->labels;
   valptr = Buf->values;

   lastbuf = Buf->lastbuf;
   
   *size = 0;
   
   for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
     p = (int) lblptr[idx++];
     q = (int) lblptr[idx++];
     r = (int) lblptr[idx++];
     s = (int) lblptr[idx++];
     
     pq = INDEX(p,q);
     
     if (pq < target_pq) continue;
     if (pq > target_pq) return(1);
     
     value = (double) valptr[Buf->idx];
     *ints++ = value;
     *rlist++ = r;
     *slist++ = s;
     *size = *size + 1;
     
     if (printflg) 
       fprintf(outfile, "<%d %d %d %d [%d] = %20.10lf\n", p, q, r, s,
               pq, value);
     
   } 
   while (!lastbuf) {
     iwl_buf_fetch(Buf);
     lastbuf = Buf->lastbuf;

     for (idx=4*Buf->idx; Buf->idx<Buf->inbuf; Buf->idx++) {
       p = (int) lblptr[idx++];
       q = (int) lblptr[idx++];
       r = (int) lblptr[idx++];
       s = (int) lblptr[idx++];
       
       pq = INDEX(p,q);
       
       if (pq < target_pq) continue;
       if (pq > target_pq) return(1);

       value = (double) valptr[Buf->idx];
       *ints++ = value;
       *rlist++ = r;
       *slist++ = s;
       *size = *size + 1;
 
       if (printflg) 
         fprintf(outfile, "<%d %d %d %d [%d] = %20.10lf\n", p, q, r, s,
                 pq, value);
       
     } 
   } 
   return(0); 
}

void iwl_buf_toend

(

struct iwlbuf *

Buf

)

iwl_buf_toend()

Set IWL Buffer's pointer to the end. Useful when want to append to an already existing file

Edward Valeev, January 2001

Definition at line 23 of file buf_toend.cc.

References iwl_buf_close(), psio_get_address(), psio_get_length(), psio_tocscan(), and PSIO_ZERO.

{
  psio_tocentry *this_entry;
  ULI entry_length;

  this_entry = psio_tocscan(Buf->itap, IWL_KEY_BUF);
  if (this_entry == NULL) {
    fprintf(outfile,
        "iwl_buf_toend: Can't find IWL buffer entry in file %d\n", Buf->itap);
    iwl_buf_close(Buf,1);
    return;
  } 

  /* set up buffer pointer */
  entry_length = psio_get_length(this_entry->sadd,this_entry->eadd);
  Buf->bufpos = psio_get_address(PSIO_ZERO,entry_length);
  
  return;
}

void iwl_buf_wrt	(	struct iwlbuf *	Buf,
		int	p,
		int	q,
		int	pq,
		int	pqsym,
		double *	arr,
		int	rmax,
		int *	active,
		int *	ioff,
		int *	orbsym,
		int *	firsti,
		int *	lasti,
		int	sortby_rs,
		int	printflag,
		FILE *	outfile
	)

iwl_buf_wrt()

Write to an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init(). Don't forget to call iwl_buf_flush() when finished with all writes to the buffer to ensure that all contents are written to disk. David Sherrill, March 1995

Revised 6/27/96 by CDS for new format

Definition at line 24 of file buf_wrt.cc.

References iwl_buf_put().

{
  int r, s, rs, rsym, ssym, smax, idx;
  double value;
  Label *lblptr;
  Value *valptr;
  
  lblptr = Buf->labels;
  valptr = Buf->values;
  
  for (r=0; r<rmax; r++) {
    rsym = orbsym[r];
    ssym = pqsym ^ rsym;
    smax = (rsym == ssym) ? r : lasti[ssym];
    
    for (s=firsti[ssym]; s<=smax; s++) {
      rs = ioff[r] + s;
      value = arr[rs];
      
      if (fabs(value) > Buf->cutoff) {
        idx = 4 * Buf->idx;
        lblptr[idx] = (Label) p;
        lblptr[idx+1] = (Label) q;
        lblptr[idx+2] = (Label) r;
        lblptr[idx+3] = (Label) s;
        valptr[Buf->idx] = (Value) value;
         
        Buf->idx++;
        
        if (Buf->idx == Buf->ints_per_buf) {
          Buf->inbuf = Buf->idx;
          Buf->lastbuf = 0;
          iwl_buf_put(Buf);
          Buf->idx = 0;
        }
        
        if(printflag)
          fprintf(outfile, "<%d %d %d %d [%d] [%d] = %20.10lf\n",
                  p, q, r, s, pq, rs, value);
         
      } /* end if (fabs(value) > Buf->cutoff) ... */
    } /* end loop over s */
  } /* end loop over r */
  
}

void iwl_buf_wrt_all	(	struct iwlbuf *	Buf,
		int	nbfso,
		double *	ints,
		int *	ioff,
		int	printflg,
		FILE *	outfile
	)

iwl_buf_wrt_all()

Write out two electron ints to IWL file. Assume that the integrals are in ijkl canonical order (no spatial symmetry).

Parameters:

	itap	= unit to write to
	nbfso	= number of basis functions in symmetry orbitals
	ints	= two electron integrals
	ioff	= the old ioff array for lexical ordering
	printflg	= print flag (1 or 0)
	outfile	= output file

David Sherrill, 6/27/96

NB: This routine will only write "standard" (pq|rs) indices to disk. The cints integral program marks certain integrals with negative index values to indicate the end of PK-matrix blocks. This marking is used by the cscf code (only?). Therefore, is this routine is used to write integrals to disk, the SCF code will most likely give incorrect data if it uses the resulting integrals. TDC 12/24/01

Definition at line 36 of file buf_wrt_all.cc.

References iwl_buf_put().

Referenced by iwl_wrttwo().

{
  int idx, p, q, r, s, smax, pq, rs, pqrs;
  Label *lblptr;
  Value *valptr;

  lblptr = Buf->labels;
  valptr = Buf->values;
  
  /* go through the lexical order and print to the output file */
  for (p=0; p<nbfso; p++) {
    for (q=0; q<=p; q++) {
      pq = ioff[p] + q;
      for (r=0; r<=p; r++) {
        smax = (p==r) ? (q+1) : (r+1);
        for (s=0; s < smax; s++) {
          rs = ioff[r] + s;
          pqrs = ioff[pq] + rs;
          if (fabs(ints[pqrs]) > Buf->cutoff) {
            idx = 4 * Buf->idx;
            lblptr[idx++] = (Label) p;
            lblptr[idx++] = (Label) q;
            lblptr[idx++] = (Label) r;
            lblptr[idx++] = (Label) s;
            valptr[Buf->idx] = (Value) ints[pqrs];
            Buf->idx++;
            if (printflg) fprintf(outfile, "%d %d %d %d [%d] = %10.6lf\n",
                                  p, q, r, s, pqrs, ints[pqrs]) ;
            
            if (Buf->idx == Buf->ints_per_buf) {
              Buf->lastbuf = 0;
              Buf->inbuf = Buf->idx;
              iwl_buf_put(Buf);
              Buf->idx = 0;
            } 
          }
        }
      }
    }
  }
}

void iwl_buf_wrt_arr	(	struct iwlbuf *	Buf,
		double *	arr,
		int *	p,
		int *	q,
		int *	r,
		int *	s,
		long int	size
	)

IWL_BUF_WRT_ARR()

This function writes out an array of two-electron integrals using the Integrals With Labels file format. David Sherrill, March 1995

Revised 6/27/96 by CDS for new format

Definition at line 22 of file buf_wrt_arr.cc.

References iwl_buf_put().

{

  long int i;
  int idx;
  double value;
  Label *lblptr;
  Value *valptr;

  if (size < 0) {
    printf("(iwl_buf_wrt_arr): Called with size = %ld\n", size);
    return;
  }

  if (Buf == NULL || arr == NULL || p == NULL || q == NULL || r == NULL 
      || s == NULL) {
    printf("(iwl_buf_wrt_arr): Called with null pointer argument\n");
    return;
  }
  
  lblptr = Buf->labels;
  valptr = Buf->values;

  for (i=0; i<size; i++) {
    value = *arr++;

    if (fabs(value) > Buf->cutoff) {
      idx = 4 * Buf->idx;
      lblptr[idx++] = (Label) p[i];
      lblptr[idx++] = (Label) q[i];
      lblptr[idx++] = (Label) r[i];
      lblptr[idx++] = (Label) s[i];
      valptr[Buf->idx] = (Value) value;
      
      Buf->idx++;

      if (Buf->idx == Buf->ints_per_buf) {
        Buf->lastbuf = 0;
        Buf->inbuf = Buf->idx;
        iwl_buf_put(Buf);
        Buf->idx = 0;
      }
      
    } /* end if cutoff */
  } /* end loop over i */
  
}

void iwl_buf_wrt_arr2	(	struct iwlbuf *	Buf,
		double *	arr,
		int	p,
		int	q,
		int *	rlist,
		int *	slist,
		int	size,
		int	printflag,
		FILE *	outfile
	)

IWL_BUF_WRT_ARR2()

This function writes out an array of two-electron integrals using the Integrals With Labels file format. All integrals in the input arr have common indices p and q. r and s indices are given in the lists plist and qlist. David Sherrill, March 1995

Revised 6/27/96 by CDS for new format

Definition at line 24 of file buf_wrt_arr2.cc.

References iwl_buf_put().

{
  int i,idx;
  double value;
  Label *lblptr;
  Value *valptr;

  if (size < 0) {
    printf("(iwl_buf_wrt_arr2): Called with size = %d\n",
           size);
    return;
  }
  
  if (Buf == NULL || arr == NULL || rlist == NULL || slist == NULL) {
    printf("(iwl_buf_wrt_arr2): Called with null pointer argument\n");
    return;
  }
  
  lblptr = Buf->labels;
  valptr = Buf->values;

  for (i=0; i<size; i++) {
    value = *arr++;
    if (fabs(value) > Buf->cutoff) {
      idx = 4 * Buf->idx;
      lblptr[idx++] = (Label) p;
      lblptr[idx++] = (Label) q;
      lblptr[idx++] = (Label) rlist[i];
      lblptr[idx++] = (Label) slist[i];
      valptr[Buf->idx] = (Value) value;
   
      if(printflag) 
        fprintf(outfile, "%d %d %d %d %20.10f\n", p, q, 
                rlist[i], slist[i], value);
      
      Buf->idx++;
      
      if (Buf->idx == Buf->ints_per_buf) {
        Buf->lastbuf = 0;
        Buf->inbuf = Buf->idx;
        iwl_buf_put(Buf);
        Buf->idx = 0;
      }
      
    } /* end if (fabs(value) > Buf->cutoff) ... */             
  } /* end loop over i */

}

void iwl_buf_wrt_arr_SI	(	struct iwlbuf *	Buf,
		double *	arr,
		short int *	p,
		short int *	q,
		short int *	r,
		short int *	s,
		int	size
	)

IWL_BUF_WRT_ARR_SI()

This function writes out an array of two-electron integrals using the Integrals With Labels file format with indices stored in arrays of short int's Ed Valeev, February 1999

Definition at line 21 of file buf_wrt_arr_SI.cc.

References iwl_buf_put().

{

  int i,idx;
  double value;
  Label *lblptr;
  Value *valptr;

  if (size < 0) {
    printf("(iwl_buf_wrt_arr_SI): Called with size = %d\n",
           size);
    return;
  }
  
  if (Buf == NULL || arr == NULL || p == NULL || q == NULL || r == NULL 
      || s == NULL) {
    printf("(iwl_buf_wrt_arr_SI): Called with null pointer argument\n");
    return;
  }
  
  lblptr = Buf->labels;
  valptr = Buf->values;

  for (i=0; i<size; i++) {
    value = *arr++;
    if (fabs(value) > Buf->cutoff) {
      idx = 4 * Buf->idx;
      lblptr[idx++] = (Label) p[i];
      lblptr[idx++] = (Label) q[i];
      lblptr[idx++] = (Label) r[i];
      lblptr[idx++] = (Label) s[i];
      valptr[Buf->idx] = (Value) value;
      
      Buf->idx++;

      if (Buf->idx == Buf->ints_per_buf) {
        Buf->lastbuf = 0;
        Buf->inbuf = Buf->idx;
        iwl_buf_put(Buf);
        Buf->idx = 0;
      }
      
    } /* end if cutoff */
  } /* end loop over i */
  
}

void iwl_buf_wrt_arr_SI_nocut	(	struct iwlbuf *	Buf,
		double *	arr,
		short int *	p,
		short int *	q,
		short int *	r,
		short int *	s,
		int	size
	)

IWL_BUF_WRT_ARR_SI_nocut()

This function writes out an array of two-electron integrals using the Integrals With Labels file format with indices stored in arrays of short int's. It DOES NOT use Buf->Cutoff when writing. Ed Valeev, February 1999

Definition at line 22 of file buf_wrt_arr_SI_nocut.cc.

References iwl_buf_put().

{

  int i,idx;
  double value;
  Label *lblptr;
  Value *valptr;

  if (size < 0) {
    printf("(iwl_buf_wrt_arr_SI_nocut): Called with size = %d\n",
           size);
    return;
  }
  
  if (Buf == NULL || arr == NULL || p == NULL || q == NULL || r == NULL 
      || s == NULL) {
    printf("(iwl_buf_wrt_arr_SI_nocut): Called with null pointer argument\n");
    return;
  }
  
  lblptr = Buf->labels;
  valptr = Buf->values;

  for (i=0; i<size; i++) {
    value = *arr++;
    idx = 4 * Buf->idx;
    lblptr[idx++] = (Label) p[i];
    lblptr[idx++] = (Label) q[i];
    lblptr[idx++] = (Label) r[i];
    lblptr[idx++] = (Label) s[i];
    valptr[Buf->idx] = (Value) value;
      
    Buf->idx++;

    if (Buf->idx == Buf->ints_per_buf) {
      Buf->lastbuf = 0;
      Buf->inbuf = Buf->idx;
      iwl_buf_put(Buf);
      Buf->idx = 0;
    }
  } /* end loop over i */
  
}

void iwl_buf_wrt_mat	(	struct iwlbuf *	Buf,
		int	ptr,
		int	qtr,
		double **	mat,
		int	rfirst,
		int	rlast,
		int	sfirst,
		int	slast,
		int *	reorder,
		int	reorder_offset,
		int	printflag,
		int *	ioff,
		FILE *	outfile
	)

iwl_buf_wrt_mat()

Write to an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init(). Don't forget to call iwl_buf_flush() when finished with all writes to the buffer to ensure that all contents are written to disk.

This version takes as input a matrix, as might be handy for a matrix formulation of an integral transformation. It assumes that all rs are available for a given pq. r and s are allowed to range from rfirst/sfirst to rlast/slast (with s<=r), and this maps to a matrix addressing of 0 to (rlast-rfirst) and 0 to (slast-sfirst).

This routine is also compatible with a reordering of the orbitals before output. We assume that p and q are already reordered, but r and s are not (yet). The reordered address of an orbital is computed according to rtr = reorder[r] - reorder_offset.

I have further modified the routine to spit out integrals whose reordered indices are canonical ij >= kl. The routine does not care whether ptr >= qtr, but it insists that the transformed pq and kl indices (called ij and kl in the routine) satisfy ij >= kl. David Sherrill, October 1995

Revised 6/27/96 by CDS for new format

Definition at line 44 of file buf_wrt_mat.cc.

References iwl_buf_put().

{
   int idx, r, s, R, S, rtr, str;
   int ij, kl;
   double value;
   Label *lblptr;
   Value *valptr;

   lblptr = Buf->labels;
   valptr = Buf->values;

   ij = INDEX(ptr,qtr);
   
   for (r=rfirst,R=0; r <= rlast; r++,R++) {
     rtr = reorder[r] - reorder_offset;

     for (s=sfirst,S=0; s <= slast && s <= r; s++,S++) {
       str = reorder[s] - reorder_offset;

       kl = INDEX(rtr,str);
       
       value = mat[R][S];

       if (ij >= kl && fabs(value) > Buf->cutoff) {
         idx = 4 * Buf->idx;
         lblptr[idx++] = (Label) MAX0(ptr,qtr);
         lblptr[idx++] = (Label) MIN0(ptr,qtr);
         lblptr[idx++] = (Label) MAX0(rtr,str);
         lblptr[idx++] = (Label) MIN0(rtr,str);
         valptr[Buf->idx] = (Value) value;
         
         Buf->idx++;
         
         if (Buf->idx == Buf->ints_per_buf) {
           Buf->lastbuf = 0;
           Buf->inbuf = Buf->idx;
           iwl_buf_put(Buf);
           Buf->idx = 0;
         }
         
         if (printflag)
           fprintf(outfile, ">%d %d %d %d [%d] [%d] = %20.10lf\n",
                   ptr, qtr, rtr, str, ij, kl, value);
         
       } /* end if (fabs(value) > Buf->cutoff) ... */
     } /* end loop over s */
   } /* end loop over r */
   
}

void iwl_buf_wrt_mat2	(	struct iwlbuf *	Buf,
		int	ptr,
		int	qtr,
		double **	mat,
		int	rfirst,
		int	rlast,
		int	sfirst,
		int	slast,
		int *	reorder,
		int	reorder_offset,
		int	printflag,
		int *	ioff,
		FILE *	outfile
	)

IWL_BUF_WRT_MAT2(): This routine is exactly like iwl_buf_wrt_mat() except that the requirement that ij >= kl has been lifted. This is necessary for the UHF alpha-beta transformation of the two-electron integrals.

TDC, 6/01

Definition at line 106 of file buf_wrt_mat.cc.

References iwl_buf_put().

{
   int idx, r, s, R, S, rtr, str;
   int ij, kl;
   double value;
   Label *lblptr;
   Value *valptr;

   lblptr = Buf->labels;
   valptr = Buf->values;

   ij = INDEX(ptr,qtr);
   
   for (r=rfirst,R=0; r <= rlast; r++,R++) {
     rtr = reorder[r] - reorder_offset;

     for (s=sfirst,S=0; s <= slast && s <= r; s++,S++) {
       str = reorder[s] - reorder_offset;

       kl = INDEX(rtr,str);
       
       value = mat[R][S];

       if (fabs(value) > Buf->cutoff) {
         idx = 4 * Buf->idx;
         lblptr[idx++] = (Label) MAX0(ptr,qtr);
         lblptr[idx++] = (Label) MIN0(ptr,qtr);
         lblptr[idx++] = (Label) MAX0(rtr,str);
         lblptr[idx++] = (Label) MIN0(rtr,str);
         valptr[Buf->idx] = (Value) value;
         
         Buf->idx++;
         
         if (Buf->idx == Buf->ints_per_buf) {
           Buf->lastbuf = 0;
           Buf->inbuf = Buf->idx;
           iwl_buf_put(Buf);
           Buf->idx = 0;
         }
         
         if (printflag)
           fprintf(outfile, ">%d %d %d %d [%d] [%d] = %20.10lf\n",
                   ptr, qtr, rtr, str, ij, kl, value);
         
       } /* end if (fabs(value) > Buf->cutoff) ... */
     } /* end loop over s */
   } /* end loop over r */
   
}

void iwl_buf_wrt_mp2	(	struct iwlbuf *	Buf,
		int	p,
		int	q,
		int	pq,
		int	pqsym,
		double **	arr,
		int	rsym,
		int *	firstr,
		int *	lastr,
		int *	firsts,
		int *	lasts,
		int *	occ,
		int *	vir,
		int *	ioff,
		int	printflag,
		FILE *	outfile
	)

iwl_buf_wrt_mp2()

Write to an Integrals With Labels formatted PSI buffer. The buffer must have been initialized with iwl_buf_init(). Don't forget to call iwl_buf_flush() when finished with all writes to the buffer to ensure that all contents are written to disk. David Sherrill, March, 1995

This routine is a modified form of iwl_buf_wrt() specific to mp2-type restricted transforms. It's not general, but it should work. Daniel, 9/25/95

Definition at line 26 of file buf_wrt_mp2.cc.

References iwl_buf_put().

{
   int idx, r, s, rs, ssym;
   int R,S,rnew,snew;
   double value;
   Label *lblptr;
   Value *valptr;

   lblptr = Buf->labels;
   valptr = Buf->values;

   ssym = pqsym ^ rsym;
   for (r=firstr[rsym],R=0; r <= lastr[rsym]; r++,R++) {
     rnew = occ[r];
     for (s=firsts[ssym],S=0; s <=lasts[ssym]; s++,S++) {
       snew = vir[s];
       rs = ioff[rnew] + snew;
       /*------------------------------------------
         We do not need integrals with rs > pq
         rs can only increase, hence if rs > pq -
         it is time to leave
        ------------------------------------------*/
       if (rs > pq)
         return;
       value = arr[R][S];
       
       if (fabs(value) > Buf->cutoff) {
         idx = 4 * Buf->idx;
         lblptr[idx++] = (Label) p;
         lblptr[idx++] = (Label) q;
         lblptr[idx++] = (Label) rnew;
         lblptr[idx++] = (Label) snew;
         valptr[Buf->idx] = (Value) value;
         
         Buf->idx++;
         
         if (Buf->idx == Buf->ints_per_buf) {
           Buf->lastbuf = 0;
           Buf->inbuf = Buf->idx;
           iwl_buf_put(Buf);
           Buf->idx = 0;
         }
         
         if(printflag)
           fprintf(outfile, "<%d %d %d %d [%d] [%d] = %20.10lf\n",
                   p, q, rnew, snew, pq, rs, value);
         
       } /* end if (fabs(value) > Buf->cutoff) ... */
     } /* end loop over s */
   } /* end loop over r */
   
}

void iwl_buf_wrt_mp2r12a	(	struct iwlbuf *	Buf,
		int	p,
		int	q,
		int	pq,
		int	pqsym,
		double **	arr,
		int	rsym,
		int *	firstr,
		int *	lastr,
		int *	firsts,
		int *	lasts,
		int *	occ,
		int	bra_ket_symm,
		int *	ioff,
		int	printflag,
		FILE *	outfile
	)

iwl_buf_wrt_mp2r12a()

Write to an Integrals With Labels formatted PSI buffer. The buffer must have been initialized with iwl_buf_init(). Don't forget to call iwl_buf_flush() when finished with all writes to the buffer to ensure that all contents are written to disk. David Sherrill, March, 1995

This routine is a modified form of iwl_buf_wrt() specific to mp2-type restricted transforms. It's not general, but it should work. Daniel, 9/25/95

This routine is a modified form of iwl_buf_wrt_mp2() specific to mp2r12a-type restricted transforms. Edward, 8/04/99

Definition at line 30 of file buf_wrt_mp2r12a.cc.

References iwl_buf_put().

{
   int idx, r, s, rs, ssym;
   int R,S,rnew,snew;
   double value;
   Label *lblptr;
   Value *valptr;

   lblptr = Buf->labels;
   valptr = Buf->values;

   ssym = pqsym ^ rsym;
   for (r=firstr[rsym],R=0; r <= lastr[rsym]; r++,R++) {
     rnew = occ[r];  /* r-index is in QTS-ordering, not Pitzer */
     for (s=firsts[ssym],S=0; s <=lasts[ssym]; s++,S++) {
       snew = s;     /* s-index is in Pitzer ordering */
       rs = ioff[rnew] + snew;
       /*---------------------------------------
         If bra_ket_symm != 0 -> we do not need
         integrals with rs > pq. rs can only
         increase here
        ---------------------------------------*/
       if (bra_ket_symm && rs > pq)
         return;
       value = arr[R][S];
       
       if (fabs(value) > Buf->cutoff) {
         idx = 4 * Buf->idx;
         lblptr[idx++] = (Label) p;
         lblptr[idx++] = (Label) q;
         lblptr[idx++] = (Label) rnew;
         lblptr[idx++] = (Label) snew;
         valptr[Buf->idx] = (Value) value;
         
         Buf->idx++;
         
         if (Buf->idx == Buf->ints_per_buf) {
           Buf->lastbuf = 0;
           Buf->inbuf = Buf->idx;
           iwl_buf_put(Buf);
           Buf->idx = 0;
         }
         
         if(printflag)
           fprintf(outfile, "<%d %d %d %d [%d] [%d] = %20.10lf\n",
                   p, q, rnew, snew, pq, rs, value);
         
       } /* end if (fabs(value) > Buf->cutoff) ... */
     } /* end loop over s */
   } /* end loop over r */
   
}

void iwl_buf_wrt_val	(	struct iwlbuf *	Buf,
		int	p,
		int	q,
		int	r,
		int	s,
		double	value,
		int	printflag,
		FILE *	outfile,
		int	dirac
	)

iwl_buf_wrt_val()

Write to an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init(). Don't forget to call iwl_buf_flush() when finished with all writes to the buffer to ensure that all contents are written to disk.

This function writes only a particular value and its indices to the given iwl buffer. This is useful when index rearragements are necessary (e.g. conversion from Mulliken to Dirac notation). This is not as nice as being able to write entire arrays of values to the buffer, but may be necessary at times. Daniel Crawford, Novemeber 1995

Definition at line 28 of file buf_wrt_val.cc.

References iwl_buf_put().

{
  int idx;
  Label *lblptr;
  Value *valptr;

  lblptr = Buf->labels;
  valptr = Buf->values;

  if (fabs(value) > Buf->cutoff) {
    idx = 4 * Buf->idx;
    if(dirac) {
      lblptr[idx++] = (Label) p;
      lblptr[idx++] = (Label) r;
      lblptr[idx++] = (Label) q;
      lblptr[idx++] = (Label) s;
    }
    else {
      lblptr[idx++] = (Label) p;
      lblptr[idx++] = (Label) q;
      lblptr[idx++] = (Label) r;
      lblptr[idx++] = (Label) s;
    }
    valptr[Buf->idx] = (Value) value;

    Buf->idx++;
     
    if (Buf->idx == Buf->ints_per_buf) {
      Buf->lastbuf = 0;
      Buf->inbuf = Buf->idx;
      iwl_buf_put(Buf);
      Buf->idx = 0;
    }
     
    if (printflag) {
      if(dirac) {
        fprintf(outfile, ">%d %d %d %d = %20.10lf\n",
                p, r, q, s, value);
      }
      else {
        fprintf(outfile, ">%d %d %d %d = %20.10lf\n",
                p, q, r, s, value);
      }
    }
  } 
}

void iwl_buf_wrt_val_SI	(	struct iwlbuf *	Buf,
		short int	p,
		short int	q,
		short int	r,
		short int	s,
		double	value,
		int	printflag,
		FILE *	outfile,
		int	dirac
	)

iwl_buf_wrt_val_SI()

Write to an Integrals With Labels formatted buffer. The buffer must have been initialized with iwl_buf_init(). Don't forget to call iwl_buf_flush() when finished with all writes to the buffer to ensure that all contents are written to disk.

This function writes only a particular value and its indices to the given iwl buffer. This is useful when index rearragements are necessary (e.g. conversion from Mulliken to Dirac notation). This is not as nice as being able to write entire arrays of values to the buffer, but may be necessary at times. Daniel Crawford, Novemeber 1995

Uses short int's as indices. May be useful. Ed Valeev, February 1999

Definition at line 31 of file buf_wrt_val_SI.cc.

References iwl_buf_put().

{
   int idx;
   Label *lblptr;
   Value *valptr;

   lblptr = Buf->labels;
   valptr = Buf->values;

   if (fabs(value) > Buf->cutoff) {
     idx = 4 * Buf->idx;
     if(dirac) {
       lblptr[idx++] = (Label) p;
       lblptr[idx++] = (Label) r;
       lblptr[idx++] = (Label) q;
       lblptr[idx++] = (Label) s;
     }
     else {
       lblptr[idx++] = (Label) p;
       lblptr[idx++] = (Label) q;
       lblptr[idx++] = (Label) r;
       lblptr[idx++] = (Label) s;
     }
     valptr[Buf->idx] = (Value) value;

     Buf->idx++;
     
     if (Buf->idx == Buf->ints_per_buf) {
       Buf->lastbuf = 0;
       Buf->inbuf = Buf->idx;
       iwl_buf_put(Buf);
       Buf->idx = 0;
     }
     
     if (printflag) {
       if(dirac) {
         fprintf(outfile, ">%d %d %d %d = %20.10lf\n",
                 p, r, q, s, value);
       }
       else {
         fprintf(outfile, ">%d %d %d %d = %20.10lf\n",
                 p, q, r, s, value);
       }
     }
   } 
}

int iwl_rdone	(	int	itap,
		char *	label,
		double *	ints,
		int	ntri,
		int	erase,
		int	printflg,
		FILE *	outfile
	)

IWL_RDONE()

This function reads the one-electron integrals in the MO basis from disk and stores them in core. Substantially revised on 29 April 1998 to filter out frozen orbitals if requested. This change requires a very different argument list from the previous version of this code.

David Sherrill, January 1994 Revised by David Sherrill, April 1998 Revised by TDC, June 2001

Parameters:

	itap	= tape to read ints from
	label	= the PSIO label
	ints	= buffer (already allocated) to store the integrals
	ntri	= number of packed integrals
	erase	= erase itap (1=yes, 0=no)
	printflg	= printing flag. Set to 1 to print ints; otherwise, set to 0
	outfile	= file pointer for output of ints or error messages

Definition at line 36 of file lib/libiwl/rdone.cc.

References print_array(), psio_open(), and psio_read_entry().

{

  int nmo;

  psio_open(itap, PSIO_OPEN_OLD);
  psio_read_entry(itap, label, (char *) ints, ntri*sizeof(double));
  psio_close(itap, !erase);

  if (printflg) {
    nmo = (sqrt((double) (1 + 8 * ntri)) - 1)/2;
    print_array(ints, nmo, outfile);
  }

  return(1);
}

void iwl_rdtwo	(	int	itap,
		double *	ints,
		int *	ioff,
		int	norbs,
		int	nfzc,
		int	nfzv,
		int	printflg,
		FILE *	outfile
	)

iwl_rdtwo(): read two electron ints from the given file. The "iwl" stands for "integrals with labels," and this is the proposed new standard for storing two-electron integrals and their (absolute) orbital labels.

Parameters:

	itap	= unit to read from
	ints	= two electron integrals (already allocated)
	ioff	= the old ioff array for lexical ordering
	norbs	= number of orbitals
	nfzc	= number of frozen core orbitals
	nfzv	= number of frozen virtual orbitals
	printflg	= print integrals as they're read
	outfile	= output file pointer

David Sherrill, 1995

Definition at line 33 of file lib/libiwl/rdtwo.cc.

References iwl_buf_close(), iwl_buf_init(), iwl_buf_rd_all(), and iwl_buf_rd_all_act().

{
  struct iwlbuf Buf;
  
  iwl_buf_init(&Buf, itap, 0.0, 1, 1);
  if ((nfzc == 0) && (nfzv == 0))
    iwl_buf_rd_all(&Buf, ints, ioff, ioff, 0, ioff, printflg, outfile);
  else
    iwl_buf_rd_all_act(&Buf, ints, ioff, ioff, 0, ioff, nfzc, norbs-nfzv-1,
                       printflg, outfile);
  iwl_buf_close(&Buf, 1);
}

void iwl_wrtone	(	int	itap,
		char *	label,
		int	ntri,
		double *	onel_ints
	)

IWL_WRTONE()

This function writes one-electron integrals.

itap = tape to read ints from label = the PSIO label ntri = the size of the array (lower triangle) onel_ints = array to hold the one-electron integrals.

David Sherrill, March 1995 Revised by TDC, June 2001

Definition at line 25 of file wrtone.cc.

References psio_open(), and psio_write_entry().

{
  psio_open(itap, PSIO_OPEN_OLD);
  psio_write_entry(itap, label, (char *) onel_ints, ntri*sizeof(double));
  psio_close(itap,1);
}

void iwl_wrttwo	(	int	itap,
		int	nbfso,
		double *	ints,
		int *	ioff,
		double	toler,
		int	printflg,
		FILE *	outfile
	)

iwl_wrttwo()

Write two electron ints to output in lexical order The "iwl" stands for "integrals with labels," and this is the proposed new standard for storing two-electron integrals and their (absolute) orbital labels. This function closes the output file when finished.

Parameters:

	itap	= unit to write to
	nbfso	= number of basis functions in symmetry orbitals
	ints	= two electron integrals
	ioff	= the old ioff array for lexical ordering
	printflg	= print flag (1 or 0)
	outfile	= output file

Revised 6/27/96 by CDS

Definition at line 30 of file wrttwo.cc.

References iwl_buf_close(), iwl_buf_flush(), iwl_buf_init(), and iwl_buf_wrt_all().

{
  struct iwlbuf Buf;

  iwl_buf_init(&Buf, itap, toler, 0, 0);
  iwl_buf_wrt_all(&Buf, nbfso, ints, ioff, printflg, outfile);
  iwl_buf_flush(&Buf, 1);
  iwl_buf_close(&Buf, 1);

}

void sortbuf	(	struct iwlbuf *	Inbuf,
		struct iwlbuf *	Outbuf,
		double *	ints,
		int	fpq,
		int	lpq,
		int *	ioff,
		int *	ioff2,
		int	nbfso,
		int	elbert,
		int	intermediate,
		int	no_pq_perm,
		int	qdim,
		int	add,
		int	printflg,
		FILE *	outfile
	)

sortbuf()

Function reads a file of two-electron integrals into core and writes them back out again in canonical order. Used in Yoshimine sorts where we have a file containing all rs for a few values of pq, but the ints are not in canonical order. At the very least, we need to sort to make sure that all (pq|rs) for a given pq are grouped together, since the transformation program wants to work with all rs for a single pq value at one time. We may or may not use the restriction pq >= rs (not used if intermediate = 1, which is how this routine is always called right now).

One interesting issue here is that the intermediate array ('ints') must be big enough to hold the integrals in the current buffer, but we don't generally want it to be much larger than necessary! Thus we calculate an 'offset' which is the canonical index of the first integral in the buffer, and we use this so that the first integral in the buffer is stored in ints[0]. What's different for the Elbert ordering is that we have all rs for a given pq but rs >= pq! If we want our canonical indices to be consecutive WITHIN THE CURRENT BUFFER, we MUST use upper triangle ordering rather than lower triangle! That's what ioff2 is used for. Obviously the offset must also be calculated with ioff2 for the Elbert order. Formula for ioff2: ioff2[0] = 0; ioff2[i] = ioff2[i-1] + n - i; Note that this is not the case when this routine is used for MP2 sorts. The definitions of the ioff arrays can be confusing, so care should be taken when using this routine.

Parameters:

	Inbuf	= IWL buffer for input
	Outbuf	= IWL buffer for output
	ints	= array to hold integrals in
	fpq	= first pq for this tape
	lpq	= last pq for this tape
	ioff	= offset array for the left indices
	ioff2	= offset array for Elbert sorts or for the right indices when no_pq_perm=1
	nbfso	= number of basis functions in SO's
	lastsort	= 1 if this is the last intape, 0 otherwise
	elbert	= integrals obey rs >= pq. Use ioff2 to get offset.
	intermediate=	1 if sorting a intermediate in the transformation which is indexed as X[ij][kl] where ij runs from fpq to lpq and kl runs from 0 to nbstri
	no_pq_perm	= don't use permutational symmetry to swap p and q (appropriate for MP2 where one is occ and one is virt)
	qdim	= dimensions for the q index...nvirt for MP2
	add	= add contributions to the same integral during sort
	printflg	= 1 for printing, 0 otherwise
	outfile	= output file pointer

Returns: none

Revised 6/27/96 by CDS for new IWL format N.B. Now need to iwl_flush the output buffer...not done in here!!

Definition at line 74 of file sortbuf.cc.

References iwl_buf_fetch(), and iwl_buf_put().

{
   int i;
   Value *valptr;              /* array of integral values */
   Label *lblptr;              /* array of integral labels */
   int idx;                    /* index for curr integral (0..ints_per_buf) */
   int lastbuf;                /* last buffer flag */
   int p, q, qmax, qmin, r, rmin, rmax, s, smin, smax, pq, rs;
   long int pqrs, offset;
   int first_p, first_q, first_pq, last_p, last_q;
   int nbstri;

   if (printflg) {
     fprintf(outfile, "\nsortbuf for pq=%d to %d\n", fpq, lpq);
   }

   if (no_pq_perm && !intermediate) {
     fprintf(outfile,"(sortbuf): illegal parameter combination.\n");
     fprintf(stderr, "(sortbuf): illegal parameter combination.\n");
   }
   
   nbstri = nbfso * (nbfso + 1) / 2;
   
   /* figure out ranges on things */
   /* I believe this section works fine, even with different ioff arrays */
   i = 0;
   while (fpq >= ioff[i] && i < BIGNUM) i++;
   if (i == BIGNUM) {
     fprintf(outfile, "(sortbuf): parameter error\n") ;
     return;
   }
   first_p = i-1 ; first_q = fpq - ioff[i-1];
   first_pq = ioff[first_p] + first_q;
   if (first_pq != fpq) {
     fprintf(outfile, "(sortbuf): fpq != first_pq.\n");
     fprintf(stderr,  "(sortbuf): fpq != first_pq.\n");
   }
   
   if (!intermediate) {
     if (elbert) offset = ioff2[first_pq] + first_pq ;
     else offset = ioff[first_pq] ;
   }
   else offset = 0;

   i=0; 
   while (lpq >= ioff[i] && i < BIGNUM) i++ ;
   if (i == BIGNUM) {
     fprintf(outfile, "(sortbuf): parameter error\n") ;
     return ;
   }
   last_p = i-1 ; last_q = lpq - ioff[i-1] ;
   
   
   lblptr = Inbuf->labels;
   valptr = Inbuf->values;

   /* read a buffer at a time until we're done */

   do {
      iwl_buf_fetch(Inbuf);
      lastbuf = Inbuf->lastbuf;
      for (idx=4*Inbuf->idx; Inbuf->idx<Inbuf->inbuf; Inbuf->idx++) {
        p = (int) lblptr[idx++];
        q = (int) lblptr[idx++];
        r = (int) lblptr[idx++];
        s = (int) lblptr[idx++];

        /* if (no_pq_perm) ioff is the appropriate offset array for the left
           indices (ioff[p] = nvirt * p for MP2); ioff2 is then the usual
           ioff offset array, used for the right indices */
        if (no_pq_perm) {
          pq = ioff[p] + q;
          rs = ioff2[MAX0(r,s)] + MIN0(r,s);
        }
        else {
          pq = ioff[MAX0(p,q)] + MIN0(p,q);
          rs = ioff[MAX0(r,s)] + MIN0(r,s);
        }
        
        if (!intermediate) {
          if (elbert)
            pqrs = ioff2[pq] + rs;
          else {
            pqrs = ioff[MAX0(pq,rs)];
            pqrs += MIN0(pq,rs);
          }
        }
        else {
          pqrs = (pq - first_pq);
          pqrs *= nbstri;
          pqrs += rs;
        }
        
        if (printflg && ints[pqrs-offset] != 0.0) 
           fprintf(outfile, "Adding %10.6lf to el %d %d %d %d = %10.6lf\n", 
                   valptr[Inbuf->idx], p, q, r, s, ints[pqrs-offset]);

        if (add) ints[pqrs-offset] += valptr[Inbuf->idx];
        else ints[pqrs-offset] += valptr[Inbuf->idx];

        if (printflg) 
          fprintf(outfile, "<%d %d %d %d | %d %d [%ld] = %10.6lf\n",
                  p, q, r, s, pq, rs, pqrs, ints[pqrs-offset]) ;
      }
   } while (!lastbuf);
   
   /* now write them out again, in order */
   lblptr = Outbuf->labels;
   valptr = Outbuf->values;

   idx = 0;

   for (p=first_p; p<=last_p; p++) {
     qmax = (p==last_p) ? last_q : p ;
     qmin = (p==first_p) ? first_q : 0 ;
     if(no_pq_perm) {
       qmax = (p==last_p) ? last_q : (qdim-1);
       qmin = (p==first_p) ? first_q: 0;
     }
     for (q=qmin; q<=qmax; q++) {
       pq = ioff[p] + q ; /* This should be fine even with MP2 */
       
       if (!intermediate) {
         rmin = (elbert) ? p : 0 ; 
         rmax = (elbert) ? nbfso : p+1 ;
       }
       else {  /* This should be fine with MP2, also */
         rmin = 0;
         rmax = nbfso;
       }
       
       for (r=rmin; r<rmax; r++) {
         
         if (!intermediate) {
           if (elbert) {
             smax = r+1 ;
             smin = (p==r) ? q : 0 ;
           }
           else {
             smax = (p==r) ? (q+1) : (r+1) ;
             smin = 0 ;
           }
         }
         else { /* This should be fine with MP2, also */
           smax = r + 1;
           smin = 0;
         }
         
         for (s=smin; s < smax; s++) {
           if(no_pq_perm) rs = ioff2[r] + s;
           else rs = ioff[r] + s;
           
           /* Again, this should be fine with MP2 */
           if (elbert) pqrs = ioff2[pq] + rs ;
           else if (intermediate) {
             pqrs = (pq - first_pq);
             pqrs *= nbstri;
             pqrs += rs;
           }
           else pqrs = ioff[pq] + rs ;
           
           if (fabs(ints[pqrs-offset]) > Outbuf->cutoff) {
             idx = 4*Outbuf->idx;
             lblptr[idx++] = p;
             lblptr[idx++] = q;
             lblptr[idx++] = r;
             lblptr[idx++] = s;
             valptr[Outbuf->idx] = ints[pqrs-offset];
             if (printflg) 
               fprintf(outfile, ">%d %d %d %d | %d %d [%ld] = %10.6lf\n",
                       p, q, r, s, pq, rs, pqrs, ints[pqrs-offset]) ;
             
             Outbuf->idx++;
             if (Outbuf->idx == Outbuf->ints_per_buf) {
               Outbuf->lastbuf = 0;
               Outbuf->inbuf = Outbuf->idx;
               iwl_buf_put(Outbuf);
               Outbuf->idx = 0;
             } 
           }
         }
       }
     }
   }
   
}

---