SUBROUTINE WriteMixed_Gaussian(na,atome,NCart,ind_zmat,val_zmat)
!----------------------------------------------------------------------
!  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 :   Nom
  Use Io_module

  IMPLICIT NONE
! Parameters of the subroutine
! na: number of atoms in the system
  integer(KINT), INTENT(IN) ::  na
! atome: Mass number of the atoms of the system
  integer(KINT), INTENT(IN) ::  atome(na)
! nCart: number of atoms described in cartesian
  integer(KINT), INTENT(IN) ::  NCart
! ind_zmat: for "zmat" atoms contains the indices of reference atoms
  integer(KINT), INTENT(IN) ::  ind_zmat(Na,5)
! val_zmat: for "zmat" atoms contains the values from reference atoms
  real(KREAL), INTENT(IN)   :: val_zmat(Na,3)

  character(6) :: at1, at2, at3, at4, d, a, dh
  Character(6) :: x,y,z
  character(SCHARS), ALLOCATABLE :: tab(:) ! 3*na
  character(LCHARS) :: ligne
  
  INTEGER(KINT) :: i,n1,n2,n3,n4, NZmat,ITab

  ALLOCATE(tab(3*na))

! We first write the Cartesian atoms

  DO I=1,NCart
! Name of the atom
     n1=ind_zmat(i,1)
     write(at1,11) nom(atome(n1)),n1
     Call CleanString(at1,' ')
! x
     write(x,11) 'x',i
     Call CleanString(x,' ')

     write(tab(3*i-2),'(A,1X,F12.8)') trim(x),val_zmat(i,1)
! y
     write(y,11) 'y',i
     Call CleanString(y,' ')
     write(tab(3*i-1),'(A,1X,F12.8)') trim(y),val_zmat(i,2)
! z
     write(z,11) 'z',i
     Call CleanString(z,' ')
     write(tab(3*i),'(A,1X,F12.8)') trim(z),val_zmat(i,3)
! write the line
     write(ligne,'(1X,A,1X,A,1X,A,1X,A)') Trim(at1),x,y,z
     write(IOOUT,*) TRIM(ligne)
  END DO

  NZmat=na-NCart
  ITab=3*NCart+1

  DO i=NCart+1,NZmat
     IF (i .GE. 1)  THEN
        n1=ind_zmat(i,1)
        write(at1,11) nom(atome(n1)),n1
11      format(a2,i3)
        Call CleanString(at1,' ')
        write(ligne,4) at1
     END IF
     IF (i .GE. 2)  THEN
        n2=ind_zmat(i,2)
        write(at2,11) nom(atome(n2)),n2
        Call CleanString(At2,' ')
        write(d,11) 'R',i-1
        Call CleanString(D,' ')
        write(ligne,4) at1,at2,d
        write(tab(ITab),12) d,val_zmat(i,1)
        ITab=ITab+1
12      format(a8,f8.4)
     END IF
     IF (i .GE. 3)  THEN
        n3=ind_zmat(i,3)
        write(at3,11) nom(atome(n3)),n3
        Call CleanString(At3,' ')
        write(a,11) 'A',na+i-3
        Call CleanString(A,' ')
        write(ligne,4) at1,at2,d,at3,a
        write(tab(ITab),13) a,val_zmat(i,2)
        ITab=ITab+1
13      format(a8,f8.3)
     END IF
     IF (i .GE. 4)  THEN
        n4=ind_zmat(i,4)
        write(at4,11) nom(atome(n4)),n4
        Call CleanString(At4,' ')
        write(dh,11) 'DH',na+na+i-6
        Call CleanString(dh,' ')
        write(ligne,4) at1,at2,d,at3,a,at4,dh
4       format(7a6)
        write(tab(ITab),13) dh,val_zmat(i,3)
        ITab=ITab+1
     END IF
     write(IOOUT,*) TRIM(ligne)
     END DO
     
     write(IOOUT,*)
     DO i=1,ITab
        write(IOOUT,*) TRIM(tab(i))
     END DO
     write(IOOUT,*)

     DEALLOCATE(Tab)

   END SUBROUTINE WriteMixed_Gaussian
