      SUBROUTINE Calc_Zmat(na,atome,ind_zmat,val_zmat,x,y,z, &
           r_cov,  fact)

!----------------------------------------------------------------------
!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon, 
!  Centre National de la Recherche Scientifique,
!  Université Claude Bernard Lyon 1. All rights reserved.
!
!  This work is registered with the Agency for the Protection of Programs 
!  as IDDN.FR.001.100009.000.S.P.2014.000.30625
!
!  Authors: P. Fleurat-Lessard, P. Dayal
!  Contact: optnpath@gmail.com
!
! This file is part of "Opt'n Path".
!
!  "Opt'n Path" is free software: you can redistribute it and/or modify
!  it under the terms of the GNU Affero General Public License as
!  published by the Free Software Foundation, either version 3 of the License,
!  or (at your option) any later version.
!
!  "Opt'n Path" is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU Affero General Public License for more details.
!
!  You should have received a copy of the GNU Affero General Public License
!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.
!
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,
! for commercial licensing opportunities.
!----------------------------------------------------------------------

      use Path_module, only : Pi,max_Z, NMaxL, Nom, KINT, KREAL
      use Io_module, only :  IoOut

      IMPLICIT NONE

! Number of atoms
      integer(KINT), INTENT(IN) :: na
! Mass number of atoms
      INTEGER(KINT), INTENT(IN) :: atome(na)
! Coordinates
      real(KREAL), INTENT(IN) ::  x(na),y(na),z(na)
! Covalent radii
      REAL(KREAL), INTENT(IN) :: R_cov(Max_Z)
! Factor to determine connectivity
      REAL(KREAL) :: Fact
