/*******************************************************************************
*                                                                              *
*                                   Viewmol                                    *
*                                                                              *
*                                I N E R T . C                                 *
*                                                                              *
*                 Copyright (c) Joerg-R. Hill, October 2003                    *
*                                                                              *
********************************************************************************
*
* $Id: inert.c,v 1.6 2003/11/07 11:02:58 jrh Exp $
* $Log: inert.c,v $
* Revision 1.6  2003/11/07 11:02:58  jrh
* Release 2.4
*
* Revision 1.5  2000/12/10 15:08:59  jrh
* Release 2.3
*
* Revision 1.4  1999/05/24 01:25:50  jrh
* Release 2.2.1
*
* Revision 1.3  1999/02/07 21:50:18  jrh
* Release 2.2
*
* Revision 1.2  1998/01/26 00:47:58  jrh
* Release 2.1
*
* Revision 1.1  1996/12/10  18:41:17  jrh
* Initial revision
*
*/
#include<math.h>
#include<stdio.h>
#include "viewmol.h"

void tql(double *, int, double *, int, int);

extern void thermo(struct MOLECULE *);

extern struct MOLECULE *molecules;
extern int debug;

void inert(struct MOLECULE *mol)
{
/* This subroutine calculates the tensor of inertia of a molecule
   and diagonalizes it. */

  const double h=6.626176e-34, c=2.99792458e10, u=1.6605655e-27;
  double tensor[3][3], eigvec[3][3], tmax;
  double cgx, cgy, cgz, mass, x, y, z;
  register double d, fac, pi;
  register int i, j;

  for (i=0; i<3; i++)
  {
    for (j=0; j<3; j++)
      tensor[i][j]=0.0;
  }
  /* Find center of gravity */
  cgx=0.0;
  cgy=0.0;
  cgz=0.0;
  mass=0.0;
  for (i=0; i<mol->na; i++)
  {
    cgx+=mol->atoms[i].mass*mol->atoms[i].x;
    cgy+=mol->atoms[i].mass*mol->atoms[i].y;
    cgz+=mol->atoms[i].mass*mol->atoms[i].z;
    mass+=mol->atoms[i].mass;
  }
  cgx/=mass;
  cgy/=mass;
  cgz/=mass;
  /* Calculate tensor of inertia */
  for (i=0; i<mol->na; i++)
  {
    fac=mol->atoms[i].mass;
    x=mol->atoms[i].x-cgx;
    y=mol->atoms[i].y-cgy;
    z=mol->atoms[i].z-cgz;
    tensor[0][0]+=fac*(y*y+z*z);
    tensor[0][1]-=fac*x*y;
    tensor[0][2]-=fac*x*z;
    tensor[1][1]+=fac*(x*x+z*z);
    tensor[1][2]-=fac*y*z;
    tensor[2][2]+=fac*(x*x+y*y);
  }
  tensor[1][0]=tensor[0][1];
  tensor[2][0]=tensor[0][2];
  tensor[2][1]=tensor[1][2];
  if (debug > 0)
  {
    printf("Tensor of inertia:\n");
    printf("%15.8f%15.8f%15.8f\n", tensor[0][0], tensor[0][1], tensor[0][2]);
    printf("               %15.8f%15.8f\n", tensor[1][1], tensor[1][2]);
    printf("                              %15.8f\n", tensor[2][2]);
  }
  /* Diagonalize it */
  tql(&tensor[0][0], 3, &eigvec[0][0], 3, 3);
  /* and convert its eigenvalues to 1/cm */
  pi=4.0*atan((double)1.0);
  fac=h/(8.0e-20*pi*pi*c*u);
  if (tensor[0][0] != 0.0)
    mol->rotConstants[0]=fac/tensor[0][0];
  if (tensor[1][1] != 0.0)
    mol->rotConstants[1]=fac/tensor[1][1];
  if (tensor[2][2] != 0.0)
    mol->rotConstants[2]=fac/tensor[2][2];
  if (debug > 0)
  {
    printf("eigenvalues: %15.8f%15.8f%15.8f\n", tensor[0][0], tensor[1][1],
           tensor[2][2]);
    printf("eigenvectors:%10.5f     %10.5f     %10.5f\n", eigvec[0][0],
           eigvec[1][0], eigvec[2][0]);
    printf("             %10.5f     %10.5f     %10.5f\n", eigvec[0][1],
           eigvec[1][1], eigvec[2][1]);
    printf("             %10.5f     %10.5f     %10.5f\n", eigvec[0][2],
           eigvec[1][2], eigvec[2][2]);
    printf("Rotational constants (1/cm):%10.6f %10.6f %10.6f\n", mol->rotConstants[0],
           mol->rotConstants[1], mol->rotConstants[2]);
  }
  tmax=tensor[0][0] > tensor[1][1] ? tensor[0][0] : tensor[1][1];
  tmax=tmax > tensor[2][2] ? tmax : tensor[2][2];
  for (i=0; i<3; i++)
  {
    d=sqrt(eigvec[i][0]*eigvec[i][0]+eigvec[i][1]*eigvec[i][1]+eigvec[i][2]
          *eigvec[i][2]);
    fac=2.0*tensor[i][i]/(tmax*d);
    for (j=0; j<3; j++)
      mol->tinert[i][j]=fac*eigvec[i][j];
  }
  thermo(mol);
}

