      SUBROUTINE GEN_REDNINTRNLS(CARTCOORD, REDUNCO, INTLABEL,
     &                           IBNDTO, BMATRX, GMATRX,
     &                           TOTREDNCO, IATOMICNMBER, NRATMS,
     &                           IREDUNCO, TOTNOFBND, TOTNOFANG, 
     &                           TOTNOFDIH, BTGMIN, EIGVECTORS)
C
C Generate the famous B matrix (Molecular vibrations, Wilson, Decius 
C and Cross)  that transform the difference Cartesian corrdiantes to 
C the rectilinear nternal coordinates (the curvelinear and rectilinear 
C are identical for small displacements. The transformations matix is
C generated by using the formuals given in Pariseau et al. JCP, 2335, 
C 1965 and a good description of rec. and curv. coordinates can be 
C found in Hoy et al.. Molecular Physics, 1266, 1972.
C
      IMPLICIT DOUBLE PRECISION (A-H, O-Z)
C
#include "mxatms.par"
#include "io_units.par"
C 
      PARAMETER(THRESHOLD = 5.0D00, EPSILON = 1.0D-10)
C
      INTEGER TOTREDNCO, TOTNOFBND, TOTNOFANG, TOTNOFDIH,
     &        FRAGSCR
      CHARACTER*4 INTLABEL(MAXREDUNCO)
C
C The following arrays need to be managed dynamically:
C
C BNDLENGTHS: Keep the bond lengths of atom pairs. It is
C             of length MXATMS*MXATMS
C IATOMICNMBER: Keep the atomic numbers of all atoms and
C               it is MAXATMS long.
C SMOFCOVRAD: The sum of covalent radius of pairs of atoms
C             and of MXATMS*MXATMS long.
C NCONPRCNTR: The number of connectivities for an atom. The
C             maximum number is set to 10, so this is a
C             rather small (it is not currently being
C             used, but needs in the future).
      DIMENSION CARTCOORD(3*MXATMS), BNDLENTHS(MXATMS, MXATMS), 
     &          IATOMICNMBER(MXATMS), SMOFCOVRADI(MXATMS, MXATMS),
     &          IBNDTO(MXATMS*MXATMS), NCONPRCNTR(MXATMS),
     &          IREDUNCO(4, MAXREDUNCO), BMATRX(9*MXATMS*MXATMS),
     &          GMATRX(9*MXATMS*MXATMS), REDUNCO(MAXREDUNCO),
     &          MARK_FRAGMENTS(MXATMS, MXATMS),
     &          LENGTH_FRAGMENTS(MXATMS),FRAGSCR(MXATMS*MXATMS)
      DIMENSION EIGVECTORS(MAXREDUNCO, MAXREDUNCO),
     &          BTGMIN(3*NRATMS,MAXREDUNCO),BLNGT_IJFRGS(MXATMS)
#include "ric_heap.com"
C      
      DATA  IZERO /0/
C
      TOTREDNCO = IZERO
C
C Assign Connectivities: We need this to proceed! At this point this is 
C some what experimental. We need to improve this to include hydrogen 
C bonds, dimer bonds and so on. This should be improved as we gain 
C more experience with this stuff.
C     
#ifdef _DEBUG_LVL0
      Print*, "Entering assign connectivities"
#endif 
      CALL ASIGN_CNTVTES(CARTCOORD, BNDLENTHS, IATOMICNMBER, 
     &                   SMOFCOVRADI, NCONPRCNTR, IBNDTO, MAXCNTVS,
     &                   NRATMS, MARK_FRAGMENTS, LENGTH_FRAGMENTS,
     &                   FRAGSCR, BLNGT_IJFRGS)
C 
C Assign bond length Coordinates.
C
#ifdef _DEBUG_LVL0 
      Print*, "Entering assign bonds"
      Write(6,*)
#endif 

      CALL ASSIGN_BONDS(IBNDTO, IREDUNCO, TOTREDNCO, TOTNOFBND, NRATMS,
     &                  MAXREDUNCO)
C
C Assign bond angle Coordinates.
C
#ifdef _DEBUG_LVL0
      Print*, "Entering assign angles"
      Print*, "Total # of bonds:", TOTNOFBND
#endif 

      CALL ASSIGN_ANGLS(CARTCOORD, IBNDTO, IREDUNCO, TOTREDNCO,
     &                  TOTNOFBND, TOTNOFANG, NRATMS, MAXREDUNCO,
     &                  THRESHOLD)
C
C Assign bond dihedral angle Coordinates.
C
#ifdef _DEBUG_LVL0 
      Print*, "Entering assign dihedral angles"
      Print*, "Total # of Angles:", TOTNOFANG 
#endif 

      CALL ASSIGN_DIHLS(IBNDTO, IREDUNCO, TOTREDNCO, TOTNOFBND,
     &                  TOTNOFANG, NRATMS, TOTNOFDIH, MAXREDUNCO)
C
C Assign dihedral angles for nearly planar structures.
C
#ifdef _TRY_LINEAR_DIHS
C
C This is a highly experimental version to handle molecules that
C are linear since there are no dihedral when 3 or 4 atoms are
C linear. 
      IF (TOTNOFDIH .EQ. IZERO) THEN
#ifdef _DEBUG_LVL0
      Print*, "Entering assign planar dihedrals"
#endif 

         CALL ASSIGN_DIHLSNPL(CARTCOORD, IBNDTO, IREDUNCO, TOTREDNCO, 
     &                        TOTNOFBND, TOTNOFANG, TOTNOFDIH, NRATMS, 
     &                        MAXREDUNCO, THRESHOLD)
      ENDIF
#endif
C
C Assign Label for redundent internal coordinates.
C
#ifdef _DEBUG_LVL0
      Write(6,*)
      Print*, "Entering assign lables"
      Print*, "Total # of dihedrals:", TOTNOFDIH 
      Print*, "The total redundent internal", TOTREDNCO 
#endif 

      CALL ASSIGN_LABELS(IREDUNCO, TOTREDNCO, TOTNOFBND, TOTNOFANG,
     &                   TOTNOFDIH, INTLABEL)
#ifdef _DEBUG_LVL0
      Print*, "The redundent internal coordinates assignments"
      Write(6,*)
      Do i = 1, TOTREDNCO
         Write(6,111) (iredunco(j, i), j=1, 4)
      Enddo
 111  Format(5X, 4(I3, 1X))

#endif 
C
C Make sure the number of RICs has not increased.
C
      CALL GETREC(0,'JOBARC','REDNCORD',ITMP,0)
      IF (ITMP.GE.0) THEN
         CALL GETREC(1,'JOBARC','REDNCORD',1,ITMP)
         IF (ITMP.LT.TOTREDNCO) THEN
            WRITE(*,*) '@GEN_REDNINTRNLS: The number of internal ',
     &                 'coordinates has increased.'
            WRITE(*,*) '                  At the very least, this ',
     &                 'system has become unstable.'
            CALL ERREX
         END IF
      END IF
C
C Now built the B and G matrices.
C
#ifdef _DEBUG_LVL0 
      Write(6,*)
      Print*, "Entering B and G matrix generation"
      Write(6,*)
#endif 
      CALL BUILT_BGMTRX(CARTCOORD, REDUNCO, IREDUNCO, TOTREDNCO,
     &                  TOTNOFBND, TOTNOFANG, TOTNOFDIH, 
     &                  NRATMS, BMATRX, GMATRX, 
     &                  EIGVECTORS,EPSILON,BTGMIN,dRICHeap(z_DerBMat))
#ifdef _DEBUG_LVL0
      Write(6,*) 
      Print*, "The redundent internal coordinates:"
      write(6,*)
      Write(6, 9) (redunco(i), I=1, TOTREDNCO)
  9   Format (5(1X,F10.6))
#endif

C
C some labels for internal coords...
C   
CSSS      CALL OUTPUT(BMATRX, 1, TOTREDNCO, 1, 3*NRATMS, TOTREDNCO, 
CSSS     &            3*NRATMS, 1)
C
      RETURN
      END

