      subroutine grepflo
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(80) rep
      if(yes) print*,'entree grepflo'
!
!==========================================================
! Display already generates LO''s
!==========================================================
!
      call titre('Entering GREP mode#',20)
      call repl(form_dolo,'>','/GREP>',yrepl)
      call repl(form_dolo1,'>','/GREP>',yrepl)
      do
         write(6,form_dolo)'G string: Display LO''s whose label '//
     *   ' contains "string"'
         write(6,form_dolo1)'D display all LO''s'
         write(6,form_dolo1)'X: Exit GREP mode'
         read(5,'(a)') rep
         call fnormaligo(rep,l)
         print*, rep
!===========================================================
         if(rep(1:1)=='X') then
            exit
!===========================================================
         else if(rep(1:1)=='G') then
            call rfa(rep,nwk)
            rewind 75
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,6,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,75,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            call rfa1(nwk)
         cycle
!===========================================================
         else if(rep(1:1)=='D') then
            call displayflo
            cycle
         endif
!===========================================================
      enddo
      call repl(form_dolo,'/GREP>','>',yrepl)
      call repl(form_dolo1,'/GREP>','>',yrepl)
      if(yes) print*,'sortie grepflo'
      return
      end
       subroutine rfa(rep,nwk)
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(80) rep
      if(yes) print*,'entree rfa'
      nwk=0
      rep(1:1)=' '
      rep=adjustl(rep)
      do k=1,norb
         if(index(flab(k),trim(rep))/=0) then
            nwk=nwk+1
            iwk(nwk)=k
         endif
      enddo
      if(yes) print*,'sortie rfa'
      return
      end
       subroutine rfa1(nwk)
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      logical chiffre
      character(80) rep
      character(4) fv
      if(yes) print*,'entree rfa1'
      call repl(form_dolo,'>','/SELECT>',yrepl)
      call repl(form_dolo1,'>','/SELECT>',yrepl)
      do
 
         write(6,form_dolo)'Select LO''s from the preceeding list:'
         write(6,form_dolo)'D n1 n2...: display orbitals n2,n2...'
         write(6,form_dolo1)'O: only occupied LO''s'
         write(6,form_dolo1)'A: only active   LO''s'
         write(6,form_dolo1)'V: only virtual   LO''s'
         write(6,form_dolo1)'n: only symmetry n'
         write(6,form_dolo1)'G string: Display LO''s whose label '//
     *   ' contains "string"'
         write(6,form_dolo1)'X: Exit SELECT mode'
         read(5,'(a)') rep
         l=len_trim(rep)
         call fnormaligo(rep,l)
         if(l==0) cycle
         call maj(rep,l)
         print*,trim(rep)
         if(rep(1:1)=='D') then
            rep(1:1)=' '
            rep=adjustl(rep)
            l=len_trim(rep)
            if(.not.chiffre(rep(1:1))) goto 1
            nwk=1
            do k=1,l
               if(rep(k:k)==' ') nwk=nwk+1
            enddo
            read(rep,*,err=1) iwk(1:nwk)
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,6,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
         endif
         if(rep=='O'.or.rep=='V'.or.rep=='A') then
            rewind 75
            if(rep=='O') then
               fv='OCC'
            else if(rep=='A') then
               fv='ACT'
            else if(rep=='V') then
               fv='VIRT'
            endif
            nwk1=0
            do k=1,nwk
               !print*,k,iwk(k),focvir(iwk(k)),fv
               if(focvir(iwk(k))(1:3)/=fv) cycle
               nwk1=nwk1+1
               iwk(nwk1)=iwk(k)
            enddo
            nwk=nwk1
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,6,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,75,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            cycle
         else if(rep(1:1)=='G') then
            rep(1:1)=' '
            rep=adjustl(rep)
            nwk1=0
            do k=1,nwk
               if(index(flab(iwk(k)),trim(rep))==0) cycle
               nwk1=nwk1+1
               iwk(nwk1)=iwk(k)
            enddo
            nwk=nwk1
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,6,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,75,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            cycle
         else if(rep=='X') then
            rewind 75
            exit
         else
            read(rep(1:1),'(i1)',err=1) is
            rewind 75
            nwk1=0
            do k=1,nwk
               if(fsym(iwk(k))/=is) cycle
               nwk1=nwk1+1
               iwk(nwk1)=iwk(k)
            enddo
            nwk=nwk1
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,6,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,75,
     *      focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *      ,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
            cycle
            cycle
         endif
         exit
 1       continue
         print*,'wrong data'
      enddo
      print*,'Exit SELECT mode'
      call repl(form_dolo,'/SELECT>','>',yrepl)
      call repl(form_dolo1,'/SELECT>','>',yrepl)
      if(yes) print*,'sortie rfa1'
      return
      end
