subroutine rename_loc
Use lewis_module
use mod_script
implicit real*8 (a-h,o-x,z),logical*1(y)
character(300) aa,string,string1,string2
character(18) :: lab

!if(currdir==' ') then
!   call system('echo $CurrDir > RENAME_BID')
!   call open_chose_number(ifil,'RENAME_BID','old', &
!   'formatted')
!   read(ifil,'(a)') currdir
!   close(ifil,status='delete')
!endif

rewind 5
ystring=.false.
do
   read(5,'(a)',end=1), aa
   call maj(aa,300)
   aa=adjustl(aa)
   if(aa/='RENAME') cycle

   !do
      read(5,'(a)'), aa
      call maj(aa,300)
      aa=adjustl(aa)
      l=len_trim(aa)
      call suppdb(aa,l)
      if(aa=='END RENAME'.or.aa=='ENDRENAME') exit
      if(aa=='STOP') stop'Stop in RENAME'

      if(aa(1:4)=='LIST') then
         call titre(' RENAME_LIST#',50)
         call rename_list(currdir)
         call titre('RENAME LIST#'// &
         'Orbital labels were written to file RENAME_LIST#'// &
         'Program stops#Edit file RENAME_LIST'// &
         ' rename it as RENAME_MOD#and run lewis'// &
         ' again with RENAME, MOD#',60)
         stop
      else if (aa(1:6)=='STRING') then
         !print*,'---------------000000--------------------------'
         !call system('cat /home/daniel/errrename/RENAME_MOD')
         call open_chose_number(ifil,trim(currdir)//'/RENAME_MOD', &
         'old','formatted')
         call open_chose_number(ifil1,trim(currdir)//'/RENAME_MOD_OLD', &
         'unknown','formatted')
         do i=1,norb
            read(ifil,*) j,label_OL_temp(i)
         enddo
         close(ifil)
         
         do
            read(aa(8:),*) string,string1,string2
            print'(a50)',aa
            if(.not.ystring) &
            call open_chose_number(ifil,trim(currdir)//'/RENAME_MOD', &
            'old','formatted')
            do i=1,norb
               read(ifil,*) j,label_OL_temp(i)
               write(ifil1,'(i8,4x,a,a,i1,a)') i,label_OL_temp(i)
            enddo
            rewind ifil
            do i=1,norb
               lab=label_OL_temp(i)
               yrepl=.false.
               if(index(lab,trim(string))/=0) then
                   call replace(len(lab),lab,trim(string1),trim(string2) &
                   ,yrepl)
                  print'(a,a20,a,a20)','Replace   ',label_OL_temp(i), &
                  '  -->  ',lab
               endif
               write(ifil,'(i8,4x,a)') i,lab
                     !if(yrepl)print*,'REPL ',lab
            enddo
            close(ifil)
            !print*,'--------------STRING---------------------------'
            !call system('cat /home/daniel/errrename/RENAME_MOD')
            read(5,'(a)'), aa
            ! other "string" data
            call maj(aa,300)
            if(aa(1:6)/='STRING') exit
            print*,' '
         enddo

         ! dans RENAME_MOD, changer les G_ en o_ et c_
         call open_chose_number(ifil,trim(currdir)//'/RENAME_MOD', &
         'old','formatted')
         rewind ifil1
         do i=1,norb
            read(ifil,*) j,label_OL_temp(i)
            if(label_OL_temp(i)(1:1)=='G') then
               read(ifil1,*) j,string
               if(string(1:1)=='C') label_OL_temp(i)(1:1)='c'
               if(string(1:1)=='O') label_OL_temp(i)(1:1)='o'
            endif
         enddo
         rewind ifil
         i=0
         do is=1,nsym
            do j=1,isym(is)
               i=i+1
               write(ifil,'(i8,4x,a,a,i1,a)') i,label_OL_temp(i),'  (sym=',is,')'
            enddo
         enddo

         ! close files
         close(ifil)
         close(ifil1,status='delete')
         call rename_mod(currdir,0)
      endif
      if(aa(1:3)=='MOD') then
         call titre(' RENAME_MOD#',50)
         call rename_mod(currdir,1)
      endif
   !enddo
   if(aa=='END RENAME'.or.aa=='ENDRENAME') exit

enddo
1    continue

end
 subroutine rename_mod(iw)
