      subroutine faido(ideb)
!
!------------------------------------------------------------
!     traitement du fichier de donnees pour la base atomique
!------------------------------------------------------------
!
      use mod_dolo
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character*3000 orb
c      common /don/ nl,numina(nfix),numac(nfix),ninac,noac
      character*4 atom1,orb1
      integer,dimension(:),allocatable :: ii
c      character*8 orbi(nfix)
c      common/bas/ orbi,nbas(nfix),nbast(0:nfix),natom,atom,base
c      character*8 base(nfix)
c      character*4 atom(100)
      dimension ideb(norb+1,maxsym)
c      common/typ/ itype(nfix),ntyp
c      common/densch/occ(nfix)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      common/version/molcas,i_rec,i_at,i_orb,i_coo
      common/pr/nprint
      character(8) base1
 
      allocate(ii(norb))
      allocate(occ(norb))
      yw=.false.
      itype(1:norb)=0
      if(yw)print*,'entree faido'
      call LECNAM('&OAO ',orb,93,ierr,0)
      if(ierr==1) then
         print*,'no &OAO namelist in DOLOIN'
         stop
      endif
      open(96,status='unknown',file='BID96')
!
! Verification et normalisation des donnees DOLOIN
!
      do
         read(93,'(a)',end=1111) orb
         orb=adjustl(orb)
         long=len_trim(orb)
         call maj(orb,long)
         call versionm(molcas,orb)
         if(orb(1:3).eq.'FIN') exit
         long=len_trim(orb)
         if(yw)print*,'apres repl orb ',orb(1:long)
!         istel=index(orb(1:long),'[')
!         if(istel.ne.0) then
!            call multi3(istel,orb(1:long),long,96)
!         else
            write(96,'(a)') orb(1:long)
!          endif
         cycle
         continue
 1111    print*,'incomplete DOLOIN file'
         stop
      enddo
c
c     traitement des atomes multiples "*"
c
      rewind 96
 33   continue
      open(95,status='unknown',file='BID95')
      do
         read(96,'(a)',end=34) orb
         orb=adjustl(orb)
         long=len_trim(orb)
         istel=index(orb,'*')
c         print*,'Istel,orb(1:ib-1),ib',istel,orb(1:ib-1),ib
         if(istel.ne.0) then
            call multi(natom,atom,orb,long,95,'  ',ibid)
         else
            write(95,'(a)') orb(1:long)
         endif
      enddo
 34   continue
      close(96,status='delete')
!--------------------------------------------------------------
!     on reordonne les donnees dans l'ordre de leur priorite
!--------------------------------------------------------------
      rewind 95
      nl=0
      do
         ytrouve=.false.
         read(95,'(a)',end=3) orb
         orb=adjustl(orb)
         long=len_trim(orb)
         call maj(orb,long)
         nl=nl+1
         jtyp=0
c        mise a la forme standard
         orb=adjustl(orb)
         if(orb(1:3).eq.'FIN') goto 3
         long=len_trim(orb)
         if(nprint.ge.1)print*,orb(1:long)
         call suppdb(orb,long)
         long=len_trim(orb)
c        lecture de l'occupation
         jj=index(orb(1:long),'OCC=')
         if(yw)print*,'jj',jj
         occ0=0.d0
         if(jj.ne.0) then
            kk=index(orb(jj:long),'=')+jj
            if(yw)print*,'kk',kk
            if(yw)print*,'1orb(kk:long)',orb(kk:long)
            read(orb(kk:long),*) occ0
            orb(jj:long)=' '
         endif
c        lecture de la priorite
         jj=index(orb(1:long),'PR')
         if(yw)print*,'jj',jj
         if(jj.ne.0) then
            kk=index(orb(jj:long),'=')+jj
            if(yw)print*,'kk',kk
            if(yw)print*,'2orb(kk:long)',orb(kk:long)
           print*,trim(orb)
            read(orb(kk:long),*) jtyp
         endif
         if(yw)print*,'jtyp',jtyp
