subroutine liaison(bond,pref,dist)
use lewis_module
Use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(100):: bond,bond0
character pref

! en entree : b AT1-AT2 ou  AT1=AT2 ou  AT1~AT2 ou  AT1^AT2 ou 
! b AT1-AT1 ...
yw=.false.
yw=(yw.or.nprint==5).and..not.nprint==-5
if(yw)print*,'entree liaison'

! en entree : BOND AT1-AT2 ou BOND AT1=AT2 ou BOND AT1~AT2 ou
! ou BOND AT1^AT2 ou BOND AT1-AT2 ou BOND AT1=AT2 ou ...
rewind 21
i=index(BOND,'=')
j=index(BOND,'~')

!k=index(suppdata,'LABEL=')
!if(k>0) prefix_label_OL=suppdata(k+7:k+7)
!if(prefix_label_OL==' ') prefix_label_OL='O'
prefix_label_OL=pref
if(pref==' ') prefix_label_OL='O'

if(index(BOND,'-')/=0) then
   call liaisonS(bond,dist)
else if(index(BOND,'=')/=0) then
   call liaisonS(bond,dist)
   call liaisonP(bond)
else if(index(BOND,'^')/=0) then
   call liaisonP(bond)
else if(index(BOND,'~')/=0) then
   call liaisonS(bond,dist)
   call liaisonT(bond)
endif

if(yw)print*,'sortie liaison'
end
!
!Liaison Sigma portee par les OA 2S,2p
!
 subroutine liaisonS(bond,dist)
use lewis_module
Use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*):: bond
character(6) :: atom1,atom2
real(8) ::L,dx,dy,dz
integer::inde,natom1,natom2
integer,dimension(8):: numero
real(8),dimension(8)::co
integer cherche_at,cherche_at0
character(2) :: list_atoms(100),cha1,cha2
character :: chiffre(10)=(/'0','1','2','3','4','5','6','7','8','9'/)
yw=.false.
yw=(yw.or.nprint==5).and..not.nprint==-5
if(yw)print*,'entree liaisonS bond=',trim(bond)

list_atoms=' '
list_atoms(1:8)=  (/'LI','BE','B ','C ','N ','O ','F ','NE'/)
list_atoms(9:16)=  (/'NA','MG','AL','SI','P ','S ','CL','AR'/)


! on analyse la donnee :
!B A1-A2  ('-' ou '='  ou '~'  ou '^' )
! on cherche les atomes A1 et A2, leurs coordonnees ...
inde=index(BOND,'-')+index(BOND,'=')+index(BOND,'~') &
+index(BOND,'^')
atom1=bond(:inde-1)
atom2=bond(inde+1:)
if(yw)print*,'atomes ',atom1,atom2
natom1=cherche_at(atom1)
natom2=cherche_at(atom2)
if(yw)print*,'numeros des atomes ',natom1,natom2
dx=coord(1,natom2)-coord(1,natom1)
dy=coord(2,natom2)-coord(2,natom1)
dz=coord(3,natom2)-coord(3,natom1)
dist=sqrt(dx*dx+dy*dy+dz*dz)
print'(a,a,f10.6,a)','BOND:  ['//bond(1:6)//' '//bond(7:7)//' ' &
//bond(8:13),']   Dist=',dist*0.529177249,' Bohr'
numero=0


!---------------------------------------------
! longueur du nom des atomes, sans leur numero
!---------------------------------------------
do i=1,4
   if(any(atom1(i:i)==chiffre(:)).or.atom1(i:i)==' ') then
      long_atom1=i-1
      exit
   endif
enddo
do i=1,4
   if(any(atom2(i:i)==chiffre(:)).or.atom2(i:i)==' ') then
      long_atom2=i-1
      exit
   endif
enddo
if(yw)print*,'long_atom1,long_atom2',long_atom1,long_atom2


!--------------------------------------
!Nombre d'OA dans la liaison consideree
!--------------------------------------
nb_AO_in_bond=0
if(atom1(1:long_atom1)=='H') then
   nb_AO_in_bond=nb_AO_in_bond+1
else
   nb_AO_in_bond=nb_AO_in_bond+4
endif
if(atom2(1:long_atom2)=='H') then
   nb_AO_in_bond=nb_AO_in_bond+1
else
   nb_AO_in_bond=nb_AO_in_bond+4
