      subroutine verif(interactive_correction)
      use mod_dolo
      parameter(maxatomlp=1000)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension multat(maxatomlp),lb(maxatomlp)
      allocatable  multl(:)
      integer deja(1000)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      character(200),allocatable :: flab3(:)
      character(200),allocatable :: flab2(:)
      character(3) focvir2(3)
      character(80) a
      call titre('Verif#',20)
      allocate(multl(norb))
      allocate(flab2(norb))
      allocate(flab3(norb))
      yw=.false.
!
!----------------------------------------
! Multiplicite des atomes
!----------------------------------------
!
      call multipat(nsym,sym1,natom,coor,multat)
      if(yw)print*,'multat',multat(1:natom)
!
!----------------------------------------
! Longueur de la base pour chaque atome
!----------------------------------------
!
      do k=1,natom
         lb(k)=0
         m=0
         do is=1,nsym
            do l=1,isym(is)
               m=m+1
               if(index5(orbi(m)(1:4),trim(atom(k)))/=0) then
                  if(any(flo(m,:)/=0.d0)) then
                     jm=0
                     do js=1,is-1
                        do jl=1,isym(js)
                           jm=jm+1
                           if(orbi(m)==orbi(jm)) goto 1
                        enddo
                     enddo
                     lb(k)=lb(k)+1
                     !print*,'lb',lb(k),m,orbi(m)
                  endif
               endif
 1             continue
            enddo
         enddo
         if(yw)print*,'atom',k,atom(k),lb(k)
      enddo
!
!-----------------------------------------------
! On met dans flab3 les liaisons sans redondance
! cad que les flab3 on tous des noms differents,
! la liste des flab3 est plus courte que celle des flab
! et dans flab2 les atomes des flab3
!-----------------------------------------------
!
      call faiflab3(lflab2,flab3,flab2)
!
!----------------------------------------
! Multiplicite des liaisons
!----------------------------------------
!
      call multipliaison(multat,natom,lflab2,flab2,atom,multl)
      do k=1,lflab2
         if(yw)print*,'multl',k,multl(k),flab2(k),'   ',flab3(k)
      enddo
      do k=1,fnorb
         if(yw)print*,'flab',k,flab(k),focvir(k)
      enddo
      print*,' '
      focvir2=(/'OCC','ACT','VIR'/)
         lflab2_0=lflab2
      do iocvir=1,3
         do k=1,lflab2_0
            n=0
            do l=1,fnorb
               if(focvir(l)(1:3)/=focvir2(iocvir)) cycle
               if(flab(l)==flab3(k)) n=n+1
          !    print*,focvir(l),focvir2(iocvir),'   ',flab(l),flab3(k),n
            enddo
            if(n>multl(k)) then
               print*,'**********Warning'
               print'(a,i3,a,i3,a)'
     *         ,'LO ('//focvir2(iocvir)//') '//trim(flab3(k))//
     *         ' of multiplicity',multl(k),' appears',n,' times'
               if(interactive_correction==1) then
                  call correc(flab3(k))
                  call faiflab3(lflab2,flab3,flab2)
               endif
            endif
         enddo
      enddo
      print*,' '
!
!-------------------------------------------------
! Nombre d'occurences des atomes dans les liaisons
!-------------------------------------------------
!
      print*,'atom      base length   '
      !print*,'flab3',flab3(1:lflab2)
      !print*,'flab',flab(1:fnorb)
      do k=1,natom
         rewind 75
         n=0
         do l=1,lflab2
            if(flab2(l)==' ') cycle
            noccur=0
            do m=1,fnorb
               if(flab3(l)==flab(m)) noccur=noccur+1
            enddo
            if(index5(flab2(l),trim(atom(k)))/=0) then
