      subroutine changecat
!
!---------------------------------------------------
! Loop on all orbitals after rename:
! If the LO was renamed a_ --> o_ (resp o_ --> a_)
! Change focvir: ACTO --> OCC or ACTV --> VIRT
! (resp  OCC --> ACTO or VIRT --> ACTV)
! (un)freeze, (un)activate
!---------------------------------------------------
! 
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      if(yes)print*,'entree changecat'
      do k=1,fnorb
         if(focvir(k)=='OCC') then
            if(flab(k)(1:1)=='A') then
               focvir(k)='ACTO'
            endif
         endif
         if(focvir(k)=='VIRT') then
            if(flab(k)(1:1)=='A') then
               focvir(k)='ACTO'
            endif
         endif
         if(focvir(k)=='ACTO') then
            if(flab(k)=='O_') then
               focvir(k)='OCC'
            endif
         endif
         if(focvir(k)=='ACTV') then
            if(flab(k)=='O_') then
               focvir(k)='VIRT'
            endif
         endif
       enddo
       if(yes)print*,'sortie changecat'
       return
       end
        subroutine changecat2(rep,rep2)
!
!-------------------------------------------------
! Rep='> string'
! looks for all LO's containing strings.
! proposes to change category for each of them
!-------------------------------------------------
!
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(*) rep,rep2
      character(len_lolist*18) lo80
      character(len_lolist*18) aa
      character(80) aaall
      if(yes)print*,'entree changecat2'
      yw=.false.
      if(yw)print*,'rep ',trim(rep)
      if(yw)print*,'rep2 ',trim(rep2)
!
      if(rep2(1:1)==' ') then
         ifil=6
      else
         ifil=ifilpr
      endif