endif
if(yw) print*,'nb_AO_in_bond',nb_AO_in_bond


!-------------------------------------------------------------
! numero des OA de la liaison dans la base d'OA de la molecule
!-------------------------------------------------------------
! 1) orbitales 1s
!H 1s
numero(1)=numero_OA(atom1,'1S')
!H 1s
numero(2)=numero_OA(atom2,'1S')
cha1=' '
cha1(1:long_atom1)=atom1(1:long_atom1)
cha2=' '
cha2(1:long_atom2)=atom2(1:long_atom2)

! 2) Orbitales 2s, 2p
if(any(cha1==list_atoms(1:8)(1:2))) then
    numero(1)=numero_OA(atom1,'1S')+1
    numero(3)=numero_OA(atom1,'2PX')
    numero(5)=numero_OA(atom1,'2PY')
    numero(7)=numero_OA(atom1,'2PZ')
end if
if(any(cha2==list_atoms(1:8)(1:2))) then
     numero(2)=numero_OA(atom2,'1S')+1
     numero(4)=numero_OA(atom2,'2PX')
     numero(6)=numero_OA(atom2,'2PY')
     numero(8)=numero_OA(atom2,'2PZ')
 end if

! 2) Orbitales 3s, 3p
if(any(cha1==list_atoms(9:16)(1:2))) then
    numero(1)=numero_OA(atom1,'1S')+2
    numero(3)=numero_OA(atom1,'2PX')+1
    numero(5)=numero_OA(atom1,'2PY')+1
    numero(7)=numero_OA(atom1,'2PZ')+1
end if
if(any(cha2==list_atoms(9:16)(1:2))) then
    numero(2)=numero_OA(atom2,'1S')+2
    numero(4)=numero_OA(atom2,'2PX')+1
    numero(6)=numero_OA(atom2,'2PY')+1
    numero(8)=numero_OA(atom2,'2PZ')+1
end if


!----------------------------------------
!on ecrit ds la matrice l'orbitale liante
! et on genere l'info correspondante
!----------------------------------------

if(only==' '.or.only=='OCC') then
   iorb=iorb+1
   ! info concernant l'OL
   occupat(iorb)=.TRUE.
   focvir(iorb)='OCC'
   fsigpi(iorb)='SIG'
   if(atom1(1:4)==atom2(1:4)) then
      fnat(iorb)=1
      atoms_in_LO(iorb,1)=atom1(1:4)
   else
      fnat(iorb)=2
      atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
   endif
   noc=noc+1
   label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.SIG'
   print'(a4,2x,a16,3x,a,i8)','Gen:','  sig L: ',label_OL_temp(iorb) &
   ,iorb
   
   ! coefs de l'OL
   L=SQRT(dx**2+dy**2+dz**2)
   co=0.D0
   ! 1) s
   co(1)=1.D0
   co(2)=1.D0
   ! 2) p
   !if(any(atom1(1:long_atom2)==list_atoms(:)(1:long_atom1))) then
      co(3)=dx/L
      co(5)=dy/L
      co(7)=dz/L
   !end if
   !if(any(atom2(1:long_atom2)==list_atoms(:)(1:long_atom2))) then
      co(4)=-dx/L
      co(6)=-dy/L
      co(8)=-dz/L
   !end if
   Do i=1,nb_AO_in_bond
      ! stocker l'OL dans ORB
      if(numero(i)/=0) ORB(numero(i),iorb)=co(i)
      ! signaler dans diff que l'OA a ete utilisee, et ne generera
      ! donc pas de diffuse T_... 
      if(numero(i)/=0) diff(numero(i))=.FALSE.
   end do
   do i=1,norb
      if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
   enddo
endif


!---------------------------------------------
! idem pour l'anti-liante
!---------------------------------------------