c        lecture du nom de l'atome
         longat=index(orb(1:5),' ')-1
         atom1='    '
         atom1(1:longat)=orb(1:longat)
         if(yw)print*,'atome en donnee dans DOLOIN ','====',atom1,'===='
c        lecture de l'orbitale
         longorb=index(orb(longat+2:longat+7),'(')-1
         kdeb=longat+longorb+3
         kfin=index(orb,')')-1
c        if(yw)print*,'longat,longorb,orb',longat,longorb,trim(orb)
         if(yw)print*,'kdeb,kfin',kdeb,kfin
         read(orb(kdeb:kfin),*) num
         if(yw)print*,'num en donnee dans DOLOIN (dans les parentheses)'
     *   ,num,kdeb,kfin,trim(orb(kdeb:kfin))
         orb1='    '
         orb1(1:longorb)=orb(longat+2:longat+1+longorb)
         if(yw)print*,'orb en donnee dans DOLOIN  ',orb1
         io=0
         if(yw)print*,'nsym',nsym
         do is=1,nsym
            num1=0
            do ios=1,isym(is)
               io=io+1
               base1=orbi(io)
               call maj(base1,8)
               if(yw)print'(a,i2,3a,i2,2a)','sym ',is,
     *         '  on cherche : "',atom1//orb1,
     *         '" (numero',num,')  on lit "',base1//'"'
               if(base1.eq.atom1//orb1) num1=num1+1
!               if(yw)print*,'is,ios,num,num1',is,ios,num,num1
               if(num1.eq.num) then
                  itype(io)=jtyp
                  occ(io)=occ0
                  if(yw)print*,'io,jtyp',io,jtyp
                  io=isymt(is)
                  if(yw)print*,'TROUVE !'
                  ytrouve=.true.
                  goto 1
               endif
            enddo
 1          continue
         enddo
         if(.not.ytrouve) then
            print*,'donnees DOLOIN : indice d''atome non trouve : '
     *      ,atom1
            stop
         endif
 7      continue
      enddo
      if(yw)print*,'nl',nl
      if(nl.gt.norb) then
         print*,'on a genere plus de liaisons que d''orbitales'
         print*,nl,' liaisons'
         stop
      endif
 3    continue
      do k=1,norb
         if(yw)print*,'itype',k,itype(k)
      enddo
c     fin de la lecture des orbitales prioritaires
c     formations des classes de priorites
      ntyp=maxval(itype(1:norb))+1
      do k=1,norb
         if(itype(k).eq.0) itype(k)=ntyp
      enddo
      if(yw)print*,'ntyp',ntyp
      if(yw)print*,'itype',itype(1:norb)
      do is=1,nsym
!         yw=.true.
         ndims=isym(is)
         ndims0=isymt(is-1)
         if(yw)print*,'ndims,ndims0',ndims,ndims0
         ideb(1,is)=1
         ideb(2:norb+1,is)=0
         do k=1,ndims
            ideb(itype(k+ndims0)+1,is)=ideb(itype(k+ndims0)+1,is)+1
         enddo
         print*,'nombre d''orbitales par priorite   sym',is
         print'(20i4)',ideb(2:ntyp+1,is)
         do k=2,ntyp+1
            ideb(k,is)=ideb(k,is)+ideb(k-1,is)
         enddo
         if(yw)print*,'fin faido ideb',ideb(1:ntyp+1,is)
      enddo
c
      return
      end
       subroutine multi(natom,atom,orb,long,ifil,debut,nl)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character(*) orb
      character*3000 orb1
      character*4 atom(200),atom1
      character*2 debut
      yw=.false.
      orb1=orb
      istel=index(orb,'*')
      l=istel-1
      if(yw)print*,'dans multi orb',orb
      do iat=1,natom
         atom1=atom(iat)
         call maj(atom1,4)
         if(yw)print*,'iat,l,atom1,orb(1:l)  ',iat,l,' ',atom1,orb(1:l)
         if(atom1(1:l).eq.orb(1:l)
     *   .and.(index(' 0123456789',atom1(l+1:l+1)).ne.0)) then
            if(yw)print*,'apres test',atom1,trim(atom1),long
            call repl(orb,orb(1:istel),trim(atom1),yrepl)
            long=len_trim(orb)
c	    orb(1:4)=atom1
            if(yw)print*,'multi  ', orb(1:long)
            if(debut.eq.'  ') then
               write(ifil,'(a)') orb(1:long)
            else
               write(ifil,'(a)') debut//orb(1:long)
            endif
            orb=orb1
            nl=nl+1
         endif
      enddo
      return
      end
       subroutine multi2(natom,atom,istel,orb,orb1,nl1)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character*3000 orb,orb1
      character*4 atom(200),atom1
      l=istel-1
      do iat=1,natom
c         if(yw)print*,'iat',iat
         atom1=atom(iat)
         ll=len_trim(atom1)
         call maj(atom1,4)
c         if(yw)print*,'dans multi2 orb',orb
c         if(yw)print*,'dans multi2 atom1',atom1,ll,l,istel
         if(atom1(1:l).eq.orb(3:2+l)) then
            orb1=orb
            call repl(orb1,'*',atom1(istel:ll),yrepl)
c            if(yw)print*,'multi2 orb',orb
            write(94,'(a)') orb1
            nl1=nl1+1
c            if(yw)print*,'multi2 orb',orb1
         endif
c         if(yw)print*,'Multi2 return'
      enddo
c      if(yw)print*,'multi2 return'
      return
      end
       subroutine multi3(istel,orb,long,ifil)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character*3000 orb,r
      character*4 rr
      character*5 ii(20)
      yw=.false.
         l=istel+1
         m=index(orb(1:long),']')-1
         n=index(orb(l:m),',')
         if(yw)print*,'l,m,n',l,m,n
         if(n.eq.0) then
c           la donnee multiple est avec un "-"
            n=index(orb(l:m),'-')
            orb(l+n-1:l+n-1)=' '
            if(yw)print*,orb(l:m)
            if(yw)print*,orb(l+n-1:l+n-1)
            read(orb(l:m),*) i,j
            do k=i,j
               rr=' '
               write(rr,'(i4)') k
               rr=adjustl(rr)
               lrr=len_trim(rr)
               r=' '
               r(1:long)=orb(1:long)
               if(yw)print*,'repl1 ',r(l-1:m+1)
               if(yw)print*,'repl2 ',rr(1:lrr)
               call repl(r,r(l-1:m+1),rr(1:lrr),yrepl)
               lr=len_trim(r)
               write(ifil,'(a)') r(1:long)
               if(yw)print*,'multi3 ',r(1:long)
            enddo
         else
c           la donnee multiple est avec des ","
c           on efface les ","
            if(yw)print*,'donnee multiple avec ","'
            orb(l+n-1:l+n-1)=' '
            nb=2
            do
               nn=index(orb(l:m),',')
               if(nn.eq.0) exit
               orb(l+nn-1:l+nn-1)=' '
               nb=nb+1
            enddo
            if(yw)print*,orb(l:m)
            if(yw)print*,'nb',nb
            read(orb(l:m),*) ii(1:nb)
            do k=1,nb
               rr=adjustl(ii(k))
               lrr=len_trim(rr)
               r=' '
               r(1:long)=orb(1:long)
               call repl(r,r(l-1:m+1),rr(1:lrr),yrepl)
               lr=len_trim(r)
               write(ifil,'(a)') r(1:long)
               if(yw)print*,'multi3 ',r(1:long)
            enddo
         endif
 
 
      return
      end
       subroutine multi4(natom,atom,istel,orb,long,ifil)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character*3000 orb,r
      character*4 atom(200),atom1
      yw=.false.
      l=istel+1
      do while (l.ne.1)
         m=index(orb(1:long),'}')-1
         n=index(orb(l:m),'-')
         if(n.ne.0) then
            orb(n:n)=' '
            read(orb(l:m),*) i,j
            r=' '
            write(r,*)(k,k=i,j)
            r=adjustl(r)
            lr=len_trim(r)
            if(yw)print*,'r',r(1:lr)
            call suppdb(r,lr)
            lr=len_trim(r)
            if(yw)print*,'r',r(1:lr)
            call repl(orb,orb(l-1:m+1),' '//r//' ',yrepl)
            long=len_trim(orb)
            if(yw)print*,'multi4 ',orb(1:long)
         endif
      enddo
      return
      end
       subroutine multi5(orb,long,ifil,molcas)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character*3000 orb,r
      character*10 num
      character*4 p(3)
      character*5 d(5),f(7)
      data p /'2PX(','2PY(','2PZ('/
      data d /'3D0(','3D1+(','3D1-(','3D2+(','3D2-('/
      data f /'4F0(','4F1+(','4F1-(','4F2+(','4F2-(','4F3+(','4F3-('/
      yw=.false.
      if(orb(2:2)/='_') goto 4
 1    continue
      l=index(orb(1:long),'2P(')
      if(yw)print*,'multi5 ',orb(1:long)
      if(yw)print*,'l',l
      if(l.ne.0) then
         m=index(orb(l:long),')')+l-1
         mm=m-l-2
         num(1:mm)=orb(l+3:m)
         ifin=0
         do k=1,3
            lp=len_trim(p(k))
            ideb=ifin+1
            ifin=ideb+lp+mm
            if(yw)print*,'ideb,ifin',ideb,ifin
            if(yw)print*,p(k)(1:lp)
            if(yw)print*,num(1:mm)
            write(r(ideb:ifin),
     *      '(a)') p(k)(1:lp)//num(1:mm)
         enddo
         if(yw)print*,'r',r(1:ifin)
         call repl(orb,orb(l:m),r(1:ifin),
     *   yrepl)
         long=len_trim(orb)
         goto 1
      endif
 2    continue
      l=index(orb(1:long),'3D(')
      if(l.ne.0) then
         m=index(orb(l:long),')')+l-1
         mm=m-l-2
         num(1:mm)=orb(l+3:m)
         ifin=0
         do k=1,5
            lp=len_trim(d(k))
            ideb=ifin+1
            ifin=ideb+lp+mm
            if(yw)print*,'ideb,ifin',ideb,ifin
            if(yw)print*,d(k)(1:lp)
            if(yw)print*,num(1:mm)
            write(r(ideb:ifin),
     *      '(a)') d(k)(1:lp)//num(1:mm)
         enddo
         call repl(orb,orb(l:m),r(1:ifin),yrepl)
         long=len_trim(orb)
         if(yw)print*,'r',r(1:ifin)
         goto 2
      endif
 3    continue
      l=index(orb(1:long),'4F(')
      if(l.ne.0) then
         m=index(orb(l:long),')')+l-1
         mm=m-l-2
         num(1:mm)=orb(l+3:m)
         ifin=0
         do k=1,7
            lp=len_trim(f(k))
            ideb=ifin+1
            ifin=ideb+lp+1+mm
            if(yw)print*,'ideb,ifin',ideb,ifin
            if(yw)print*,f(k)(1:lp)
            if(yw)print*,num(1:mm)
            write(r(ideb:ifin),
     *      '(a)') f(k)(1:lp)//num(1:mm)//' '
         enddo
         call repl(orb,orb(l:m),r(1:ifin),yrepl)
         long=len_trim(orb)
         if(yw)print*,'r',r(1:ifin)
         goto 3
      endif
 
      if(yw)print*,'ORB FIN MULTI5 ',orb(1:long)
         call versionm(molcas,orb(1:long))
 4    continue
      long=len_trim(orb)
      if(yw)print*,'ORB FIN MULTI5 ',orb(1:long)
      write(ifil,'(a)') orb(1:long)
 
      return
      end