! Zmat index and values
      integer(KINT), INTENT(OUT) :: ind_zmat(na,5)
      real(KREAL),INTENT(OUT) ::  val_zmat(na,3)


      INTEGER(KINT), ALLOCATABLE :: LIAISONS(:,:) !(na,0:NMaxL
      INTEGER(KINT), ALLOCATABLE :: LiaisonsBis(:,:) ! na,0:NMaxL
      INTEGER(KINT), ALLOCATABLE :: LieS_CP(:,:),LieS_CF(:,:) ! (na,0:NMaxL)
      INTEGER(KINT), ALLOCATABLE :: NbAt3(:,:) !(Na,2)
      INTEGER(KINT), ALLOCATABLE :: CycleAt(:) !(Na)
      INTEGER(KINT), ALLOCATABLE :: CAFaire(:) ! Na

      Integer(KINT) :: AtTypCycl(Max_Z)
      Integer(KINT) :: NbCycle
      real(KREAL) ::  vx1,vy1,vz1,norm1
      real(KREAL) ::  vx2,vy2,vz2,norm2
      real(KREAL) ::  val
      Logical PasFini,AtTerm,Debug,Bicycle,FLie3,FirstCycle
      LOGICAL, ALLOCATABLE ::  Former3(:), DejaFait(:) ! Na
      Logical FTmp
      LOGICAL F1213, F1223,F1323

      INTEGER(KINT) :: I,J,K, IZM, N1,n2, N3, IL, JL
      INTEGER(KINT) :: IdAt0, I3, IAt3, Idx3, I1, I0, IAf
      INTEGER(KINT) :: Izm1,Izm2, IZm3,IZm4, VCF, ICat
      INTEGER(KINT) :: IOld, IndFin, IdAtL, IndAFaire
      INTEGER(KINT) :: IAti, IAtD, IAtv, IIAtDh, IAtDh
      INTEGER(KINT) :: IAt0, IAta, IAt, Jat,Idx
      INTEGER(KINT) :: ITmp, IAtTmp, NbAt0
      INTEGER(KINT) :: NbLies, ICycle, IMax
      REAL(KREAL) :: d,d12, d13,d32

  INTERFACE
     function valid(string) result (isValid)
       CHARACTER(*), intent(in) :: string
       logical                  :: isValid
     END function VALID

     FUNCTION angle(v1x,v1y,v1z,norm1,v2x,v2y,v2z,norm2)
        use Path_module, only :  Pi,KINT, KREAL
       real(KREAL) ::  v1x,v1y,v1z,norm1
       real(KREAL) ::  v2x,v2y,v2z,norm2
       real(KREAL) ::  angle
     END FUNCTION ANGLE


  END INTERFACE



      debug=valid("Calc_zmat")
      if (debug) WRITE(*,*) "========== Entering Calc_zmat =========="

      FirstCycle=.TRUE.
      FTmp=.FALSE.
      NbCycle=0
      DO i=1,na
         DO J=1,5
            Ind_Zmat(i,J)=0
         END DO
      END DO
      ALLOCATE(Former3(Na), DejaFait(Na))
      ALLOCATE(CaFaire(Na), CycleAt(Na))
      ALLOCATE(NbAt3(Na,2))
      ALLOCATE(Liaisons(na,0:NMaxL),LiaisonsBis(na,0:NMaxL))
      ALLOCATE(Lies_CP(na,0:NMaxL), Lies_CF(na,0:NMaxL))


      WRITE(IOOUT,*) Na
      WRITE(IOOUT,*) 'Calc_zmat'
      DO I=1,na
         WRITE(IOOUT,*) NOM(Atome(I)),X(i),y(i),z(i)
      END DO

      if (na.le.2) THEN
         WRITE(*,*) "I do not work for less than 2 atoms :-p"
         RETURN
      END IF

!     Cas particulier: 3 atomes ou moins...
      if (Na.eq.3) THEN
         d12=sqrt((x(1)-x(2))**2+(y(1)-y(2))**2+(z(1)-z(2))**2)
         d13=sqrt((x(1)-x(3))**2+(y(1)-y(3))**2+(z(1)-z(3))**2)
         d32=sqrt((x(3)-x(2))**2+(y(3)-y(2))**2+(z(3)-z(2))**2)
         F1213=(d12<=d13)
         F1323=(d13<=d32)
         F1223=(d12<=d32)
         if (debug) THEN
            WRITE(*,*) "DEBUG Calc_Zmat 3 atoms"
            WRITE(*,*) "d12,d13,d32:",d12,d13,d32
            WRITE(*,*) "F1213,F1323,F1223:",F1213,F1323,F1223
         END IF
         if (F1213) THEN
            if (F1323) THEN
               ind_zmat(1,1)=3
               ind_zmat(2,1)=1
               ind_zmat(2,2)=3
               ind_zmat(3,1)=2
               ind_zmat(3,2)=1
               ind_zmat(3,3)=3
            ELSE
               ind_zmat(1,1)=1
               ind_zmat(2,1)=2
               ind_zmat(2,2)=1
               ind_zmat(3,1)=3
               ind_zmat(3,2)=2
               ind_zmat(3,3)=1
            END IF
         ELSE
            IF (F1223) THEN
               ind_zmat(1,1)=2
               ind_zmat(2,1)=1
               ind_zmat(2,2)=2
               ind_zmat(3,1)=3
               ind_zmat(3,2)=1
               ind_zmat(3,3)=2
            ELSE
               ind_zmat(1,1)=2
               ind_zmat(2,1)=3
               ind_zmat(2,2)=2
               ind_zmat(3,1)=1
               ind_zmat(3,2)=3
               ind_zmat(3,3)=2
            END IF
         END IF
         IF (debug) THEN
            DO i=1,na
               WRITE(*,*) (ind_zmat(i,j),j=1,5)
            END DO
         END IF

!     We have ind_zmat, we fill val_zmat
         val_zmat(1,1)=0.
         val_zmat(1,2)=0.
         val_zmat(1,3)=0.
         n2=ind_zmat(2,1)
         n1=ind_zmat(2,2)
         d=sqrt((x(n1)-x(n2))**2+(y(n1)-y(n2))**2+ &
              (z(n1)-z(n2))**2)
         val_zmat(2,1)=d
         val_zmat(2,2)=0.
         val_zmat(2,3)=0.
         n1=ind_zmat(3,1)
         n2=ind_zmat(3,2)
         n3=ind_zmat(3,3)
         CALL vecteur(n2,n1,x,y,z,vx1,vy1,vz1,norm1)
         if (debug) write(*,*) n1,n2,norm1
         val_zmat(3,1)=norm1

         CALL vecteur(n2,n3,x,y,z,vx2,vy2,vz2,norm2)
         val=angle(vx1,vy1,vz1,norm1,vx2,vy2,vz2,norm2)
         if (debug) write(*,*) n2,n3,norm2,val
         val_zmat(3,2)=val
         val_zmat(3,3)=0.

         RETURN
      END IF


!     Premiere etape : calcul des connectivites
      DO I=1,na
         DejaFait(I)=.FALSE.
         Former3(I)=.False.
         Do J=0,NMaxL
            Liaisons(I,j)=0
            LiaisonsBis(I,j)=0
         END DO
         DO J=1,5
            ind_zmat(I,J)=0
         END DO
      END DO

      if (debug) WRITE(IOOUT,*) "Liaisons initialiazed"
!     DO IL=1,na
!     WRITE(IOOUT,1003) Il,(LIAISONS(IL,JL),JL=0,NMaxL)
!     WRITE(IOOUT,1003) Il,(LIAISONSBis(IL,JL),JL=0,NMaxL)
!     END DO

      Call CalcCnct(na,atome,x,y,z,LIAISONS,r_cov,fact)

      if (debug) THEN
         WRITE(IOOUT,*) "Connections calculated"
         DO IL=1,na
            WRITE(IOOUT,1003) Il,(LIAISONS(IL,JL),JL=0,NMaxL)
         END DO
      END IF


!     on va maintenant trier ces connectivites en 2 :
!     Lies_CF : vers l'exterieur de la molecule
!     Lies_CP : vers l'interieur de la molecule
!     Pour cela, on procede 'a l'envers' : on regarde les atomes
!     auxquels sont lies les atomes attaches -> on remplit Lies_CF/P
!     et on supprime ces atomes...

!     v2.0 on copie Liaison dans LiaisonBis. On analyse LiaisonBis
!     tout en modifiant Liaison. Cela evite de fausser l'analyse: un atome
!     qui est lie initialement a 2 atomes (et qui n'est donc pas terminal)
!     peut devenir terminal en milieu de traitement si on annule la liaison
!     qui le liait a un atome terminal situé avant lui...
!     ex: H2O code dans l'ordre H,O,H.
      PasFini=.True.
      AtTerm=.True.
      DO WHILE (PasFini.AND.AtTerm)
         PasFini=.False.
         AtTerm=.False.
         DO I=1,na
            DO J=0,NMaxL
               LiaisonsBis(I,J)=Liaisons(I,J)
            END DO
         END DO
!     DO IL=1,na
!     WRITE(IOOUT,1003) Il,(LIAISONS(IL,JL),JL=0,NMaxL)
!     WRITE(IOOUT,1003) Il,(LIAISONSBis(IL,JL),JL=0,NMaxL)
!     END DO
!     WRITE(IOOUT,*) "=================================="


         DO I=1,na
            if ((LiaisonsBis(I,0).eq.1).AND.Liaisons(I,0).ne.0) THEN
               AtTerm=.True.
!     On enleve cet atome
               Liaisons(I,0)=0
               NbLies=Lies_CP(I,0)+1
               Lies_CP(I,NbLies)=Liaisons(I,1)
               Lies_CP(I,0)=NbLies
               Liaisons(Liaisons(I,1),0)=Liaisons(Liaisons(I,1),0)-1

               NbLies=Lies_CF(Liaisons(I,1),0)+1
               Lies_CF(Liaisons(I,1),NbLies)=I
               Lies_CF(Liaisons(I,1),0)=NbLies

               Call Annul(Liaisons,Liaisons(I,1),I)

            END IF

            if (Liaisons(I,0).ge.1) THEN
               PasFini=.TRUE.
            END IF

         END DO
         if (debug) WRITE(*,*) 'PasFini, AtTerm',PasFini,AtTerm
         If (PasFini.AND.(.Not.AtTerm)) THEN
!     Pas d'atomes terminaux lors de l'exploration precedente.
!     On a soit une erreur, soit un cycle. Je ne sais pas encore gerer
!     tous les  cas :  on affiche un warning
            WRITE(*,*) "Je ne trouve pas d'atomes terminaux"
            WRITE(*,*) "Possibilite de molecule cyclique"
            WRITE(*,*) "Cas en cours de traitement: verifier l'output"
!     On va d'abord voir si on a des atomes liés a plus de 2 centres.
            AtTerm=.TRUE.
            Bicycle=.False.
            ICycle=0
            IMax=0
            DO I=1,na
               if (Liaisons(I,0).gt.2) THEN
                  ICycle=ICycle+1
                  BiCycle=.True.
                  If (Liaisons(I,0).gt.IMax) Imax=Liaisons(I,0)
                  Former3(I)=.True.
               END IF
            END DO
            IF (BiCycle) THEN
!     On a des atomes lies a 3 ou plus d'atomes...
!     donc soit des bicycles, soit plusieurs
!     cycles attaches par un sommet...
               WRITE(*,*) "On dirait un bicyle... on essaie"
               WRITE(*,*) ICycle, "atomes lies a plus de 2 atomes"
               WRITe(*,*) "Nb Attaches max:",IMax
!     Plusieurs cas possibles pour un bicycle:
!     1) 2 cycles relies par un sommet, ICycle=2, IMax=3
!     2) 2 cycles relies par une arrete, ICycle=2, Imax=3
               If (Imax.Eq.3) THEN