if(only==' '.or.only=='VIR') then
   iorb=iorb+1
   ! info concernant l'OL
   focvir(iorb)='VIRT'
   fsigpi(iorb)='SIG'
   if(atom1(1:4)==atom2(1:4)) then
      fnat(iorb)=1
      atoms_in_LO(iorb,1)=atom1(1:4)
   else
      fnat(iorb)=2
      atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
   endif
   label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.SIG*'
   print'(a4,2x,a16,3x,a,i8)','Gen:','  sig AL: ',label_OL_temp(iorb) &
   ,iorb
   
   ! coefs de l'OL
   L=SQRT(dx**2+dy**2+dz**2)
   co=0.D0
   co(1)=1.D0
   co(2)=-1.D0
   !if(any(atom1(1:long_atom1)==list_atoms(:)(1:long_atom1))) then
      co(3)=dx/L
      co(5)=dy/L
      co(7)=dz/L
   !end if
   !if(any(atom2(1:long_atom2)==list_atoms(:)(1:long_atom2))) then
       co(4)=dx/L
       co(6)=dy/L
       co(8)=dz/L
   !end if
   Do i=1,nb_AO_in_bond
      if(numero(i)>0) ORB(numero(i),iorb)=co(i)
   end do
   do i=1,norb
      if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
   enddo
endif

if(yw)print*,'sortie liaisonS'
end
!
!Distribution entre liaisons Pi
!
 subroutine liaisonP(bond)
use lewis_module
use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*):: bond
integer::inde,natompro1,natompro2,atome_proche
character(6) :: atom1,atom2
integer cherche_at,cherche_at0
yw=.false.
yw=(yw.or.nprint==5).and..not.nprint==-5
if(yw)print*,'entree liaisonP'
if(yw)print*,'suppdata',trim(suppdata)
i=cherche_at(bond(1:6))
j=cherche_at(bond(8:13))

print'(a,a,f10.6,a)','BOND:  ['//bond(1:6)//' '//bond(7:7)//' ' &
//bond(8:13),']   Dist= ',distanc(i,j)*0.529177249,' Bohr'

if(index(BOND,'^')>0) then
   ind=index(suppdata,'PI=')
   if(ind>0) then
!     alors on a en donnee une liaison pi dont les axes sont donnes
      call liaisonPa(bond,ind)
      return
   endif
endif

! Recherche des atomes proches pour definir la direction des PI
! (perpendiculaires au plan)
inde=index(BOND,'-')+index(BOND,'=')+index(BOND,'~') &
+index(BOND,'^')
atom1=bond(:inde-1)
atom2=bond(inde+1:)
natom1=cherche_at(atom1)
natom2=cherche_at(atom2)
natompro1=atome_proche(natom1,natom2)
natompro2=atome_proche(natom2,natom1)
if (natompro1==0 .OR. natompro2==0) then
!   il n'y a qu'un atome proche
    if(yw) print*,'appel liaisonPO'
    call liaisonPO(bond)
else
!   il y a deux atomes proches (chaque atome a le sien)
    if(yw) print*,'appel liaisonPC'
    call liaisonPC(bond)
end if
if(yw)print*,'sortie liaisonP'
end
!
!Liaison P type dont les axes sont donnes
!
 subroutine liaisonPa(bond,ind)
use lewis_module
Use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*):: bond
character(6) :: atom1,atom2
real(8),dimension(3) :: vecpi
integer,dimension(8):: numero
character(6) :: suffix
yw=.false.
if(yw)print*,'entree liaisonPa'
inde=index(BOND,'^')
atom1=bond(:inde-1)
atom2=bond(inde+1:)
numero(1)=numero_OA(atom1,'2PX')
numero(2)=numero_OA(atom1,'2PY')
numero(3)=numero_OA(atom1,'2PZ')
numero(4)=numero_OA(atom2,'2PX')
numero(5)=numero_OA(atom2,'2PY')
numero(6)=numero_OA(atom2,'2PZ')

!ecriture pi liante
iorb=iorb+1
focvir(iorb)='OCC'
fsigpi(iorb)='PI'
if(atom1(1:4)==atom2(1:4)) then
   fnat(iorb)=1
   atoms_in_LO(iorb,1)=atom1(1:4)
else
   fnat(iorb)=2
   atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
endif
suffix='PI'
ind1=index(suppdata,'SUFFIX=')
if(ind1/=0) then
   ind1=ind1+7
   ind2=index(suppdata(ind1:),',')+ind1-1
   if(ind2==ind1-1) ind2=len_trim(suppdata)
   suffix=suppdata(ind1:ind2)
endif
label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.'// &
trim(suffix)
occupat(iorb)=.TRUE.
noc=noc+1
call repl(suppdata,',',' ',yrepl)
call repl(suppdata,',',' ',yrepl)
call repl(suppdata,',',' ',yrepl)
read(suppdata(ind+3:),*) vecpi
print'(a,3f10.6)','Axe PI (en donnee) :',vecpi
print'(a4,2x,a16,3x,a,i8)','Gen:','  pi L: ',label_OL_temp(iorb) &
,iorb
do i=1,3
   ORB(numero(i),iorb)=vecpi(i)
   diff(numero(i))=.FALSE.
