      subroutine storelo2(AA,ii,olo,vlo,ios2,oocc,vocc,nao,mor2,
     *mboc,mbal)
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(len_datlist) AA
      dimension ii(nao)
      dimension olo(nao,mboc),vlo(nao,mbal)
      dimension oocc(mboc),vocc(mbal),ios2(mor2)
      character(80) bb
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      if(yes)print*,'entree storelo2'
 
!
!--------------------------------------------------------------------
! Store LO's, occupations and labels in final matrices
! olo/vlo: occ/virt LO's
! oocc/vocc: occ/virt occupations
!--------------------------------------------------------------------
!
      yw=.false.
      in=index(aa,' ')-1
      if(yw) then
         print*,'entree storelo2'
         print*,'nao,mor2,mboc,mbal',nao,mor2,mboc,mbal
         print*,'ios2',ios2
         print'(a,20i4)','ii  ',ii(1:nao)
         print'(a,10f8.4)','oocc',oocc
         print'(a,10f8.4)','vocc',vocc
         print*,'olo'
         call scripto(olo,nao,mboc,nao,mboc,orbi(ii))
         print*,'vlo'
         call scripto(vlo,nao,mbal,nao,mbal,orbi(ii))
         print*,'label ',aa(1:in)
      endif
!
!--------------------------------------------------------------------
! Position in the final flo matrix
! Add vectors to flo
!--------------------------------------------------------------------
!
      rewind 75
      yoverlap=.false.
      do k=1,mboc
         is=ios2(k)
         fnorb=fnorb+1
         if(aa(1:1)=='A') then
            focvir(fnorb)='ACTO'
         else
            focvir(fnorb)='OCC'
         endif
         flo(:,fnorb)=0.d0
         flo(ii,fnorb)=olo(:,k)
         flab(fnorb)=aa(1:in)
         orig(fnorb)=origtmp
         ftype(norb)=ftypetmp
         do l=1,fnorb-1
            s=dot_product(flo(:,l),flo(:,fnorb))
            if(abs(s)>0.5) then
               write(75,'(3x,f8.4,''    Orb:'',2i4,a,i2)')
     *         abs(s),fnorb,l,'  '//trim(flab(fnorb))
     *         //' '//trim(flab(l))
     *         //'     '//focvir(fnorb)//' / '//focvir(l)//'   SYM',is
               yoverlap=.true.
            endif
         enddo
         focc(fnorb)=oocc(k)
         fsym(fnorb)=is
         fdat0(fnorb)=nbdat0
         fdat1(fnorb)=jdatlist
         fnat(fnorb)=fnat_tmp
         do i=1,fnat_tmp
            atoms_in_LO(fnorb,i)=atoms_in_LO_tmp(i)
         enddo
         !print*,'FNATo',fnorb,flab(fnorb),fnat(fnorb)
      enddo
      kv=0
      do k=mor2-mbal+1,mor2
         kv=kv+1
         fnorb=fnorb+1
         is=ios2(k)
         if(aa(1:1)=='A') then
            focvir(fnorb)='ACTV'
         else
            focvir(fnorb)='VIRT'
         endif
         flo(:,fnorb)=0.d0
         flo(ii,fnorb)=vlo(:,kv)
         flab(fnorb)=aa(1:in)
         orig(fnorb)=origtmp
         do l=1,fnorb-1
            s=dot_product(flo(:,l),flo(:,fnorb))
            if(abs(s)>0.5) then
               write(75,'(3x,f8.4,''    Orb:'',2i4,a,i2)')
     *         abs(s),fnorb,l,'  '//trim(flab(fnorb))
     *         //' '//trim(flab(l))
     *         //'     '//focvir(fnorb)//' / '//focvir(l)//'   SYM',is
               yoverlap=.true.
            endif
         enddo
         focc(fnorb)=vocc(kv)
         fsym(fnorb)=is
         fdat0(fnorb)=nbdat0
         fdat1(fnorb)=jdatlist
         fnat(fnorb)=fnat_tmp
         do i=1,fnat_tmp
            atoms_in_LO(fnorb,i)=atoms_in_LO_tmp(i)
         enddo
         !print*,'FNATv',fnorb,flab(fnorb),fnat(fnorb)
       enddo
!
!--------------------------------------------------------------------
! Overlap with preceeding LO's
!--------------------------------------------------------------------
!
       if(yw)print*,'in_progress',in_progress
      if(in_progress/='BOND'.and.yoverlap) then
!      if(in_progress/='BOND'.and.in_progress/='SIGM'
!     *.and.in_progress/='PI_ '.and.yoverlap) then
         call titre('Warning: Large overlap(s)#',30)
         rewind 75
         ywk=.false.
         kk=0
         do
            read(75,'(a80)',end=1) bb
            kk=kk+1
            bb=adjustl(bb)
            print'(3x,a)',trim(bb)
            i=index(bb,':')
            bb(1:i)=' '
            read(bb,*) i,j
            !read(bb,'(16x,2i4)') i,j
            ywk(i)=.true.
            ywk(j)=.true.
         enddo
 1       continue
         n=0
         do k=1,norb
            if(ywk(k)) then
               n=n+1
               iwk(n)=k
            endif
         enddo
         print*,' '
         print*,'Corresponding LO''s'
         print*,' '
         call scripto6(flo(:,iwk(1:n)),norb,n,norb,n,orbi,6,
     *   focvir(iwk(1:n)),flab(iwk(1:n)),focc(iwk(1:n))
     *   ,fsym(iwk(1:n)),fdat1(iwk(1:n)),iwk(1:n))
         !call modifflo
      endif
!      do k=1,fnorb
!         print*,'fnat',k,flab(k),atoms_in_LO(k,1:fnat(k))
!      enddo
!
!--------------------------------------------------------------------
! Occupations
!--------------------------------------------------------------------
!
      call occupations
      call scriflo
      if(yes)print*,'sortie storelo2'
      return
      end