!     on doit pouvoir traiter celui la...
!     On classe les atomes liés a trois atomes, par le nombre d'atomes
!     lies a trois atomes
!     auxquels ils sont liés ... interessant pour les composes asterisques.
                  I3=0
                  FLie3=.False.
                  DO I=1,Na
                     If (Liaisons(I,0).EQ.3) THEN
                        I3=I3+1
                        K=0
                        DO J=1,Liaisons(I,0)
                           If (Liaisons(Liaisons(I,J),0).Eq.3) THEN
                              k=k+1
                              FLie3=.True.
                           END IF
                        END DO
                        NbAt3(I3,2)=k
                        NbAt3(I3,1)=I
                     END IF
                  END DO
!     A-t-on deux atomes a 3 lies ensemble ?
                  IF (FLie3) THEN
!     on les classe pas nb at lies a 3
                     IAt3=0
                     Idx3=0
                     DO I=1,I3
                        IF (NbAt3(I,2).ge.Iat3) THEN
                           IAt3=NbAt3(I,2)
                           Idx3=NbAt3(I,1)
                        END IF
                     END DO
!     On va enlever ces liaisons entre atomes a 3, en les mettant
!     en CF de l'atome 'central'
                     if (debug) WRITE(*,*) "Atome ",Idx3, &
                          " retenu, lié a",IAt3," atomes 3"
                     DO I=1,Liaisons(Idx3,0)
                        I1=Liaisons(Idx3,I)
                        If (Liaisons(I1,0).EQ.3) THEN
                           if (debug) WRITE(*,*) "Traitement ",I1,Idx3
                           NbLies=Lies_CF(Idx3,0)+1
                           Lies_CF(Idx3,NbLies)=I1
                           Lies_CF(Idx3,0)=NbLies
                           NbLies=Lies_CP(I1,0)+1
                           Lies_CP(I1,NbLies)=Idx3
                           Call Annul(Liaisons,I1,Idx3)
                           Call Annul(Liaisons,Idx3,I1)
                           Liaisons(Idx3,0)=Liaisons(Idx3,0)-1
                           Liaisons(I1,0)=Liaisons(I1,0)-1
                        END IF
                     END DO
                  ELSE
                     WRITE(*,*) "Aucune liaisons entre deux atomes liés"
                     WRITE(*,*) "Pas encore traité"
                     STOP
                  END IF        !FLie3=T ?
               END IF           !Imax=3 ?
            ELSE                ! BiCyle ?
!     Un seul cycle. Facile :-)
               WRITE(*,*) "Un  cycle identifie..."
               NbCycle=NbCycle+1
               if (debug) WRITE(*,*) 'Considering cycle ',NbCycle
               If (NbCycle.ge.2) THEN
