      subroutine reortypo(ndims,long,occup,tipo,u,ngel)
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      parameter (maxsym=8)
      allocatable iord(:)
      dimension occup(long),u(ndims,long)
      character(12) tipo(long)
      allocate(iord(long))
c      print*,'entree reortypo',long
      kk=0
      do k=1,long
         llabel0=max(1,index(tipo(k),'_')-1,1)
c         print*,'k,llabel0',k,llabel0
         if(index(tipo(k)(1:llabel0),'G').ne.0) then
            kk=kk+1
            iord(kk)=k
         endif
c         print*,'K,llabel0',k,llabel0,kk
      enddo
      ngel=kk
      do k=1,long
         llabel0=max(1,index(tipo(k),'_')-1,1)
c         print*,'k,llabel0',k,llabel0
         if(index(tipo(k)(1:llabel0),'G').eq.0) then
            kk=kk+1
            iord(kk)=k
         endif
c         print*,'K,llabel0',k,llabel0,kk
      enddo
      tipo=tipo(iord(1:long))
      occup=occup(iord(1:long))
      u(:,:)=u(:,iord(1:long))
c      print*,'sortie reortypo'
      deallocate(iord)
      return
      end
       subroutine suppdb(orb,long)
      character(*) orb
      j=1
      do i=2,long
         if(orb(i-1:i).ne.'  ') then
            j=j+1
            orb(j:j)=orb(i:i)
         endif
      enddo
      orb(j+1:long)=' '
      long=j
      return
      end
       subroutine ligne_suite(orb,orb1,long,long1)
      character(*) orb,orb1
      if(orb(long:long).eq.'&') then
         do
            read(93,'(a)') orb1
            orb1=adjustl(orb1)
            long1=len_trim(orb1)
            orb(long:long+long1-1)=orb1(1:long1)
            long=long+long1-1
            if(orb1(long1:long1).ne.'&') exit
         enddo
      endif
      return
      end
       subroutine reor(n,it)
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      dimension it(n)
      do 1 i=1,n-1
      do 2 j=i+1,n
      if(it(j).ge.it(i)) goto 2
      ii=it(i)
      it(i)=it(j)
      it(j)=ii
 2    continue
 1    continue
      return
      end
       subroutine reord(n,occup,ios)
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      dimension ios(n),occup(n)
      do 1 i=1,n-1
      do 2 j=i+1,n
      if(ios(j).le.ios(i)) goto 2
      ii=ios(i)
      ios(i)=ios(j)
      ios(j)=ii
      aa=occup(i)
      occup(i)=occup(j)
      occup(j)=aa
 2    continue
 1    continue
      return
      end
       subroutine versionm(molcas,orb)
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      character(*) orb
      yw=.false.
      long=len_trim(orb)
      if(yw)print*,'entree versionm',molcas,orb,long
         if(molcas.eq.4) then
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'1S(','1S0(',yrepl)
            enddo
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'2PX','2P1-',yrepl)
            enddo
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'2PY','2P1+',yrepl)
            enddo
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'2PZ','2P0',yrepl)
            enddo
         else if(molcas.eq.5) then
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'1S0(','1S(',yrepl)
            enddo
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'2P1+','2PX',yrepl)
            enddo
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'2P1-','2PY',yrepl)
            enddo
            yrepl=.true.
            do while (yrepl)
               call repl(orb,'2P0','2PZ',yrepl)
            enddo
         endif
      long=len_trim(orb)
      if(yw)print*,'sortie versionm',molcas,orb,long
      return
      end
 
       subroutine reortypv(ndims,long,occup,tipo,u,ngel)
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      parameter (maxsym=8)
      dimension occup(long),u(ndims,long)
      character(12) tipo(long)
      allocatable iord(:)
      allocate(iord(long))
      kk=0
      ngel=0
      do k=1,long
         llabel0=max(1,index(tipo(k),'_')-1,1)
         if(index(tipo(k)(1:llabel0),'G').eq.0) then
            kk=kk+1
            iord(kk)=k
         endif
      enddo
      do k=1,long
         llabel0=max(1,index(tipo(k),'_')-1,1)
         if(index(tipo(k)(1:llabel0),'G').ne.0) then
            ngel=ngel+1
            kk=kk+1
            iord(kk)=k
         endif
      enddo
      tipo=tipo(iord(1:long))
      occup=occup(iord(1:long))
      u(:,:)=u(:,iord(1:long))
      deallocate(iord)
      return
      end
 
 
