      subroutine proj_uci(alpha)
      use module
C     use mod_dav
      use mod_uci
      implicit none
      real(8),allocatable :: vecadr(:,:)
      real(8) alpha(m,m)
      common /habillage/ M,m2
      logical yw
      integer k,kk,l,m2,m
      yw=.false.
      allocate(vecadr(idimadr,m))
      if(yw)print*,'esp_mod',esp_mod
      call lire(v1,m,ndet,21)
      do k=1,m
         do kk=1,ndet
C           if(abs(v1(kk,1))>1.d-2) print'(i8,f12.8)',kk,v1(kk,1)
         enddo
         do l=1,idimadr
            vecadr(l,k)=v1(esp_mod(l),1)
         enddo
      enddo
      do k=1,idimadr
         vecadr(k,1)=sum(alpha(1:m,1)*vecadr(k,:))
         if(yw)print*,'vecadr',k,vecadr(k,1)
      enddo
      v1(esp_mod(:),1)=v1(esp_mod(:),1)-
     *dot_product(v1(esp_mod(:),1),vecadr(:,1))*vecadr(:,1)
      call ecri(v1,m,ndet,21)
 
 
      deallocate(vecadr)
      end
       subroutine init_uci
      use module
      use mod_lirorb
      use mod_dav
      use mod_uci
      implicit none
      real*8 :: coef
      integer, allocatable :: k_orbat(:)
      integer, allocatable :: k_idxact(:)
      integer :: k,i,j,ii,l,jjb,jja,ierr,nao,nbid2,ibid,kkk
      integer :: iadr
      character(18),allocatable,dimension(:) :: tipo
      character(18) :: tipo1
      logical(1), allocatable :: yc(:)
      dimension ibid(8)
      character(10000) namel
      logical yw
      yw=.false.
      open(45,file=info1,status='old')
      call LECNAM('&COST_AO',namel,45,ierr,1)
      !call nameli(namel,NATOM,'NATOM',4)
      allocate(k_orbat(natom))
      if (.not.allocated(atom0)) allocate(atom0(natom))
      k_orbat = 0
      call namela(namel,ATOM0,'ATOM')
      call lirorb('ORB_IJKLOC',nao,nbid2,ibid,99,98)
      allocate(tipo(nao))
      allocate(yc(noac*2))
      read(99)
      read(99)
      read(99) tipo
C  initialisation nombre des actives, actives par atom, leur position
      if(yw)print*, 'natom', natom
      i = 0
      do k=1,natom
        j = 0
        do kkk=1,norb
           if (tipo(kkk)(1:2) .eq. 'A_') then
                 tipo1= '                 '
!                print*, kkk, atom0(k),tipo(kkk),i
                 do i = 3,18
                   tipo1(i:i) = tipo(kkk)(i:i)
                   if (tipo(kkk)(i:i) == '.') exit
                 enddo
              if (tipo1(3:i-1) .eq. atom0(k)) then
                 if(yw)print*, tipo1(3:i-1)
                 i = i + 1
                 j = j + 1
              endif
           endif
!          print*,'tipo',k,'  ',tipo(k)
!          print*,'atom0',k,'  ',atom0(k)
        enddo
        k_orbat(k) = j !actives par atom
      enddo
!
!
! lecture du determinant de reference
!
      open(45,form='formatted',status='unknown',file='SELEC')
      read(45,'(a)') namel(1:20)
      if(yw)print*,'namel',namel(1:20)
! initialisation de yc avec la reference
      do i=1,noac
         yc(i)=namel(i:i)=='+'
      enddo
      do i=1+noac,noac+noac
         yc(i)=namel(i:i)=='-'
      enddo
!
! double boucle :
! 1. sur les atomes alpha
! 2. sur les atomes beta
      open(99,file='IDIMADR')
      idimadr=0
      jja=0
      do i=1,natom
         if(k_orbat(i)==0) cycle
         do k = jja + 1, jja+k_orbat(i)
            if(namel(k:k)=='-') cycle
            yc(k)=.false.
!           l'atome i est alpha
            jjb=0
            do j=1,natom
               if(k_orbat(j)==0) cycle
               do l = jjb + 1, jjb+k_orbat(j)
                  if(namel(l:l)=='+') cycle
                  yc(l)=.true.
!                 l'atome j est beta
!                 call adrdet(yc...)
                  yc(noac+1:noac+noac)=.not.yc(1:noac)
                  call adrdet(yc,0,1,0,1,iadr)
                  coef=1.d0/(dsqrt(1.d0*k_orbat(i)*k_orbat(j)))
                  idimadr=idimadr+1
                  write(99,*) coef,iadr
                  if(yw)print*, yc(1:noac), coef, iadr
                  yc(l)=.false.
               enddo
               jjb=jjb+k_orbat(j)
            enddo
            yc(k)=.true.
         enddo
         jja=jja+k_orbat(i)
      enddo
      allocate(esp_mod(idimadr))
      allocate(c_esp_mod(idimadr))
      rewind 99
      do i = 1, idimadr
         read(99,*) c_esp_mod(i), esp_mod(i)
      enddo
      close(99,status='delete')
!     print*, natom_act
!     write(6,*) k_idxact
      if (allocated(atom0)) deallocate(atom0)
      return
      end