!     si ce n'est pas le premier cycle que l'on met, on regarde si parmi les
!     atomes du cycle, l'un d'eux etait avant attache a 3 atomes...
                  I=1
                  DO WHILE (Liaisons(I,0).ne.2)
                     I=I+1
                  END DO
                  if (debug) WRITE(*,*) "I>2:",I,Former3(I)
                  FTmp=Former3(I)
                  I0=I
                  IOld=I
                  I1=I
                  I=Liaisons(I,1)
                  DO WHILE (.NOT.FTmp)
                     I1=Liaisons(I,1)
                     If (I1.Eq.IOld) I1=Liaisons(I,2)
                     FTmp=Former3(I1)
                     if (debug) WRITE(*,*) "I,I1,I0,IOld",I,I1,I0, &
                          IOld,FTmp
                     IF (I1.eq.I0) FTmp=.TRUE.
                     if (debug) WRITE(*,*) "I,I1,I0,IOld",I,I1,I0, &
                          IOld,FTmp
                     IOld=I
                     I=I1
                  END DO
                  if (debug) WRITE(*,*)  "I,I1,I0,IOld",I,I1,I0, &
                       IOld,FTmp
                  IF (Former3(I1)) THEN
!     On a notre atome particulier ... cool :-)
                     if (debug) WRITE(*,*) "Atome former3",I1
                     ITmp=I1
                  END IF
               END IF           ! NbCycle >=2
               IF (.NOT.Ftmp) THEN
                  if (debug) WRITE(*,*) "Pas trouve de former3"
!     on regarde si il y a un atome particulier.. ie un heteroatome ou autre.
                  DO I=1,Max_Z
                     AtTypCycl(I)=0
                  END DO
                  DO I=1,na
                     if (Liaisons(I,0).eq.2) &
                          AtTypCycl(Atome(I))=AtTypCycl(Atome(I))+1
                     if (debug) WRITE(*,*) I,Atome(I), &
                          AtTypCycl(Atome(I)), &
                          Liaisons(I,0)
                  END DO
                  Itmp=NmaxL+1
                  IAtTmp=0
                  DO I=1,Max_Z
                     If ((AtTypCycl(I).gt.0).and.(AtTypCycl(I).le.Itmp)) &
                          THEN
                        Itmp=AtTypCycl(I)
                        IAtTmp=I
                     END IF
                  END DO
                  if (debug) WRITE(*,*) 'Itmp,IAtTmp:',Itmp,IAtTmp
!     On a le type de l'atome particulier... on va prendre le premier venu
                  DO I=na,1,-1
                     If ((Atome(I).eq.IAtTmp).AND.(Liaisons(I,0).Eq.2)) &
                          Itmp=I
                  END DO
               END IF
               if (debug) WRITE(*,*) 'Atome ',Itmp,'(',IAtTmp,') retenu'
!     On va tricher en enlevant les liaisons de cet atome a la main...
               I0=Itmp
               I1=Liaisons(I0,1)
               DO WHILE (I1.Ne.ITmp)
                  if (debug) WRITE(*,*) "Going from",I0,"to ",I1
!     On rajoute ces deux liaisons en CF de Itmp
                  NbLies=Lies_CF(I0,0)+1
                  Lies_CF(I0,NbLies)=Liaisons(I0,1)
                  Lies_CF(I0,0)=NbLies
!     et les liaisons vers Itmp deviennent des CP pour les autres atomes
                  NbLies=Lies_CP(I1,0)+1
                  Lies_CP(I1,NbLies)=I0
                  Lies_CP(I1,0)=NbLies

                  Call Annul(Liaisons,I1,I0)
                  Liaisons(I1,0)=Liaisons(I1,0)-1
                  Liaisons(I0,0)=Liaisons(I0,0)-1

                  DO IL=1,na
                     WRITE(IOOUT,1003) Il,(LIAISONS(IL,JL),JL=0,NMaxL)
                  END DO
                  I0=I1
                  I1=Liaisons(I0,1)

               end do
               Call Annul(Liaisons,I1,I0)
               Liaisons(I1,0)=Liaisons(I1,0)-1
               Liaisons(I0,0)=Liaisons(I0,0)-1
            END IF
         END IF
         DO IL=1,na
            WRITE(IOOUT,1003) Il,(LIAISONS(IL,JL),JL=0,NMaxL)
         END DO
!     WRITE(IOOUT,*) "=================================="
!     WRITE(IOOUT,*) "=================================="
      END DO

!     WRITE(IOOUT,*) "=================================="
!     Il ne reste plus que des atomes lies a rien...
!     ce sont les 'centres' de la molecule. On repart
!     d'eux pour construire le reste de la molecule.

 1003 FORMAT(1X,I4,' - ',15(I5))
!     Avant de partir, on va classer, pour chaque atome, les atomes CF par
!     nombre de masse decroissant.
      DO I=1,na
!     WRITE(*,*) I,Lies_CF(I,0),(Atome(Lies_CF(I,J)),j=1,Lies_CF(I,0))
         DO J=1,Lies_CF(I,0)-1
            DO K=J+1,Lies_CF(I,0)
               if (atome(Lies_CF(I,K))>atome(Lies_CF(I,J))) THEN
                  Itmp=Lies_CF(I,K)
                  Lies_CF(I,K)=Lies_CF(I,J)
                  Lies_CF(I,J)=Itmp
               END IF
            END DO
         END DO
