/*
** INTS.C
**
** Return values of one and two-electron integrals
**
** C. David Sherrill
** Center for Computational Quantum Chemistry
** University of Georgia
**
** Updated 3/18/95 to exclude frozen virtual orbitals.
** Updated 3/28/95 to exclude frozen core orbitals.
*/

#include <stdio.h>
#include <stdlib.h>
#include <libiwl/iwl.h>
#include <libciomr/libciomr.h>
#include <libqt/qt.h>
#include <psifiles.h>
#include "structs.h"
#define EXTERN
#include "globals.h"

#define MIN0(a,b) (((a)<(b)) ? (a) : (b))
#define MAX0(a,b) (((a)>(b)) ? (a) : (b))


void read_integrals()
{
   int i, j, ij, k, l, kl, ijkl, ijij;
   int nmotri, nmotri_full;
   double value;
   extern void check_energy(double *H, double *twoel_ints, int *docc, 
      int *frozen_docc, int fzc_flag, double escf, double enuc, double efzc, 
      int nirreps, int *reorder, int *opi, FILE *outfile);
   int junk;
   double *tmp_onel_ints;

   /* allocate memory for one and two electron integrals */
   nmotri_full = (CalcInfo.nmo * (CalcInfo.nmo + 1)) / 2;
   nmotri = (CalcInfo.num_ci_orbs * (CalcInfo.num_ci_orbs + 1)) / 2 ;
   CalcInfo.onel_ints = (double *) init_array(nmotri) ;
   CalcInfo.twoel_ints = (double *) init_array(nmotri * (nmotri + 1) / 2);
   CalcInfo.maxK = (double *) init_array(CalcInfo.num_ci_orbs);  

   /* replace old iwl_rdone call with the new one which filters 
    * note we must always filter the one-elec ints in the new scheme, 
    * although the two-elec ints only need filtering for first derivs
    * or for MCSCF 
    */

   /* iwl_rdone(Parameters.oei_file, nmotri, CalcInfo.onel_ints, 
                &(CalcInfo.efzc), Parameters.oei_erase); */

   tmp_onel_ints = init_array(nmotri_full);
   iwl_rdone(Parameters.oei_file, PSIF_MO_FZC, tmp_onel_ints, nmotri_full,
             Parameters.oei_erase, (Parameters.print_lvl>4), outfile);
   filter(tmp_onel_ints, CalcInfo.onel_ints, ioff, CalcInfo.nmo, 
	  CalcInfo.num_fzc_orbs, CalcInfo.num_fzv_orbs);
   free(tmp_onel_ints);

   iwl_rdtwo(Parameters.tei_file, CalcInfo.twoel_ints, ioff, CalcInfo.nmo, 
             Parameters.filter_ints ? CalcInfo.num_fzc_orbs : 0, 
             Parameters.filter_ints ? CalcInfo.num_fzv_orbs : 0, 
             (Parameters.print_lvl>4), outfile);

   /* Determine maximum K integral for use in averaging the diagonal */
   /* Hamiltonian matrix elements over spin-coupling set */
   if (Parameters.hd_ave) {
     for(i=0; i<CalcInfo.num_ci_orbs; i++) 
        for(j=0; j<CalcInfo.num_ci_orbs; j++) {
           /* if (i==j) continue; */
           ij = ioff[MAX0(i,j)] + MIN0(i,j);
           ijij = ioff[ij] + ij;
           value = CalcInfo.twoel_ints[ijij];
           if(value > CalcInfo.maxK[i]) CalcInfo.maxK[i] = value;
           }
      for(i=0; i<CalcInfo.num_ci_orbs; i++) {
        if(CalcInfo.maxK[i] > CalcInfo.maxKlist)
          CalcInfo.maxKlist = CalcInfo.maxK[i];
        if (Parameters.print_lvl > 4)
          fprintf(outfile,"maxK[%d] = %lf\n",i, CalcInfo.maxK[i]);
        } 
      }

   if (Parameters.print_lvl > 4) {
      fprintf(outfile, "\nOne-electron integrals\n") ;
      for (i=0, ij=0; i<CalcInfo.num_ci_orbs; i++) {
         for (j=0; j<=i; j++, ij++) {
            fprintf(outfile, "h(%d)(%d) = %11.7lf\n", i+1, j+1, 
               CalcInfo.onel_ints[ij]) ;
            }
         }
      fprintf(outfile, "\n") ;
      }

   if (Parameters.print_lvl > 4) {
      fprintf(outfile, "\nmaxKlist = %lf\n",CalcInfo.maxKlist);
      fprintf(outfile, "\nTwo-electron integrals\n");
      for (i=0; i<CalcInfo.num_ci_orbs; i++) {
         for (j=0; j<=i; j++) {
            ij = ioff[MAX0(i,j)] + MIN0(i,j) ;
            for (k=0; k<=i; k++) {
               for (l=0; l<=k; l++) {
                  kl = ioff[MAX0(k,l)] + MIN0(k,l) ;
                  ijkl = ioff[MAX0(ij,kl)] + MIN0(ij,kl) ;
                  fprintf(outfile, "%2d %2d %2d %2d (%4d) = %10.6lf\n",
                     i, j, k, l, ijkl, CalcInfo.twoel_ints[ijkl]);
                  } 
               }
            }
         }
      }

   if (Parameters.print_lvl) {
      check_energy(CalcInfo.onel_ints, CalcInfo.twoel_ints, CalcInfo.docc, 
         CalcInfo.frozen_docc, Parameters.fzc, CalcInfo.escf, CalcInfo.enuc, 
         CalcInfo.efzc, CalcInfo.nirreps, CalcInfo.reorder, 
         CalcInfo.orbs_per_irr, outfile);
      }

} 