end do
do i=4,6
   ORB(numero(i),iorb)=vecpi(i-3)
   diff(numero(i))=.FALSE.
end do
do i=1,norb
   if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
enddo
iorb=iorb+1     !ecriture pi anti-liante
focvir(iorb)='VIRT'
fsigpi(iorb)='PI'
if(atom1(1:4)==atom2(1:4)) then
   fnat(iorb)=1
   atoms_in_LO(iorb,1)=atom1(1:4)
else
   fnat(iorb)=2
   atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
endif
label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.'// &
trim(suffix)
print'(a4,2x,a16,3x,a,i8)','Gen:','  pi AL: ',label_OL_temp(iorb) &
,iorb
do i=1,3
   ORB(numero(i),iorb)=vecpi(i)
end do
do i=4,6
   ORB(numero(i),iorb)=-vecpi(i-3)
end do
do i=1,norb
   if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
enddo
end
!                                         C
!Liaison P type O (1 seul atome proche)      C = O (::)
!                                         C
 subroutine liaisonPO(bond)
use lewis_module
Use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*):: bond
integer::inde,natompro1,natompro2,atome_proche
character(6) :: atom1,atom2
real(8),dimension(3) :: vecpi
integer,dimension(8):: numero
integer cherche_at,cherche_at0
yw=.false.
if(yw)print*,'entree liaisonPO'
inde=index(BOND,'-')+index(BOND,'=')+index(BOND,'~') &
+index(BOND,'^')
atom1=bond(:inde-1)
atom2=bond(inde+1:)
natom1=cherche_at(atom1)
natom2=cherche_at(atom2)
natompro1=atome_proche(natom1,natom2)
natompro2=atome_proche(natom2,natom1)
if(yw) then
   print*,'liaisonPO: atom1,atom2',atom1,atom2
   print*,'liaisonPO: natom1,natom2',natom1,natom2
   print*,'liaisonPO: natompro1,natompro2',natompro1,natompro2
endif
if (natompro1/=0) then
    call produit_vect(natompro1,natom1,natom2,vecpi)
else if (natompro2/=0) then
    call produit_vect(natompro2,natom2,natom1,vecpi)
else
    print*,'ERREUR A RESOUDRE'
end if
print'(a,3f10.6)','Axe PI :',vecpi
numero(1)=numero_OA(atom1,'2PX')
numero(2)=numero_OA(atom1,'2PY')
numero(3)=numero_OA(atom1,'2PZ')
numero(4)=numero_OA(atom2,'2PX')
numero(5)=numero_OA(atom2,'2PY')
numero(6)=numero_OA(atom2,'2PZ')
if(only==' '.or.only=='OCC') then
   iorb=iorb+1   !ecriture pi liante
   focvir(iorb)='OCC'
   fsigpi(iorb)='PI'
   if(atom1(1:4)==atom2(1:4)) then
      fnat(iorb)=1
      atoms_in_LO(iorb,1)=atom1(1:4)
   else
      fnat(iorb)=2
      atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
   endif
   label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI'
   print'(a4,2x,a16,3x,a,i8)','Gen:','  pi L: ',label_OL_temp(iorb) &
   ,iorb
   occupat(iorb)=.TRUE.
   noc=noc+1
   do i=1,3
      ORB(numero(i),iorb)=vecpi(i)
      diff(numero(i))=.FALSE.
   end do
   do i=4,6
      ORB(numero(i),iorb)=vecpi(i-3)
      diff(numero(i))=.FALSE.
   end do
   do i=1,norb
      if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
   enddo
endif
if(only==' '.or.only=='VIR') then
   iorb=iorb+1     !ecriture pi anti-liante
   focvir(iorb)='VIRT'
   fsigpi(iorb)='PI'
   if(atom1(1:4)==atom2(1:4)) then
      fnat(iorb)=1
      atoms_in_LO(iorb,1)=atom1(1:4)
   else
      fnat(iorb)=2
      atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
   endif
   label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI*'
   print'(a4,2x,a16,3x,a,i8)','Gen:','  pi AL: ',label_OL_temp(iorb) &
   ,iorb
   do i=1,3
      ORB(numero(i),iorb)=vecpi(i)
   end do
   do i=4,6
      ORB(numero(i),iorb)=-vecpi(i-3)
   end do
   do i=1,norb
      if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
   enddo