!     WRITE(*,*) I,Lies_CF(I,0),(Atome(Lies_CF(I,J)),j=1,Lies_CF(I,0))
      END DO

      IF (Debug) THEN
         WRITE(IOOUT,*) 'LIAISONS'
         DO I=1,na
            WRITE(IOOUT,1003) i,(LIAISONS(I,J),J=0,NMaxL)
         END DO

         WRITE(IOOUT,*) 'LIes_CF'
         DO I=1,na
            WRITE(IOOUT,1003) i,(LIeS_CF(I,J),J=0,NMaxL)
         END DO

         WRITE(IOOUT,*) 'LIes_CP'
         DO I=1,na
            WRITE(IOOUT,1003) i,(LIeS_CP(I,J),J=0,NMaxL)
         END DO
      END IF


!     On compte le nb d'atomes sans atomes CP (centripetes)
      NbAt0=0
      DO I=1,na
         IF (Lies_CP(I,0).eq.0) THEN
            NbAt0=NbAt0+1
            IF (DEBUG) WRITE(*,*) "Center atom",NbAt0,I,Atome(I)
         END IF
      END DO

!     On va les traiter tous en construisant les molecules en partant d'eux
!     Le premier atome sans CP est different des autres car il fixe
!     l'origine

      IZm=1
!     Boucle pour trouver celui qui a le plus d'atomes CF
      IdAt0=0
      VCF=0
      DO ICAt=1,na
         if ((Lies_CP(ICaT,0).eq.0).AND.(Lies_CF(ICAt,0).gt.VCF)) THEN
            IdAt0=ICat
            VCF=Lies_CF(ICAt,0)
         END IF
      END DO
      Lies_CP(IdAt0,0)=-1

!     WRITE(IOOUT,*) 'Atome 1', IdAt0, Nom(Atome(IdAt0))
      Izm1=IdAt0
      ind_zmat(izm,1)=Izm1
      ind_zmat(izm,2)=0
      ind_zmat(izm,3)=0
      ind_zmat(izm,4)=0
      ind_zmat(izm,5)=0
      val_zmat(izm,1)=0.0
      val_zmat(izm,2)=0.0
      val_zmat(izm,3)=0.0
      DejaFait(Izm1)=.True.

!     Les atomes CF lies a IdAt0 sont mis en attente pour
!     etre traites

      IndFin=1
      Do iaf=1,Lies_CF(IdAt0,0)
         CAfaire(IndFin)=Lies_CF(IdAt0,Iaf)
         IndFin=IndFin+1
      END DO
      CAfaire(IndFin)=0

!     On construit la premiere couche qui est speciale car elle fixe les
!     axes.
!     Plusieurs cas sont possibles suivant le nb d'atomes CF

      IF (Lies_CF(IdAt0,0).ge.3) THEN
         if (debug) WRITE(*,*) 'Cas tres simple,',IdAt0, &
              ' lié a plus de 3 atomes'
         IZm2=Lies_CF(IdAt0,1)
         IZm3=Lies_CF(IdAt0,2)
!     WRITE(IOOUT,*) 'Atome 2' , Izm2, Nom(Atome(Izm2))
!     WRITE(IOOUT,*) 'Atome 3' ,Izm3, Nom(Atome(izm3))

         Izm=2
         CALL vecteur(IZm1,IZm2,x,y,z,vx1,vy1,vz1,norm1)
!     write(*,11) n1,n2,norm1

         ind_zmat(izm,1)=izm2
         ind_zmat(izm,2)=izm1
         ind_zmat(izm,3)=0
         ind_zmat(izm,4)=0
         ind_zmat(izm,5)=0
         val_zmat(izm,1)=norm1
         val_zmat(izm,2)=0.0
         val_zmat(izm,3)=0.0
         DejaFait(Izm2)=.TRUE.

         Izm=3
         CALL vecteur(izm1,izm3,x,y,z,vx2,vy2,vz2,norm2)
         val=angle(vx1,vy1,vz1,norm1,vx2,vy2,vz2,norm2)

!     write(*,11) n1,n2,norm1,n3,val

         ind_zmat(izm,1)=izm3
         ind_zmat(izm,2)=izm1
         ind_zmat(izm,3)=izm2
         ind_zmat(izm,4)=0
         ind_zmat(izm,5)=0
         val_zmat(izm,1)=norm2
         val_zmat(izm,2)=val
         val_zmat(izm,3)=0.0
         DejaFait(Izm3)=.TRUE.

         DO IdAtl=3,Lies_CF(IdAt0,0)
            Izm4= Lies_CF(IdAt0,IdAtl)
!     WRITE(IOOUT,*) 'Atome ',Izm+1,Izm4,Nom(Atome(Izm4)),Izm1,
!     $Izm2,Izm3
            Izm=Izm+1
            Call AddLigne(Izm,Izm4,Izm1,Izm2,Izm3,ind_zmat,val_zmat, &
                 x,y,z)
            DejaFait(Izm4)=.TRUE.
         END DO
      END IF

      IF (Lies_CF(Izm1,0).eq.2) THEN
         if (debug) WRITE(*,*) 'Cas simple,',IdAt0, &
              ' lié a 2 atomes'

         IZm2=Lies_CF(IdAt0,1)
         IZm3=Lies_CF(IdAt0,2)
         Izm=2
         CALL vecteur(IZm1,IZm2,x,y,z,vx1,vy1,vz1,norm1)
