      SUBROUTINE INERTIA(IT, NOSILENT)
C
C BUILD INERTIA TENSOR
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C MXATMS     : Maximum number of atoms currently allowed
C MAXCNTVS   : Maximum number of connectivites per center
C MAXREDUNCO : Maximum number of redundant coordinates.
C
      INTEGER MXATMS, MAXCNTVS, MAXREDUNCO
      PARAMETER (MXATMS=200, MAXCNTVS = 10, MAXREDUNCO = 3*MXATMS)
C coord.com : begin
C
      DOUBLE PRECISION Q, R, ATMASS
      INTEGER NCON, NR, ISQUASH, IATNUM, IUNIQUE, NEQ, IEQUIV,
     &        NOPTI, NATOMS
      COMMON /COORD/ Q(3*MXATMS), R(MAXREDUNCO), NCON(MAXREDUNCO),
     &     NR(MXATMS),ISQUASH(MAXREDUNCO),IATNUM(MXATMS),
     &     ATMASS(MXATMS),IUNIQUE(MAXREDUNCO),NEQ(MAXREDUNCO),
     &     IEQUIV(MAXREDUNCO,MAXREDUNCO),
     &     NOPTI(MAXREDUNCO), NATOMS

C coord.com : end


C
C     Main OPTIM control data
C     IPRNT   Print level - not used yet by most routines
C     INR     Step-taking algorithm to use
C     IVEC    Eigenvector to follow (TS search)
C     IDIE    Ignore negative eigenvalues
C     ICURVY  Hessian is in curviliniear coordinates
C     IMXSTP  Maximum step size in millibohr
C     ISTCRT  Controls scaling of step
C     IVIB    Controls vibrational analysis
C     ICONTL  Negative base 10 log of convergence criterion.
C     IRECAL  Tells whether Hessian is recalculated on each cyc
C     INTTYP  Tells which integral program is to be used
C              = 0 Pitzer
C              = 1 VMol
C     XYZTol  Tolerance for comparison of cartesian coordinates
C
      COMMON /OPTCTL/ IPRNT,INR,IVEC,IDIE,ICURVY,IMXSTP,ISTCRT,IVIB,
     $   ICONTL,IRECAL,INTTYP,IDISFD,IGRDFD,ICNTYP,ISYM,IBASIS,
     $   XYZTol
 
 
      Parameter (LuOut = 6)
      DOUBLE PRECISION IT(3,3),SCRATCH(9)
      LOGICAL NOSILENT
C
      IND(I,J)=3*(I-1)+J
C   
      CALL ZERO(SCRATCH,9)
      CALL ZERO(IT,9)
      DO 100 I=1,3
         DO 100 K=1,NATOMS
            X1=DIST(Q(3*K-2),SCRATCH(1))
            X2=Q(3*(K-1)+I)
 100        IT(I,I)=ATMASS(K)*(X1*X1-X2*X2)+IT(I,I)
c     $         (DIST(Q(3*K-2),SCRATCH(1))**2-Q(3*(K-1)+I)**2)+IT(I,I)
      DO 200 I=1,3
         DO 300 J=1,3
            IF(I.EQ.J)GOTO 300
            DO 400 K=1,NATOMS
               IT(I,J)=-ATMASS(K)*(Q(IND(K,I))*Q(IND(K,J)))+IT(I,J)
 400        Continue
 300     Continue
 200  CONTINUE
      IF(IPRNT.GE.4 .AND. NOSILENT)WRITE(LuOut,*)' Inertia tensor'
      IF(IPRNT .GE. 4 .AND. NOSILENT) WRITE(LuOut,80)
     &                                ((IT(I,J),J=1,3),I=1,3)
 80   FORMAT(3(1X,F10.5))
      RETURN
      END