/* tql.f -- translated by f2c (version 19950110).
   You must link the resulting object file with the libraries:
      -lf2c -lm   (in that order)
*/

void tql(double *a, int n, double *c, int l1, int l2)
{
    /* Initialized data */

    const double pzahl = (double)1e-31;
    const double bit = (double)1e-15;

    /* System generated locals */
    int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3;
    double r__1, r__2;

    /* Local variables */
    static int inda;
    static double d[3], e[3], f, g, h;
    static int i, j, k, l, m;
    static double p, q, r, s;
    static int index;
    static double cc, hh;
    static int ll, mm;
    static double tol;


/*     This subroutine diagonalizes the matrix a by the TQL algorithm and */
/*     puts the eigenvectors in c and the eigenvalues in the diagonal of */
/*     a */

    /* Parameter adjustments */
    c_dim1 = l1;
    c_offset = c_dim1 + 1;
    c -= c_offset;
    a_dim1 = l1;
    a_offset = a_dim1 + 1;
    a -= a_offset;

    /* Function Body */
    if (n == 1)
    {
      d[0] = a[a_dim1 + 1];
      c[c_dim1 + 1] = (double)1.;
      return;
    }
    tol = pzahl / bit;
    i__1 = n;
    for (i = 1; i <= i__1; ++i) {
      i__2 = i;
      for (j = 1; j <= i__2; ++j) {
          a[i + j * a_dim1] = a[j + i * a_dim1];
/* L1: */
          c[i + j * c_dim1] = a[i + j * a_dim1];
      }
    }
    index = n + 1;
    i__2 = n;
    for (i = 2; i <= i__2; ++i) {
      --index;
      inda = index - 1;
      l = index - 2;
      f = c[index + inda * c_dim1];
      g = (double)0.;
      if (l == 0) {
          goto L5;
      }
      i__1 = l;
      for (k = 1; k <= i__1; ++k) {
/* L4: */
/* Computing 2nd power */
          r__1 = c[index + k * c_dim1];
          g += r__1 * r__1;
      }
L5:
      h = g + f * f;
      if (g > tol) {
          goto L6;
      }
      e[index - 1] = f;
      h = (double)0.;
      goto L2;
L6:
      g = sqrt(h);
      if (f >= (double)0.) {
          g = -(double)g;
      }
      e[index - 1] = g;
      h -= f * g;
      c[index + inda * c_dim1] = f - g;
      f = (double)0.;
      ++l;
      i__1 = l;
      for (j = 1; j <= i__1; ++j) {
          c[j + index * c_dim1] = c[index + j * c_dim1] / h;
          g = (double)0.;
          i__3 = j;
          for (k = 1; k <= i__3; ++k) {
/* L8: */
            g += c[j + k * c_dim1] * c[index + k * c_dim1];
          }
          if (j == l) {
            goto L9;
          }
          ll = j + 1;
          i__3 = l;
          for (k = ll; k <= i__3; ++k) {
/* L10: */
            g += c[k + j * c_dim1] * c[index + k * c_dim1];
          }
L9:
          e[j - 1] = g / h;
/* L7: */
          f += g * c[j + index * c_dim1];
      }
      hh = f / (h + h);
      i__1 = l;
      for (j = 1; j <= i__1; ++j) {
          f = c[index + j * c_dim1];
          g = e[j - 1] - hh * f;
          e[j - 1] = g;
          i__3 = j;
          for (k = 1; k <= i__3; ++k) {
/* L11: */
            c[j + k * c_dim1] = c[j + k * c_dim1] - f * e[k - 1] - g * c[
                  index + k * c_dim1];
          }
      }
L2:
      d[index - 1] = h;
    }
    e[0] = (double)0.;
    d[0] = c[c_dim1 + 1];
    c[c_dim1 + 1] = (double)1.;
    i__2 = n;
    for (i = 2; i <= i__2; ++i) {
      l = i - 1;
      if (d[i - 1] == (double)0.) {
          goto L13;
      }
      i__3 = l;
      for (j = 1; j <= i__3; ++j) {
          g = (double)0.;
          i__1 = l;
          for (k = 1; k <= i__1; ++k) {
/* L15: */
            g += c[i + k * c_dim1] * c[k + j * c_dim1];
          }
          i__1 = l;
          for (k = 1; k <= i__1; ++k) {
/* L14: */
            c[k + j * c_dim1] -= g * c[k + i * c_dim1];
          }
      }
L13:
      d[i - 1] = c[i + i * c_dim1];
      c[i + i * c_dim1] = (double)1.;
      i__1 = l;
      for (j = 1; j <= i__1; ++j) {
          c[i + j * c_dim1] = (double)0.;
/* L12: */
          c[j + i * c_dim1] = (double)0.;
      }
    }
    i__1 = n;
    for (i = 2; i <= i__1; ++i) {
/* L16: */
      e[i - 2] = e[i - 1];
    }
    e[n - 1] = (double)0.;
    f = (float)0.;
    hh = (float)0.;
    i__1 = n;
    for (l = 1; l <= i__1; ++l) {
      h = bit * ((r__1 = d[l - 1], fabs(r__1)) + (r__2 = e[l - 1], fabs(
            r__2)));
      if (hh < h) {
          hh = h;
      }
      inda = l + 1;
      i__2 = n;
      for (m = l; m <= i__2; ++m) {
          if ((r__1 = e[m - 1], fabs(r__1)) <= hh) {
            goto L19;
          }
/* L18: */
      }
      m = n;
L19:
      if (m == l) {
          goto L17;
      }
L25:
      g = d[l - 1];
      p = (d[inda - 1] - g) / (e[l - 1] * (double)2.);
      r = sqrt(p * p + (double)1.);
      if (p < (double)0.) {
          r = -(double)r;
      }
      d[l - 1] = e[l - 1] / (p + r);
      h = g - d[l - 1];
      if (l == n) {
          goto L20;
      }
      i__2 = n;
      for (i = inda; i <= i__2; ++i) {
/* L21: */
          d[i - 1] -= h;
      }
L20:
      f += h;
      p = d[m - 1];
      cc = (double)1.;
      s = (double)0.;
      ll = m;
      i__2 = m;
      for (i = inda; i <= i__2; ++i) {
          mm = ll;
          --ll;
          q = e[ll - 1];
          g = cc * q;
          h = cc * p;
          if (fabs(p) < fabs(q)) {
            goto L23;
          }
          cc = q / p;
          r = sqrt(cc * cc + (double)1.);
          e[mm - 1] = s * p * r;
          s = cc / r;
          cc = (double)1. / r;
          goto L24;
L23:
          cc = p / q;
          r = sqrt(cc * cc + (double)1.);
          e[mm - 1] = s * q * r;
          s = (double)1. / r;
          cc /= r;
L24:
          p = cc * d[ll - 1] - s * g;
          d[mm - 1] = h + s * (cc * g + s * d[ll - 1]);
          i__3 = n;
          for (k = 1; k <= i__3; ++k) {
            h = c[k + mm * c_dim1];
            c[k + mm * c_dim1] = s * c[k + ll * c_dim1] + cc * h;
/* L22: */
            c[k + ll * c_dim1] = cc * c[k + ll * c_dim1] - s * h;
          }
      }
      e[l - 1] = s * p;
      d[l - 1] = cc * p;
      if ((r__1 = e[l - 1], fabs(r__1)) > hh) {
          goto L25;
      }
L17:
      d[l - 1] += f;
    }
    inda = n - 1;
    i__1 = inda;
    for (i = 1; i <= i__1; ++i) {
      k = i;
      p = d[i - 1];
      l = i + 1;
      i__3 = n;
      for (j = l; j <= i__3; ++j) {
          if (d[j - 1] >= p) {
            goto L27;
          }
          k = j;
          p = d[j - 1];
L27:
          ;
      }
      if (k == i) {
          goto L26;
      }
      d[k - 1] = d[i - 1];
      d[i - 1] = p;
      i__3 = n;
      for (j = 1; j <= i__3; ++j) {
          p = c[j + i * c_dim1];
          c[j + i * c_dim1] = c[j + k * c_dim1];
/* L28: */
          c[j + k * c_dim1] = p;
      }
L26:
      ;
    }
    i__1 = n;
    for (i = 1; i <= i__1; ++i) {
/* L29: */
      a[i + i * a_dim1] = d[i - 1];
    }
}