!     write(*,11) n1,n2,norm1

         ind_zmat(izm,1)=izm2
         ind_zmat(izm,2)=izm1
         ind_zmat(izm,3)=0
         ind_zmat(izm,4)=0
         ind_zmat(izm,5)=0
         val_zmat(izm,1)=norm1
         val_zmat(izm,2)=0.0
         val_zmat(izm,3)=0.0
         DejaFait(Izm2)=.TRUE.

         Izm=3

         CALL vecteur(izm1,izm3,x,y,z,vx2,vy2,vz2,norm2)
         val=angle(vx1,vy1,vz1,norm1, &
              vx2,vy2,vz2,norm2)

!     write(*,11) n1,n2,norm1,n3,val

         ind_zmat(izm,1)=izm3
         ind_zmat(izm,2)=izm1
         ind_zmat(izm,3)=izm2
         ind_zmat(izm,4)=0
         ind_zmat(izm,5)=0
         val_zmat(izm,1)=norm2
         val_zmat(izm,2)=val
         val_zmat(izm,3)=0.0
         DejaFait(Izm3)=.TRUE.

      END IF

      IF (Lies_CF(Izm1,0).eq.1) THEN
         if (debug) WRITE(*,*) 'Cas merdouille,',IdAt0, &
              ' lié a 1 atome'

         IZm2=Lies_CF(IdAt0,1)
         Izm=2
         CALL vecteur(IZm1,IZm2,x,y,z,vx1,vy1,vz1,norm1)
!     write(*,11) n1,n2,norm1

         ind_zmat(izm,1)=izm2
         ind_zmat(izm,2)=izm1
         ind_zmat(izm,3)=0
         ind_zmat(izm,4)=0
         ind_zmat(izm,5)=0
         val_zmat(izm,1)=norm1
         val_zmat(izm,2)=0.0
         val_zmat(izm,3)=0.0
         DejaFait(Izm2)=.TRUE.

!     Pour les autres atomes, on prend les atomes
!     CF lie a l'tome CF lie a At0... en esperant
!     qu'il en a !!!
!     => il faudra voir le cas ou il n'en a pas !!!
!     en attendant on rajoute le test...
         IF (Lies_CF(Izm2,0).Eq.0) THEN
            WRITE(*,*) "Je n'arrive pas a trouver les premiers"
            WRITE(*,*) "atomes pour construire la molecule"
            WRITE(*,*) "Atome central lié au plus a 1 atome",Izm1,izm2
            WRITE(*,*) "Et atome 2 lié a rien... moi perdu"
            STOP
         END IF

!     On ajoute les atomes lies a cet atome dans la liste a faire
         Do iaf=1,Lies_CF(Izm2,0)
            CAfaire(IndFin)=Lies_CF(Izm2,Iaf)
            IndFin=IndFin+1
         END DO
         CAfaire(IndFin)=0
         Izm3= Lies_CF(Izm2,1)
         Izm=3
         CALL vecteur(izm2,izm1,x,y,z,vx1,vy1,vz1,norm1)

         CALL vecteur(izm2,izm3,x,y,z,vx2,vy2,vz2,norm2)
         val=angle(vx1,vy1,vz1,norm1, &
              vx2,vy2,vz2,norm2)

!     write(*,11) n1,n2,norm1,n3,val

         ind_zmat(izm,1)=izm3
         ind_zmat(izm,2)=izm2
         ind_zmat(izm,3)=izm1
         ind_zmat(izm,4)=0
         ind_zmat(izm,5)=0
         val_zmat(izm,1)=norm1
         val_zmat(izm,2)=val
         val_zmat(izm,3)=0.0
         DejaFait(Izm3)=.TRUE.

!     je pense que ce qui suit est totalement inutile
!     C     DO IdAtl=3,Lies_CF(IdAt0,0)
!     C     Izm4= Lies_CF(IdAt0,IdAtl)
!     C     Izm=Izm+1
!     C     Call AddLigne(Izm,Izm4,Izm1,Izm2,Izm3,ind_zmat,val_zmat
!     C     $,x,y,z)
!     C     DejaFait(Izm4)=.TRUE.
!     C     END DO
      END IF

!     on a cree la premiere couche autour du premier centre
!     reste a finir les autres couches
      IndAFaire=1
      if (debug) WRITE(IOOUT,*) "CaFaire:",CaFaire
      Do WHILE (Cafaire(IndAFaire).ne.0)
         IAt0=Cafaire(IndAfaire)
         if (debug) WRITE(*,*) "IndAFaire,IAt0,Lies_CF(IAt0,0)", &
              IndAFaire,IAt0,Lies_CF(IAt0,0)
         if (Lies_CF(IAt0,0).ge.1) THEN
!     IAt0 est l'atome pour lequel on construit la couche suivante
!     le premier atome lie est particulier car il definit l'orientation
!     de ce fragment
            IAti=Lies_CF(IAt0,1)
!     WRITE(IOOUT,*) 'IAti:',IAti
            IAtd=IAt0
!     WRITE(IOOUT,*) 'IAtd:',IAtd
            IAtv=Lies_CP(IAt0,1)