!
!---------------------------------------------------------
! open ifilpr to store details concerning LO's generation
!---------------------------------------------------------
!
      write(lo80,'(i4)') idatlist+1
      lo80=adjustl(lo80)
      open(ifilpr,file='basicD_'//trim(lo80),status='unknown')
        if(yw)print*,'open','basicD_'//trim(lo80)
      write(ifilpr,'(a)') trim(rep)//' '//trim(rep2)
!
!---------------------------------------------------------
! Decode rep, find lables to be modified
!---------------------------------------------------------
!
      rep(1:1)=' '
      l=len_trim(rep)
      call fnormaligo(rep,l)
!
      ifin=0
      aa=' '
      nwk=0
      do k=1,fnorb
         ideb=ifin+2
         if(index(flab(k),trim(rep))/=0) then
            l=len_trim(flab(k))
            ifin=ifin+l+2
            aa(ideb:ifin)=flab(k)
            nwk=nwk+1
            iwk(nwk)=k
         endif
      enddo
      call scripto6(flo(:,iwk(1:nwk)),norb,nwk,norb,nwk,orbi,ifil,
     *focvir(iwk(1:nwk)),flab(iwk(1:nwk)),focc(iwk(1:nwk))
     *,fsym(iwk(1:nwk)),fdat1(iwk(1:nwk)),iwk(1:nwk))
!
!---------------------------------------------------------
! read data to change category, verify data
!---------------------------------------------------------
!
      write(ifil,*)' '
      write(ifil,*)'---------------------------------------------'
      write(ifil,*)
     *'Change Category:    O: move to OCC, V: move to VIRT, '
      write(ifil,*)
     *'F: freeze, UF: unfreeze, A: activate, UA unactivate,'
      write(ifil,*)'other letter: let as it is,    X: exit'
      write(ifil,*)'(One data for each orbital, or "ALL A", "ALL F"...)'
      write(ifil,*)'---------------------------------------------'
      write(ifil,*)' '
      write(ifil,*) trim(aa)
      aa=rep2
      do
         if(aa==' ')read(iunit5,'(a)') aa
         l=len_trim(aa)
         call fnormaligo(aa,l)
         aaall=' '
         if(aa(1:3)=='ALL') then
            aaall=aa
            aa(1:3)=' '
            aa=adjustl(aa)
            do k=1,nwk
               aa(k*3-2:k*3)=aa(1:3)
            enddo
            call fnormaligo(aa,l)
         endif
         write(ifil,*) trim(aa)
         if(aa(1:1)=='X') then
            close(ifilpr)
            if(yes)print*,'Sortie changecat2'
            return
         endif
! number of answers
         nn=1
         do k=1,l
            if(aa(k:k)==' ')nn=nn+1
         enddo
         if(nn.ne.nwk) then
            print*,nwk,' LO''s',nn,' data!    bad number of data'
            dataOK=.false.
            if(rep2.ne.' ') then
               ! alors on est entre directement par interac
               close(ifilpr)
               if(yes)print*,'sortie changecat2'
               return
            endif
            return
         endif
         exit
      enddo
      if(ifil.ne.6) print*,nn,' orbitals changed'
!
!---------------------------------------------------------------
! read LO's, change category when the string is included in flab
!---------------------------------------------------------------
!
      n=0
      lo80=aa
      if(yw) print*,'aa ',trim(aa)
      do k=1,fnorb
         if(index(flab(k),trim(rep))/=0) then
            if(aa(1:1)=='O') then
               if(focvir(k)=='OCC'.or.focvir(k)=='ACTO') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ',focvir(k),'   UNCHANGED'
               else if(focvir(k)=='VIRT') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ',focvir(k),'   CHANGED TO OCC'
                  focvir(k)='OCC'
               else if(focvir(k)=='ACTV') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ',focvir(k),'   CHANGED TO ACTO'
                  focvir(k)='ACTO'
               endif
            else if(aa(1:1)=='V') then
               if(focvir(k)=='VIRT'.or.focvir(k)=='ACTV') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ',focvir(k),'   UNCHANGED'
               else if(focvir(k)=='OCC') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ',focvir(k),'   CHANGED TO VIRT'
                  focvir(k)='VIRT'
               else if(focvir(k)=='ACTO') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ',focvir(k),'   CHANGED TO ACTV'
                  focvir(k)='ACTV'
               endif
            else if(aa(1:1)=='A') then
               if(focvir(k)=='ACTV'.or.focvir(k)=='ACTO') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   UNCHANGED'
               else if(focvir(k)=='OCC') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   ACTIVATED'
                  flab(k)(1:1)='A'
                  focvir(k)='ACTO'
               else if(focvir(k)=='VIRT') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   ACTIVATED'
                  focvir(k)='ACTV'
                  flab(k)(1:1)='A'
               endif
            else if(aa(1:2)=='UA') then
               if(focvir(k)=='VIRT'.or.focvir(k)=='OCC') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   UNCHANGED'
               else if(focvir(k)=='ACTO') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   UNACTIVATED'
                  flab(k)(1:1)='O'
                  focvir(k)='OCC'
               else if(focvir(k)=='ACTV') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   UNACTIVATED'
                  focvir(k)='VIRT'
                  flab(k)(1:1)='O'
               endif
            else if(aa(1:1)=='F') then
               if(flab(k)(1:1)=='G') then
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   UNCHANGED'
               else
                  flab(k)(1:1)='G'
                  write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   FROZEN'
               endif
            else if(aa(1:2)=='UF') then
               if(flab(k)(1:1)/='G') then
                   write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,' was ','   UNCHANGED'
               else
                  if(focvir(k)=='VIRT'.or.focvir(k)=='OCC') then
                     write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *               ,' was ','   UNFROZEN  --> O_'//
     *               trim(flab(k)(3:))
                     flab(k)(1:1)='O'
                  else if(focvir(k)(1:1)=='A') then
                     write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *               ,' was ','   UNFROZEN --> A_'//
     *               trim(flab(k)(3:)) 
                     flab(k)(1:1)='A'
                  endif
               endif
            else if(aa(1:1)=='T') then
               if(flab(k)(1:1)=='T') then
                   write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *            ,'   UNCHANGED'
               else
                  flab(k)(1:1)='T'
                  if(focvir(k)=='OCC') then
                     focvir(k)='VIRT'
                     write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *               ,' was ',' OCCUPIED   --> DIFFUSE   T_'//
     *               trim(flab(k)(3:)) 
                  else if(focvir(k)=='VIRT') then
                     write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *               ,' was ',' VIRTUAL   --> DIFFUSE   T_'//
     *               trim(flab(k)(3:)) 
                  else if(focvir(k)(1:3)=='ACT') then
                     focvir(k)='VIRT'
                     write(ifil,'(a,i4,5a)')'LO',k,' ',trim(flab(k))
     *               ,' was '
     *               ,' ACTIVE   --> DIFFUSE (NON ACTIVE)   T_'//
     *               trim(flab(k)(3:)) 
                  endif
               endif
            endif
            ifin=ifin+l+1
            !aa(ideb:ifin)=flab(k)
            aa(1:2)=' '
            aa=adjustl(aa)
         endif
      enddo
      idatlist0=idatlist0+1
      if(aaall==' ') then
         datlist0(idatlist0)='> '//trim(rep)//' '//trim(lo80)
      else
         datlist0(idatlist0)='> '//trim(rep)//' '//trim(aaall)
      endif
      idatlist=idatlist+1
      datlist(idatlist)='> '//trim(rep)//' '//trim(lo80)
      call wdata
      if(ifil.ne.6) then
         do k=1,nn
            backspace ifil
         enddo
         do k=1,nn
            read(ifil,'(a80)') lo80
            print*,trim(lo80)
         enddo
      endif
      close(ifilpr)
      if(yes)print*,'sortie changecat2'
      return
      end
        subroutine changecat3(rep)
!
!-------------------------------------------------
! Prepares data for changecat2
!-------------------------------------------------
!
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(*) rep
      character(len_lolist*18) aa
      if(yes)print*,'entree changecat3'
      dataOK=.true.
      if(rep(1:1).ne.'>') then
         print*,'wrong data'
         dataOK=.false.
         if(yes)print*,'sortie changecat3'
         return
      endif
      l=len_trim(rep)
      call fnormaligo(rep,l)
      l=len_trim(rep)
      i=index(rep(3:),' ')
      call changecat2(rep(1:i+1),rep(i+3:))
      if(yes)print*,'sortie changecat3'
      return
      end
      
      