!               do m=1,l-1
!                  if(flab(l)==flab(m)) goto 2
!               enddo
               n=n+multl(l)
               write(75,'(5a,i3,a,i3)')'atom ',atom(k),' LO ',flab3(l),
     *         ' Mult in molec ',multl(l),' Mult in basis',noccur
 2             continue
            endif
         enddo
         if(lb(k)==n/multat(k)) then
            print'(1x,a,i8,f8.4)',atom(k),lb(k),(1.d0*n)/multat(k)
         else
            print'(1x,a,i8,f8.4,a)',
     *      atom(k),lb(k),(1.d0*n)/multat(k),'   ERROR'
            rewind 75
            do
               read(75,'(a80)',end=4) a
               print'(30x,a)',trim(a)
            enddo
 4          continue
         endif
      enddo
 
      deallocate (multl,flab2)
      return
      end
       subroutine multipliaison(multat,natom,lflab2,flab2,atom,multl)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension multat(natom),multl(lflab2)
      character(4) atom(natom)
      character(200) flab2(lflab2)
      multl=0
      do k=1,natom
         do l=1,lflab2
            !print*,'index5',flab2(l),trim(atom(k))
            !print*,'index5',index5(flab2(l),trim(atom(k)))
            if(index5(flab2(l),' '//trim(atom(k))//' ')/=0) multl(l)=
     *      max(multl(l),multat(k))
         enddo
      enddo
      return
      end
 
       subroutine multipat(nsym,sim,natom,coor,multat)
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character(3) sim(7)
      dimension coor(3,natom*nsym)
      dimension multat(natom)
      dimension yopx(7),yopy(7),yopz(7)
      dimension coor_image(3,8)
      dimension ynouv(8)
      yes=.false.
      if(yes) print*,'entree multipat'
      yw=.false.
!
! Multiplicite des atomes
!
C      nop=0
C      if(nsym==2) nop=1
C      if(nsym==4) nop=2
C      if(nsym==8) nop=3
C      if(yw)print*,'nop',nop
      if(yw) then
         print*,'multipat : en entree :'
         print*,'nsym',nsym
         print*,'sim',sim(1:nsym-1)
         print*,'natom',natom
         print'(a)','coor'
         print'(3f10.6)',coor(:,1:natom)
      endif
      do iop=1,nsym-1
         iop1=iop
         !if(iop1==3) iop1=4
         yopx(iop)=index(sim(iop1),'X')/=0
         yopy(iop)=index(sim(iop1),'Y')/=0
         yopz(iop)=index(sim(iop1),'Z')/=0
      enddo
      if(yw)print*,'yopx',yopx(1:nsym-1)
      if(yw)print*,'yopy',yopy(1:nsym-1)
      if(yw)print*,'yopz',yopz(1:nsym-1)
 
      do iat=1,natom
         coor_image(:,1)=coor(:,iat)
         if(yw)print'(a,3f12.8)',
     *      'coor_image(1)',coor_image(:,1)
         do iop=1,nsym-1
            coor_image(:,iop+1)=coor_image(:,1)
            if(yopx(iop)) coor_image(1,iop+1)=-coor_image(1,iop+1)
            if(yopy(iop)) coor_image(2,iop+1)=-coor_image(2,iop+1)
            if(yopz(iop)) coor_image(3,iop+1)=-coor_image(3,iop+1)
            if(yw)print'(a,2i3,3f12.8)',
     *      'coor_image',iat,iop+1,coor_image(:,iop+1)
         enddo
         ynouv=.true.
         do i=2,nsym
            do j=1,i-1
               if(all(coor_image(:,i)==coor_image(:,j)))
     *         ynouv(i)=.false.
            enddo
         enddo
         if(yw)print*,'ynouv',ynouv(1:nsym)
         multat(iat)=count(ynouv(1:nsym))
      enddo
 
 
 
 
 
C      do iat=1,natom
C         n=0
C         do iop=1,nop
C            yautre=(yopx(iop).and.abs(coor(1,iat))>1.d-6)
C     *         .or.(yopy(iop).and.abs(coor(2,iat))>1.d-6)
C     *         .or.(yopz(iop).and.abs(coor(3,iat))>1.d-6)
C            if(yautre) n=n+1
C         enddo
C         multat(iat)=2**n
C      enddo
      if(yw)print*,'multat',multat
      if(yes) print*,'sortie multipat'
      return
      end
       subroutine correc(flab3)
      use mod_dolo
      character(200) flab3
      open(99,form='formatted')
      write(99,'(a)') flab3
      rewind(99)
      call renamelo(99,5)
      close(99)
      return
      end
 
 
       subroutine faiflab3(lflab2,flab3,flab2)
      use mod_dolo
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character(200) flab3(norb)
      character(200) flab2(norb)
      yw=.false.
      lflab2=0
      do l=1,fnorb
         if(flab(l)==' ') cycle
         do m=1,l-1
            if(flab(l)==flab(m)) goto 3
         enddo
         lflab2=lflab2+1
         flab3(lflab2)=flab(l)
         flab2(lflab2)=' '
         ifin=1
         do m=1,fnat(l)
            ideb=ifin+1
            ifin=ideb+len_trim(atoms_in_LO(l,m))
            !print*,'IIII',lflab2,ideb,ifin
            flab2(lflab2)(ideb:ifin)=trim(atoms_in_LO(l,m))
         enddo
        !print*,'flab2f',flab2(lflab2)
 3       continue
      enddo
      if(yw)print*,'flab2',flab2(1:lflab2)
      return
      end