!     WRITE(IOOUT,*) 'IAtv:',IAtv
            IIAtdh=1
            IAtdh=Lies_CF(IAtv,IIatdh)
            DO WHILE (Iatdh.eq.IAt0)
               IIatdh=IIatdh+1
               IAtdh=Lies_CF(IAtv,IIatdh)
            END DO
            IF (IAtdh.eq.0) IAtdh=Lies_CP(IAtv,1)
!     WRITE(IOOUT,*) 'IAtdh:',IAtdh
            IF (.NOT.DejaFait(IAti)) THEN
               Izm=Izm+1
               if (debug) WRITE(*,*) 'izm,IAti,IAtd,IAtv,IAtdh', &
                    izm,IAti,IAtd,IAtv,IAtdh
               Call AddLigne(Izm,IAti,IAtd,IAtv,IAtdh,ind_zmat,val_zmat &
                    ,x,y,z)
               DejaFait(IAti)=.TRUE.
            END IF

            CAfaire(IndFin)=Lies_CF(IAt0,1)
            IndFin=IndFin+1
!     Le traitement des autres est plus facile
            IAtdh=Lies_CF(IAt0,1)
            DO IAta=2,Lies_CF(IAt0,0)
               IAtI=Lies_CF(IAt0,IAta)
                     if (debug) WRITE(*,*) " Problem is here; IndFin:",I
               CAfaire(IndFin)=IAtI
               IndFin=IndFin+1

               IF (.NOT.DejaFait(IAti)) THEN
                  Izm=Izm+1
                  Call AddLigne(Izm,IAti,IAtd,IAtv,IAtdh,ind_zmat &
                       ,val_zmat,x,y,z)
                  DejaFait(IAti)=.TRUE.
               END IF
            END DO

            CAfaire(IndFin)=0
         END IF
         IndAFaire=IndAFaire+1
      END DO


!     On a fini de creer la molecule autour du premier atome 'centre'
!     Pour les autres c'est presque id... sauf que les axes sont deja fixes
!     On pourrait imaginer de mettre des atomes fictifs pour redefinir des axes
!     locaux... dans une autre version
!     V2.0
      NbAt0=NbAt0-1
      DO I=1,NbAt0
!     Boucle pour trouver celui qui a le plus d'atomes CF

         IdAt0=0
         VCF=0

         DO ICAt=1,na
            if ((Lies_CP(ICaT,0).eq.0).AND.(Lies_CF(ICAt,0).gt.VCF)) &
                 THEN
               IdAt0=ICat
               VCF=Lies_CF(ICAt,0)
            END IF
         END DO
         Lies_CP(IdAt0,0)=-1

         IF (debug) WRITE(*,*) 'Adding fragment centered on ',IdAt0, &
              LIAISONS(IdAt0,0)
         IF (debug) WRITE(*,*) 'Center linked to ',Lies_CF(IdAt0,0), &
              ' atoms'
!     if (LIAISONS(IdAt0,0).EQ.0) goto 12345

         if (debug) THEN
            WRITE(IOOUT,*) 'LIAISONS tralala',nbcycle
            DO IAt=1,na
               WRITE(IOOUT,1003) iat,(LIAISONS(Iat,Jat),Jat=0,NMaxL)
            END DO
         END IF

!     Boucle pour voir quel est l'atome du fragment precedent qui est le plus
!     proche de celui ci
!     Rq: si ce sont des cycles lies, il pourrait etre malin de rechercher
!     a quoi il etait lie.
         norm2=1.e6
         Idx=0
         DO ICAt=1,Izm
            CALL vecteur(Idat0,ind_zmat(icat,1),x,y,z,vx1,vy1,vz1,norm1)
            if (norm2.ge.norm1) THEN
               norm2=norm1
               Idx=Icat
            END IF
         END DO
         IF (debug) WRITE(*,*) 'Link between fragments ',IdAt0, &
              ind_zmat(Idx,1), ' -- Idx=',Idx

!     on a l'indice... on va rajouter cet atome a la liste !
         izm=izm+1
         n1=ind_zmat(Idx,1)
!     Petit probleme si Idx<=2
         IF (Idx.EQ.1) THEN
!     Pb non negligeable ...
            IF (izm.ge.2) THEN
               IAtv=ind_zmat(2,1)
               IAtdh=ind_zmat(3,1)
            ELSE
               WRITE(*,*) '2 fragments, le 1er a moins de 2 atomes...'
               WRITE(*,*) "J'ai merde... "
               STOP
            END IF
         ELSEIF (Idx.EQ.2) THEN
            IAtv=1
            IF (izm.ge.2) THEN
               IAtdh=ind_zmat(3,1)
            ELSE
               WRITE(*,*) '2 fragments, le 1er a moins de 2 atomes...'
               WRITE(*,*) "J'ai merde... "
               STOP
            END IF
         ELSE
            IAtv=ind_zmat(Idx,2)
            IAtdh=ind_zmat(Idx,3)
         END IF

!     WRITE(*,*) "Outchilou IAtv, IAtdh", IAtv, IAtdh,n1
         CALL vecteur(n1,IdAt0,x,y,z,vx1,vy1,vz1,norm1)
         CALL vecteur(n1,IAtv,x,y,z,vx2,vy2,vz2,norm2)
         val=angle(vx1,vy1,vz1,norm1, &
              vx2,vy2,vz2,norm2)
         if (debug) WRITE(*,*) 'Angle val:1',IdAt0,n1,IAtv,val
         if ((abs(val).LE.10.).OR.(abs(pi-val).le.10.)) THEN
            IAtv=IAtdh