endif
end


!                              C         C
!Liaison P a 2 atomes proches     C = C
!                              C         C
 subroutine liaisonPC(bond)
use lewis_module
Use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*):: bond
character(6) :: atom1,atom2
real(8),dimension(3) :: prov1,prov2,vecpi
real(8),allocatable,dimension(:) :: L
integer::natompro1,natompro2,atome_proche,cherche_at
integer,dimension(8):: numero
yw=.false.
if(yw)print*,'entree liaisonPC'
allocate(L(Natom))
inde=index(BOND,'-')+index(BOND,'=')+index(BOND,'~') &
+index(BOND,'^')
atom1=bond(:inde-1)
atom2=bond(inde+1:)
natom1=cherche_at(atom1)
natom2=cherche_at(atom2)
natompro1=atome_proche(natom1,natom2)
natompro2=atome_proche(natom2,natom1)
if(yw) then
   print*,'liaisonPO: atom1,atom2  ',atom1,' | ',atom2
   print*,'liaisonPO: natom1,natom2',natom1,natom2
   print*,'liaisonPO: natompro1,natompro2',natompro1,natompro2
endif
call produit_vect(natompro1,natom1,natom2,prov1)
!      call produit_vect(natom1,natom2,natompro2,prov2)
!      vecpi=(prov1+prov2)/2
vecpi=prov1
print'(a,3f10.6)','Axe PI :',vecpi
numero(1)=numero_OA(atom1,'2PX')
numero(2)=numero_OA(atom1,'2PY')
numero(3)=numero_OA(atom1,'2PZ')
numero(4)=numero_OA(atom2,'2PX')
numero(5)=numero_OA(atom2,'2PY')
numero(6)=numero_OA(atom2,'2PZ')
if(only==' '.or.only=='OCC') then
   iorb=iorb+1   !ecriture pi liante
   focvir(iorb)='OCC'
   fsigpi(iorb)='PI'
   if(atom1(1:4)==atom2(1:4)) then
      fnat(iorb)=1
      atoms_in_LO(iorb,1)=atom1(1:4)
   else
      fnat(iorb)=2
      atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
   endif
   label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI'
   print'(a4,2x,a16,3x,a,i8)','Gen:','  pi L: ',label_OL_temp(iorb) &
   ,iorb
   occupat(iorb)=.TRUE.
   noc=noc+1
   do i=1,3
      ORB(numero(i),iorb)=vecpi(i)
      diff(numero(i))=.FALSE.
   end do
   do i=4,6
      ORB(numero(i),iorb)=vecpi(i-3)
      diff(numero(i))=.FALSE.
   end do
   do i=1,norb
      if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
   enddo
endif
if(only==' '.or.only=='VIR') then
   iorb=iorb+1     !ecriture pi anti-liante
   focvir(iorb)='VIRT'
   fsigpi(iorb)='PI'
   atoms_in_LO(iorb,1:2)=(/atom1(1:4),atom2(1:4)/)
   if(atom1(1:4)==atom2(1:4)) then
      fnat(iorb)=1
      atoms_in_LO(iorb,1)=atom1(1:4)
   else
      fnat(iorb)=2
      atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
   endif
   label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI*'
   print'(a4,2x,a16,3x,a,i8)','Gen:','  pi AL: ',label_OL_temp(iorb) &
   ,iorb
   do i=1,3
      ORB(numero(i),iorb)=vecpi(i)
   end do
   do i=4,6
      ORB(numero(i),iorb)=-vecpi(i-3)
   end do
   do i=1,norb
      if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
   enddo
endif
end
!
!Liaison T
!
 subroutine liaisonT(bond)
use lewis_module
Use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*):: bond
character(6) :: atom1,atom2
real(8),dimension(3) :: prov,d,cart
real(8),allocatable,dimension(:) :: L
integer,dimension(6):: numero
REAL(8),dimension(6):: co
integer cherche_at,cherche_at0
allocate(L(Natom))
inde=index(BOND,'-')+index(BOND,'=')+index(BOND,'~') &
+index(BOND,'^')
atom1=bond(:inde-1)
atom2=bond(inde+1:)
natom1=cherche_at(atom1)
natom2=cherche_at(atom2)
do j=1,3
d(j)=coord(j,natom2)-coord(j,natom1)
end do
if(d(2)/=0) then
   cart(1)=1
   cart(2)=-(d(1)/d(2))
   cart(3)=0