Use lewis_module
use mod_script
character(20) aa
character(20),allocatable :: label_OL_ren(:)
real(8),allocatable :: orb_ren(:,:)
real(8),allocatable :: occ_ren(:)

call open_chose_number(ifil,trim(currdir)//'/RENAME_MOD', &
'old','formatted')
i=0
do is=1,nsym
   do k=1,isym(is)
      i=i+1
      read(ifil,'(i8,4x,a20)',end=1) j,aa
      aa=adjustl(aa)
      !print*,i,j,'  '//trim(aa)
      if(j/=i) then
         backspace ifil
         cycle
      endif
      !print'(a20)',label_OL(i)
      !print'(a20)',aa
      if(label_OL_temp(i)/=aa) then
              if(iw==1)print'(a,a20,a,a20)','Replace   ',label_OL_temp(i), &
         '  -->  ',aa
         if(aa(1:1)=='G') then
            if(label_OL_temp(i)(1:1)=='C') aa(1:1)='c'
            if(label_OL_temp(i)(1:1)=='O') aa(1:1)='o'
         endif
         label_OL_temp(i)=aa
         !print*,'SYM',i,itsym(i)
      endif
   enddo
enddo
1    continue
   ! On reordonne les OL pour placer les actives au centre

   ! noacs a peut-etre ete modifie dans RENAME_MOD. On va le recalculer
noacs=0

i=0
j=0
ifin=0
do is=1,nsym
   ideb=ifin+1
   ifin=ifin+isym(is)
   allocate(label_OL_ren(isym(is)))
   allocate(occ_ren(isym(is)))
   allocate(orb_ren(isym(is),isym(is)))
   label_OL_ren=label_OL_temp(ideb:ifin)
   occ_ren=occ(ideb:ifin)
   orb_ren=orb(ideb:ifin,ideb:ifin)
   !print*,'label_OL_ren',label_OL_ren
   !print*,'shape',shape(orb)
   !print*,'ideb,ifin',ideb,ifin
   do k=1,isym(is)
      i=i+1
      if(occupat(i).and.label_OL_ren(k)(1:2)/='A_') then
         j=j+1
   !      print*,'OCC ',label_OL_ren(k),is,i,j
         label_OL(j)=label_OL_ren(k)
         occ(j)=occ_ren(k)
         orb(ideb:ifin,j)=orb_ren(:,k)
      endif
   enddo  
   i=i-isym(is)
   do k=1,isym(is)
      i=i+1
      if(label_OL_ren(k)(1:2)=='A_') then
         noacs(is)=noacs(is)+1
         j=j+1
         !print*,'ACT ',label_OL_ren(k),is,i,j,occupat(i)
         label_OL(j)=label_OL_ren(k)
         occ(j)=occ_ren(k)
         orb(ideb:ifin,j)=orb_ren(:,k)
         if(occupat(i)) nocs(is)=nocs(is)-1
      endif
   enddo  
   i=i-isym(is)
   do k=1,isym(is)
      i=i+1
      if(.not.occupat(i).and.label_OL_ren(k)(1:2)/='A_') then
         j=j+1
   !      print*,'VIR ',label_OL_ren(k),is,i,j
         label_OL(j)=label_OL_ren(k)
         occ(j)=occ_ren(k)
         orb(ideb:ifin,j)=orb_ren(:,k)
      endif
   enddo  
   deallocate(label_OL_ren,occ_ren,orb_ren)
enddo
close(ifil)
end

 subroutine rename_list
Use lewis_module
use mod_script
idon=0

call open_chose_number(ifil,trim(currdir)//'/RENAME_LIST', &
'unknown','formatted')
i=0
do is=1,nsym
   do j=1,isym(is)
      i=i+1
      write(ifil,'(i8,4x,a,a,i1,a)') i,label_OL_temp(i),'  (sym=',is,')'
   enddo
enddo
close(ifil)
end
 subroutine replace(l,lab,string1,string2,yrepl)
implicit real*8 (a-h,o-x,z),logical*1(y)
character(*) :: lab,string1,string2
laa=len_trim(lab)
l1=len_trim(string1)
l2=len_trim(string2)
      !print*,'laa,l1,l2',laa,l1,l2
yrepl=.false.
do i=1,laa
   if(i+l1>l) exit
   if(lab(i:i+l1-1)==string1) then
      lab(i+l2-1:laa+l2-l1)=lab(i+l1-1:laa)
      lab(i:i+l2-1)=string2
      yrepl=.true.
   endif
enddo
end