!     Ceci pose pb si Idx<=3... a traiter plus tard
            IF (Idx.ge.3) THEN
               IAtdh=ind_zmat(Idx,4)
            ELSE
               if (izm.ge.4) THEN
                  IAtdh=4
               ELSE
                  WRITE(*,*) 'Pb Angle Val+idx=3+izm<=4'
                  STOP
               END IF
            END IF
         END IF
         Call AddLigne(Izm,IdAt0,ind_zmat(Idx,1),IAtv,IAtdh, &
              ind_zmat,val_zmat,x,y,z)


         IndFin=1
         IAtd=IdAt0
         n1=IAtdh
         IAtdh=IAtv
         IAtv=ind_zmat(Idx,1)
!     On ajoute les atomes lies a cet atome dans la liste a faire
         Do iaf=1,Lies_CF(IdAt0,0)
            IatI=Lies_CF(IdAt0,Iaf)
!     We check that this atom is not the one that is the closest to
!     the center atom
            if (IAtv.Ne.IAtI) THEN
               IF (debug) WRITE(*,*) 'Adding atom',IAtI, &
                    'to CAFaire in pos',iaf
               CAfaire(IndFin)=IAtI
               IndFin=IndFin+1
!     On les ajoute aussi dans la zmat
               If (.NOT.DejaFait(IatI)) THEN
                  izm=izm+1
!     WRITE(*,*) "Outchili IAtv, IAtdh,IAtI", IAtv, IAtdh,IAtI
                  CALL vecteur(IAtI,IAtD,x,y,z,vx1,vy1,vz1,norm1)
                  CALL vecteur(IAtI,IAtv,x,y,z,vx2,vy2,vz2,norm2)
                  val=angle(vx1,vy1,vz1,norm1, vx2,vy2,vz2,norm2)
                  if (debug) WRITE(*,*) 'Angle val:2',IAtI,IAtD,IAtv,val
                  if ((abs(val).LE.10.).OR.(abs(180.-abs(val)).le.10.)) &
                       THEN
                     Call AddLigne(Izm,IAtI,IAtv,IAtdh,n1, &
                          ind_zmat,val_zmat,x,y,z)
                  ELSE

                     Call AddLigne(Izm,IAtI,IAtD,IAtv,IAtdh, &
                          ind_zmat,val_zmat,x,y,z)
                  END IF
               END IF
            END IF
         END DO
         CAfaire(IndFin)=0

!     On traite le reste de ce fragment !!
         IndAFaire=1
         WRITE(IOOUT,*) CaFaire
         Do WHILE (Cafaire(IndAFaire).ne.0)
            IAt0=Cafaire(IndAfaire)
            if (Lies_CF(IAt0,0).ge.1) THEN
!     IAt0 est l'atome pour lequel on construit la couche suivante
!     le premier atome lie est particulier car il definit l'orientation
!     de ce fragment
               Itmp=1
               IAti=Lies_CF(IAt0,Itmp)
               DO WHILE (DejaFait(IAti).AND.(Itmp.Le.Lies_CF(IAt0,0)))
                  Itmp=Itmp+1
                  IAti=Lies_CF(IAt0,ITmp)
               END DO
               If (.NOT.DejaFait(Iati)) THEN
                  IF (debug) WRITE(IOOUT,*) 'IAti:',IAti
                  IAtd=IAt0
                  IF (debug)     WRITE(IOOUT,*) 'IAtd:',IAtd
                  IAtv=Lies_CP(IAt0,1)
                  IF (debug)     WRITE(IOOUT,*) 'IAtv:',IAtv
                  IIAtdh=1
                  IAtdh=Lies_CF(IAtv,IIatdh)
                  DO WHILE (Iatdh.eq.IAt0)
                     IIatdh=IIatdh+1
                     IAtdh=Lies_CF(IAtv,IIatdh)
                  END DO
                  IF (IAtdh.eq.0) IAtdh=Lies_CP(IAtv,1)
                  IF (debug) WRITE(IOOUT,*) 'IAtdh:',IAtdh
                  Izm=Izm+1
                  Call AddLigne(Izm,IAti,IAtd,IAtv,IAtdh, &
                       ind_zmat,val_zmat,x,y,z)
!     Le traitement des autres est plus facile
                  IAtdh=Lies_CF(IAt0,ITmp)
                  DO IAta=ITmp+1,Lies_CF(IAt0,0)
                     IAtI=Lies_CF(IAt0,IAta)
                     If (.NOT.DejaFait(IAtI)) THEN
                        Izm=Izm+1
                        Call AddLigne(Izm,IAti,IAtd,IAtv,IAtdh, &
                             ind_zmat,val_zmat,x,y,z)
                     END IF
                  END DO
               END IF

!     On ajoute les atomes lies a cet atome dans la liste a faire
               Do iaf=1,Lies_CF(IAt0,0)
                  CAfaire(IndFin)=Lies_CF(IAt0,Iaf)
                  IndFin=IndFin+1
               END DO
               CAfaire(IndFin)=0
            END IF
            IndAFaire=IndAFaire+1
         END DO
!12345    CONTINUE
      END DO

      if (debug) THEN
         WRITE(*,*) 'ind_zmat'
         DO I=1,na
            WRITE(*,'(1X,5I5)') (ind_zmat(i,j),j=1,5)
         END DO
      END IF



      if (debug) WRITE(*,*) "====================== Exiting Calc_zmat ==================="

    END SUBROUTINE Calc_Zmat

