/* solrot.f -- translated by f2c (version 19950314).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm   (in that order)
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    doublereal tvec[9]	/* was [3][3] */;
    integer id;
} euler_;

#define euler_1 euler_

struct {
    integer l1l, l2l, l3l, l1u, l2u, l3u;
} ucell_;

#define ucell_1 ucell_

/* Subroutine */ int solrot_(integer *ni, integer *nj, doublereal *xi, 
	doublereal *xj, doublereal *wj, doublereal *wk, integer *kr, 
	doublereal *e1b, doublereal *e2a, doublereal *enuc, doublereal *
	cutoff)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2, i__3, i__4;

    /* Local variables */
#define lims ((integer *)&ucell_1)
    static doublereal xjuc[3], wmax[100], wsum[100];
    static integer i, j, k, l;
    static doublereal wbits[100], e1bits[10], e2bits[10];
    static integer kb, ii, nequal;
    static doublereal enubit;
    extern /* Subroutine */ int rotate_(integer *, integer *, doublereal *, 
	    doublereal *, doublereal *, integer *, doublereal *, doublereal *,
	     doublereal *, doublereal *);
    static doublereal one;

/* ***********************************************************************
 */

/*   SOLROT FORMS THE TWO-ELECTRON TWO-ATOM J AND K INTEGRAL STRINGS. */
/*          ON EXIT WJ = "J"-TYPE INTEGRALS */
/*                  WK = "K"-TYPE INTEGRALS */

/*      FOR MOLECULES, WJ = WK. */
/* ***********************************************************************
 */
    /* Parameter adjustments */
    --e2a;
    --e1b;
    --wk;
    --wj;
    --xj;
    --xi;

    /* Function Body */
    if (first) {
	first = FALSE_;
	i__1 = euler_1.id;
	for (i = 1; i <= i__1; ++i) {
	    lims[i - 1] = -1;
/* L10: */
	    lims[i + 2] = 1;
	}
	for (i = euler_1.id + 1; i <= 3; ++i) {
	    lims[i - 1] = 0;
/* L20: */
	    lims[i + 2] = 0;
	}
    }
    one = 1.;
    if (xi[1] == xj[1] && xi[2] == xj[2] && xi[3] == xj[3]) {
	one = .5;
    }
    for (i = 1; i <= 100; ++i) {
	wmax[i - 1] = 0.;
	wsum[i - 1] = 0.;
/* L30: */
	wbits[i - 1] = 0.;
    }
    nequal = 1;
    for (i = 1; i <= 10; ++i) {
	e1b[i] = 0.;
/* L40: */
	e2a[i] = 0.;
    }
    *enuc = 0.;
    i__1 = ucell_1.l1u;
    for (i = ucell_1.l1l; i <= i__1; ++i) {
	i__2 = ucell_1.l2u;
	for (j = ucell_1.l2l; j <= i__2; ++j) {
	    i__3 = ucell_1.l3u;
	    for (k = ucell_1.l3l; k <= i__3; ++k) {
		for (l = 1; l <= 3; ++l) {
/* L50: */
		    xjuc[l - 1] = xj[l] + euler_1.tvec[l - 1] * i + 
			    euler_1.tvec[l + 2] * j + euler_1.tvec[l + 5] * k;
		}
		kb = 1;
		rotate_(ni, nj, &xi[1], xjuc, wbits, &kb, e1bits, e2bits, &
			enubit, cutoff);
		--kb;
		i__4 = kb;
		for (ii = 1; ii <= i__4; ++ii) {
/* L60: */
		    wsum[ii - 1] += wbits[ii - 1];
		}
		if (wmax[0] < wbits[0]) {
		    i__4 = kb;
		    for (ii = 1; ii <= i__4; ++ii) {
/* L70: */
			wmax[ii - 1] = wbits[ii - 1];
		    }
		}
		for (ii = 1; ii <= 10; ++ii) {
		    e1b[ii] += e1bits[ii - 1];
/* L80: */
		    e2a[ii] += e2bits[ii - 1];
		}
		*enuc += enubit * one;
/* L90: */
	    }
	}
    }
    if (one < .9) {
	i__3 = kb;
	for (i = 1; i <= i__3; ++i) {
/* L100: */
	    wmax[i - 1] = 0.;
	}
    }
    i__3 = kb;
    for (i = 1; i <= i__3; ++i) {
	wk[i] = wmax[i - 1];
/* L110: */
	wj[i] = wsum[i - 1];
    }
    *kr = kb + *kr;
    return 0;
} /* solrot_ */

#undef lims