double get_onel(int i, int j)
{
   int ij ;
   double value ;

   if (i > j) {
      ij = ioff[i] + j;
      value = CalcInfo.onel_ints[ij] ;
      return(value) ;
      }
   else {
      ij = ioff[j] + i ;
      value = CalcInfo.onel_ints[ij] ;
      return(value) ;
      }
   return(CalcInfo.onel_ints[ij]) ;
}


double get_twoel(int i, int j, int k, int l)
{
   int ij, kl, ijkl ;

   ij = ioff[MAX0(i,j)] ;
   ij += MIN0(i,j) ;
   kl = ioff[MAX0(k,l)] ;
   kl += MIN0(k,l) ;
   ijkl = ioff[MAX0(ij,kl)] ;
   ijkl += MIN0(ij,kl) ;


   return(CalcInfo.twoel_ints[ijkl]) ;
}



/*
** tf_onel_ints(): Function lumps together one-electron contributions
**    so that h'_{ij} = h_{ij} - 1/2 SUM_k (ik|kj)
**    The term h' arises in the calculation of sigma1 and sigma2 via
**    equation (20) of Olsen, Roos, et. al. JCP 1988
**
*/
void tf_onel_ints(int printflag, FILE *outfile)
{
   int i, j, k, ij, ik, kj, ikkj ;
   int nbf ;
   double *tei, *teptr ;
   double tval ;
   int ntri;

   /* set up some shorthand notation (speed up access) */
   nbf = CalcInfo.num_ci_orbs ;
   tei = CalcInfo.twoel_ints ;
   ntri = (nbf * (nbf + 1)) / 2;

   /* ok, new special thing for CASSCF...if there are *no* excitations
      into restricted orbitals, and if Parameters.fci=TRUE, then we
      do *not* want to sum over the restricted virts in h' or else
      we would need to account for RAS-out-of-space contributions
      (requiring fci=false).
    */
   if (Parameters.fci && (nbf > Parameters.ras3_lvl) && 
       Parameters.ras34_max == 0)
      nbf = Parameters.ras3_lvl;

   /* allocate space for the new array */
   CalcInfo.tf_onel_ints = init_array(ntri) ;

   /* fill up the new array */
   for (i=0,ij=0; i<nbf; i++)
      for (j=0; j<=i; j++) {
         tval = CalcInfo.onel_ints[ij] ;

         for (k=0; k<nbf; k++) {
            ik = ioff[MAX0(i,k)] + MIN0(i,k) ;
            kj = ioff[MAX0(k,j)] + MIN0(k,j) ;
            ikkj = ioff[ik] + kj ;
            teptr = tei + ikkj ;
            tval -= 0.5 * (*teptr) ;
            } 

         CalcInfo.tf_onel_ints[ij++] = tval ;
         }
   /* print if necessary */
   if (printflag) {
      fprintf(outfile, "\nh' matrix\n") ;
      print_array(CalcInfo.tf_onel_ints, nbf, outfile) ;
      fprintf(outfile, "\n") ;
      }
}



/*
** form_gmat(): Form the g matrix necessary for restriction to the RAS
**    subspaces (i.e. to eliminate contributions of out-of-space terms).
**    See equations (28-29) in Olsen, Roos, et. al. JCP 1988
**
*/
void form_gmat(int printflag, FILE *outfile)
{
   int nbf ;
   double *tei, *oei ;
   double tval ;
   int i, j, k, ij, ii, ik, kj, ikkj, iiij ;


   /* set up some shorthand notation (speed up access) */
   nbf = CalcInfo.num_ci_orbs ;
   oei = CalcInfo.onel_ints ;
   tei = CalcInfo.twoel_ints ;

   /* allocate space for the new array */
   /* CalcInfo.gmat = init_matrix(nbf, nbf) ; */
   /* why not use init_blockmatix here? */
   CalcInfo.gmat = (double **) malloc (nbf * sizeof(double *));
   CalcInfo.gmat[0] = (double *) malloc (nbf * nbf * sizeof(double));
   for (i=1; i<nbf; i++) {
      CalcInfo.gmat[i] = CalcInfo.gmat[i-1] + nbf;
      }

   /* fill up the new array */
   for (i=0; i<nbf; i++) {
      for (j=i+1; j<nbf; j++) {
         ij = ioff[j] + i ;
         tval = oei[ij] ;
         for (k=0; k<i; k++) {
            ik = ioff[i] + k ;
            kj = ioff[j] + k ;
            ikkj = ioff[kj] + ik ;
            tval -= tei[ikkj] ;
            }
         CalcInfo.gmat[i][j] = tval ;
         }
      } 

   for (i=0, ij=0; i<nbf; i++) {
      for (j=0; j<=i; j++,ij++) {
         tval = oei[ij] ;
         for (k=0; k<i; k++) {
            ik = ioff[i] + k ;
            kj = ioff[MAX0(k,j)] + MIN0(k,j) ;
            ikkj = ioff[ik] + kj ;
            tval -= tei[ikkj] ;
            }
         ii = ioff[i] + i ;
         iiij = ioff[ii] + ij ;
         if (i==j) tval -= 0.5 * tei[iiij] ;
         else tval -= tei[iiij] ;
         CalcInfo.gmat[i][j] = tval ;
         }
      }

   if (printflag) {
      fprintf(outfile, "\ng matrix\n") ;
      print_mat(CalcInfo.gmat, nbf, nbf, outfile) ;
      fprintf(outfile, "\n") ;
      }
}