else if(d(1)/=0) then
   cart(1)=-(d(2)/d(1))
   cart(2)=1
   cart(3)=0
else
   cart(1)=1
   cart(2)=0
   cart(3)=0
end if
numero(1)=numero_OA(atom1,'2PX')
numero(2)=numero_OA(atom1,'2PY')
numero(3)=numero_OA(atom1,'2PZ')
numero(4)=numero_OA(atom2,'2PX')
numero(5)=numero_OA(atom2,'2PY')
numero(6)=numero_OA(atom2,'2PZ')
co(1)=cart(1)
co(2)=cart(2)
co(3)=cart(3)
co(4)=co(1)
co(5)=co(2)
co(6)=co(3)
iorb=iorb+1
focvir(iorb)='OCC'
fsigpi(iorb)='PI'
if(atom1(1:4)==atom2(1:4)) then
   fnat(iorb)=1
   atoms_in_LO(iorb,1)=atom1(1:4)
else
   fnat(iorb)=2
   atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
endif
occupat(iorb)=.TRUE.
noc=noc+1
label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI1'
print'(a4,2x,a16,3x,a,i8)','Gen:', &
'  Triple_piL: ',label_OL_temp(iorb) &
,iorb
do i=1,6
   ORB(numero(i),iorb)=co(i)  !écrit la premiere pi liante
   diff(numero(i))=.FALSE.
end do
do i=1,norb
   if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
enddo
co(4)=-co(1)
co(5)=-co(2)
co(6)=-co(3)
iorb=iorb+1
focvir(iorb)='VIRT'
fsigpi(iorb)='PI'
if(atom1(1:4)==atom2(1:4)) then
   fnat(iorb)=1
   atoms_in_LO(iorb,1)=atom1(1:4)
else
   fnat(iorb)=2
   atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
endif
label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI1*'
print'(a4,2x,a16,3x,a,i8)','Gen:', &
'  Triple_pi AL: ',label_OL_temp(iorb) &
,iorb
do i=1,6
   ORB(numero(i),iorb)=co(i)  !écrit la premiere pi anti-liante
end do
do i=1,norb
   if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
enddo
!seconde liaison pi
call produit_vectoriel(d,cart,prov)
co(1)=prov(1)
co(2)=prov(2)
co(3)=prov(3)
co(4)=co(1)
co(5)=co(2)
co(6)=co(3)
iorb=iorb+1
focvir(iorb)='OCC'
fsigpi(iorb)='PI'
if(atom1(1:4)==atom2(1:4)) then
   fnat(iorb)=1
   atoms_in_LO(iorb,1)=atom1(1:4)
else
   fnat(iorb)=2
   atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
endif
label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI2'
print'(a4,2x,a16,3x,a,i8)','Gen:', &
'  Triple_pi L: ',label_OL_temp(iorb) &
,iorb
occupat(iorb)=.TRUE.
noc=noc+1
do k=1,6
   ORB(numero(k),iorb)=co(k)  !écrit la seconde pi liante
end do
do i=1,norb
   if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
enddo
co(4)=-co(1)
co(5)=-co(2)
co(6)=-co(3)
iorb=iorb+1
focvir(iorb)='VIRT'
fsigpi(iorb)='PI'
if(atom1(1:4)==atom2(1:4)) then
   fnat(iorb)=1
   atoms_in_LO(iorb,1)=atom1(1:4)
else
   fnat(iorb)=2
   atoms_in_LO(iorb,1:fnat(iorb))=(/atom1(1:4),atom2(1:4)/)
endif
label_OL_temp(iorb)=prefix_label_OL//'_'//atom1//atom2//'.PI2*'
print'(a4,2x,a16,3x,a,i8)','Gen:', &
'  Triple_pi AL: ',label_OL_temp(iorb) &
,iorb
do ii=1,6
   ORB(numero(ii),iorb)=co(ii)  !écrit la seconde pi anti-liante
end do
do i=1,norb
   if(abs(orb(i,iorb))>1.d-6)print'(a,f10.6)',label(i),orb(i,iorb)
enddo
end
