      subroutine orbiliens
C      use module
C      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
C      character(10000) namel
C      allocatable yac(:)
Cc
Cc---------------------------------------------------------------
Cc Definition de liens entre les orbitales
C!  1. entre occ et virt   critere Kij, ou voisins
C!  2. entre virt et virt : s'il existe o / o-v1 et o-v2
C!  3. entre occ et occ, idem
Cc---------------------------------------------------------------
Cc
C!
C! Lecture donnees
C!
C      yw=.false.
C      if(liens==' ') return
C      rewind 93
C      call LECNAM('&IJKLOC ',namel,93,ierr,0)
C      call namela(namel,CRITER,'CRITER')
C      call nameli(namel,NOAC,'NOAC',4)
C      call nameli(namel,NUMAC,'NUMAC',4)
C      call nameld(namel,SL,'SL',8)
C!
C! allocation
C!
C      allocate(yl(norb,norb))
C      allocate(ylc(norb))
C      allocate(yac(norb))
C      yl=.false.
C      ylc=.false.
C!
C! yac
C!
C      yac=.false.
C      yac(numac)=.true.
C!
C! Non actives/Actives
C!
C      if(liens=='KIJ') then
C         do i=1,norb
C            do ia=1,noac
C               ja=numac(ia)
C               if(aijij(min(i,ia),max(i,ia))>=sl) then
C                  ylc(i)=.true.
C                  exit
C               endif
C            enddo
C         enddo
C      else
C         print*,'valeur de "liens" non prevue ',liens
C      endif
C!
C! O/V
C!
C      if(liens=='KIJ') then
C         extiv: do iv=noc+1,norb
C            if(yac(iv)) cycle
C            do io=1,noc
C               if(yac(io)) cycle
C               yl(io,iv)=aijij(io,iv)>=sl
C               yl(iv,io)=yl(io,iv)
C               cycle extiv
C            enddo
C            if(ylc(io).and.ylc(iv)) then
C               yl(io,iv)=aijij(io,iv)>=sl
C               yl(iv,io)=yl(io,iv)
C               cycle extiv
C            endif
C         enddo extiv
C      else
C      endif
C!
C! O/O
C!
C      do io1=1,noc
C         exto2: do io2=1,io1-1
C            do iv=noc+1,norb
C               if(yl(io1,iv).and.yl(io2,iv)) then
C                  yl(io1,io2)=.true.
C                  yl(io2,io1)=.true.
C                  cycle exto2
C               endif
C            enddo
C         enddo exto2
C      enddo
C!
C! V/V
C!
C      do iv1=noc+1,norb
C         extv2: do iv2=noc+1,iv1-1
C            do io=noc+1,norb
C               if(yl(iv1,io).and.yl(iv2,io)) then
C                  yl(iv1,iv2)=.true.
C                  yl(iv2,iv1)=.true.
C                  cycle extv2
C               endif
C            enddo
C         enddo extv2
C      enddo
C      deallocate(yl,ylc,yac)
C         
      return
      end
