      subroutine deloc(AA)
      use mod_dolo
      use mod_deloc
      use mod_script
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! multatloc(atom): number of equivalent atoms due to the symmetry
! multlo            number of equivalent bonds due to the symmetry
! (multlo(bond)     =max(multatloc(atom),multatloc(atom+1)))
!                  operations
! sig(bond)      : number of sigma on bond
! pi(bond)       : number of pi on bond
! mult = sig + pi: multiplicity of bond
! lp(atom)       : number of lone pairs on atom
! vi(atom)       : number of atomic virtuals on atom
! sy(atom)       : if(/=0): atom is bonded to itself (by symmetry)
!                  with a bond of multiplicity sy(atom)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character(dim_datlist) :: AA,bb
      logical del
      character(1000) chain
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      integer noc,nvirt
      yw=.false.
      if(yes) print*,'entree deloc'
      in_progress='DELOC'
      rewind 94
      l=len_trim(AA)
      if(l+3>dim_datlist) stop'increase dim_datlist'
      if(AA(l:l).ne.',') AA(l+1:l+1)=','
      AA(l+3:l+3)='/'
      bb=aa
!
!----------
! Read data
!----------
!
      if(yw)print*,'AA  ',trim(aa)
      nn=2
      chain=' '
      label1='o'
      para=' '
      orth=' '
      call namela(AA,CHAIN,'CHAIN')
      call nameli(AA,noc,'NOC',4)
      call nameli(AA,NVIRT,'NVIRT',4)
      call namela(AA,LABEL1,'LABEL')
      call namela(AA,PARA,'PARA')
      call namela(AA,ORTH,'ORTH')
!
!-----------------------
! interpretation of data
!-----------------------
!
      ! interpret CHAIN
      nn=1
      do while (index(chain,'-')/=0)
         call repl(chain,'-',''',''',yrepl)
         nn=nn+1
      enddo
      if(yw)print*,'nn',nn
!
!-----------------------
! Allocations
!-----------------------
!
      allocate(atomloc(nn))
      allocate(basloc(nn))
      l=len_trim(chain)
!
!-----------------------
! Read data "chain"
!-----------------------
!
      chain(8:l+7)=chain(1:l)
      chain(1:7)='ATOMS='''
      do while (index(chain,'-')/=0)
         call repl(chain,'-',''',''',yrepl)
      enddo
      l=len_trim(chain)
      chain(l+1:l+1)=''''
      if(yw)print*,trim(chain)
      call namela(chain,atomloc,'ATOMS')
      call namela(AA,basloc,'BAS')
      if(yw) then
         do k=1,nn
            print*,'atomloc ',atomloc(k),' ',basloc(k)
         enddo
      endif
!
!-----------------------
! build basic data
!-----------------------
!
      call faidatd('DL',atomloc,basloc,bb,noc,nvirt,label1,nn,orth,para)
      deallocate(atomloc,basloc)
      return
      end
       subroutine faidatd(a,atomloc,basloc,bb,noc,nvirt,label1,n
     *,orth,para)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! builds a canonic (basic) data line
! a: suffix of the label  (LP SP SG ...)
! atomloc: atom names     ('C' 'H')
! basloc: basis names     ('1s(2) 2p(1)' '1s(1))
! bb (output): canonic data line
! iocc,ivirt: number of bonding and anti-bonding orbitals
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      use mod_dolo
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character(dim_datlist) :: bb
      character(2) a
      character(4) atomloc(*)
      character(80) basloc(*)
      character(1) label1
      character(15) orth,para
      yw=.false.
      if(yes)print*,'entree faidatd  '
! ecriture du label
      bb=label1//'_'//trim(atomloc(1))//'~'//trim(atomloc(n))
      bb=trim(bb)//'.'//a
! ecriture des atomes et de leur base
      do k=1,n
         ll=len_trim(bb)
         la=len_trim(atomloc(k))
         lb=len_trim(basloc(k))
         bb(ll+2:ll+la+lb+5)=
     *   trim(atomloc(k))//' '//trim(basloc(k))//' :'
      enddo
! on efface le dernier ":"
      ll=len_trim(bb)
      bb(ll:ll)=' '
! on ecrit les occupations
      bb=trim(bb)//' ('
      ll=len_trim(bb)
      write(bb(ll+1:ll+8),'(2i4)') noc,nvirt
      ll=len_trim(bb)
      bb(ll+1:ll+1)=')'
      if(yw)print*,'bb  ',trim(bb)
      call fnormaligo(bb,ll)
      if(yw)print*,'bb  ',trim(bb)
      do k=1,3
         call repl(bb,'( ','(',yrepl)
         if(.not.yrepl) exit
      enddo
      if(para/=' ') then
         l=len_trim(bb)
         bb(l+2:)='PARA('//trim(para)//')'
      endif
      if(orth/=' ') then
         l=len_trim(bb)
         bb(l+2:)='ORTH('//trim(orth)//')'
      endif
      write(94,'(a)') bb
      if(yw)print*,'basic data  ',trim(bb)
      if(yes)print*,'sortie faidatd   '
      return
      end
