      subroutine leero(va,vb)
      IMPLICIT REAL*8 (A-H,O-x,z),LOGICAL*1(y)
      parameter(maxsym=8,maxorb=500,maxorbcas=16)
      parameter(maxne=maxorbcas+2,lungo=100)
      common/dim/ iadri
      dimension ntv(maxorbcas+2),npv(maxorbcas+2)
      dimension ntn(maxorbcas+2),npn(maxorbcas+2)
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common /prep/ nca0,ncb0,ic0(maxorbcas),icamun(maxorb+maxorb)
     *,numt(maxorb),nump(maxorb),nv
     *,gener,yoc(maxorb+maxorb),yrefc(maxorbcas),yac(maxorb)
     *,ygmono,ygddci,ygddc2,ygcas,ygtous
      character*4 gener
      common/detsto/mdestod,ndestod,mdestod1,ndestod1,npie2,mpie2,
     *ctps((maxne)*lungo*2),cex(lungo)
      dimension y(maxorb*2+1)
      common/mat/ roij(maxorb,maxorb)
      dimension roij1(maxorb,maxorb)
      dimension val(maxorb*maxorb)
      dimension va(iadri),vb(iadri)
      dimension itab(2048)
      dimension iord(maxorb)
      common/orbi/ngel(8),ndel(8),norbs(8),norb2
      common/pr/nprint,mprint(10)
      LOGICAL BIDIA
      common/infdav/ alam(56),tau,twvec,twess,sint,sh
     *,hab,Nbtots,nvec,ngao,niter,iprec,lvec(56),ipresc,irest
     *,iunit,ihprec,ihvec,ifiess,NESSAI,nf8,BIDIA,maxda2,ywvec,ytana
     *,yhmono,ydens,ywcas
      common/ronum/deltae,numero(2)
      common/ref2/refmr1,refmr,prefix
      common/preff/prefff
      character*2 iwspin(maxorb*2)
      character*80 file,prefix,refmr1,refmr
      common/cas_spin/isz0
      common /wvc/ iwspin
      dimension e(50)
       yw=.false.
      nel=ninac*2+nelac
      nelb=(nel-ms2)/2
      nela=nel-nelb
      norbb=norb+mod(-ms2,2)
      do k=1,norb
         iwspin(k)='+ '
         iwspin(k+norb)='- '
      enddo

      do k=1,norb
         do l=1,norb
            roij(l,k)=0.d0
         enddo
      enddo
      print*,' '
      print*,'***********************************************'//
     *'******************************'
      print*,'         lecture des vecteurs'
c
c     symetries des 2 vecteurs, dimensions, energies
c
      rewind 60
      mdestod=0
      ndestod=0
      mdestod1=0
      ndestod1=0
      call venond1(60,ne,ntv,npv,ierr)
      if(yw)print*,'ntv,npv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
      isa=1
      do k=1,ne-1
         isa=its(isa,itsym(ntv(k)))
         isa=its(isa,itsym(npv(k)))
      enddo
      if(ne.ne.0)isa=its(isa,itsym(ntv(ne)))
      if(ne.ne.0.and.npv(ne).ne.norb+norb+1) isa=its(isa,itsym(npv(ne)))
      read(10) ndeta,nvec
      read(10) (e(k),k=1,nvec)
      e1=e(numero(1))
      print*,'e1',e1
      do k=1,numero(1)-1
         read(10)
      enddo
      print*,'vecteur 1 : dimension =',ndeta,';     symetrie',isa
c
      rewind 61
      mdestod=0
      ndestod=0
      mdestod1=0
      ndestod1=0
      call venond1(61,ne,ntv,npv,ierr)
      if(yw)print*,'ntv,npv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
      isb=1
      do k=1,ne-1
         isb=its(isb,itsym(ntv(k)))
         isb=its(isb,itsym(npv(k)))
      enddo
      if(ne.ne.0) then
         isb=its(isb,itsym(ntv(ne)))
         if(npv(ne).ne.norb+norb+1) isb=its(isb,itsym(npv(ne)))
      endif
      read(11) ndetb,nvec
      read(11) (e(k),k=1,nvec)
      e2=e(numero(2))
      print*,'e2',e2
      do k=1,numero(2)-1
         read(11)
      enddo
      print*,'vecteur 2 : dimension =',ndetb,';     symetrie',isb
      isro=its(isa,isb)
      print*,'numero',numero
      print*,'***********************************************'//
     *'******************************'
c
c     le vecteur 2 sera reconnu par ses adresses
c     il faut donc le reordonner
c
      call lir8(va,ndetb,11)
      print*,' leero VECTEUR 2'
      rewind 61
      mdestod=0
      ndestod=0
      mdestod1=0
      ndestod1=0
      call reocip(va,vb,itab,ndetb,1)
      do k=1,ndetb
         call venond1(61,ne,ntv,npv,ierr)
         if(dabs(vb(k)).gt.twvec) call wv(ne,ntv,npv,vb(k))
      enddo
c
c     vb contient le vecteur 2
c     on lit le vecteur 1
c
      call lir8(va,ndeta,10)
      print*,' leero VECTEUR 1'
      rewind 60
      mdestod=0
      ndestod=0
      mdestod1=0
      ndestod1=0
      do k=1,ndeta
         call venond1(60,ne,ntv,npv,ierr)
         if(dabs(va(k)).gt.twvec) call wv(ne,ntv,npv,va(k))
      enddo
      deltae=e2-e1
      print*,'deltae',deltae
c
c     signes
c
      call sgn(va,60,ndeta)
      call sgn(vb,61,ndetb)
      print*,'apres sgn'
c
c     boucle sur la lecture des determinants du vecteur 1
c
      mdestod=0
      ndestod=0
      mdestod1=0
      ndestod1=0
      rewind 60
      if(yw)print*,'noca0,nocb0',noca0,nocb0
      if(yw)print*,'nela,nelb,norb,norbb',nela,nelb,norb,norbb
c--   mise a zero des occupations
      do k=1,nela
         y(k)=.true.
      enddo
      do k=1,nelb
         y(k+norb)=.true.
      enddo
      do k=1+nela,norb
         y(k)=.false.
      enddo
      do k=1+nelb,norbb
         y(k+norb)=.false.
      enddo


c vamos a leer del fichero dens 
c      print*,'Vectores iguales: leemos ro de CASDI'
c      print*,'prefix: ',prefix
      call colle(prefix,'dens',file,long)
c      print*,'file: ',file
c      print*,'norb: ',norb
c      print*,'numero(1): ',numero(1)
      
c abrimos el archivo
c hay que leer los datos de norb*norb en norb*norb
c puesto que de esa forma han sido escritos
c y luego ponerlos en roij como toca
      open(63,file=file,STATUS='OLD',form='unformatted')
      do kk=1,numero(1)
            read(63)(val(i),i=1,norb*norb)
      enddo
      do i=1,norb
          do j=1,norb
              roij(i,j)=val((i-1)*norb+j)
          enddo
      enddo
      close(63)

c ahora retomamos calro
c
c     on reordonne ro dans l'ordre des orbitales
c     sans tenir compte de l'ordre Occ/virt
c
      ii=0
      do is=1,nsym
         do k=1,norb
            if(itsym(k).eq.is) then
               ii=ii+1
               iord(ii)=k
            endif
         enddo
      enddo
      do i=1,norb
         do j=1,norb
            roij1((j),(i))=roij(iord(j),iord(i))
         enddo
      enddo
      if(nprint.ge.1) then
      print*,' '
      print*,' '
      print*,' '
      print*,' '
      print*,'MATRICE RO avant reintroduction du gel/del'
      call script(roij1,norb,norb,maxorb,maxorb)
      endif
c
c     on reintroduit les orbitales gelees et les orbitales detruites
c
      ysame=deltae.eq.0

      norb2=norb
      do is=1,nsym
         norb2=norb2+ngel(is)+ndel(is)
      enddo
      kk=0
      kp=0
      do is=1,nsym
         do k=1,ngel(is)
            kk=kk+1
            y(kk)=.false.
         enddo
         norbsp=norbs(is)-ngel(is)-ndel(is)
         do k=1,norbsp
            kk=kk+1
            kp=kp+1
            y(kk)=.true.
            iord(kp)=kk
         enddo
         do k=1,ndel(is)
            kk=kk+1
            y(kk)=.false.
         enddo
      enddo
      do k=1,norb2
         do l=1,norb2
            roij(l,k)=0.d0
         enddo
      enddo
      do k=1,norb
         do l=1,norb
            roij(iord(l),iord(k))=roij1(l,k)
         enddo
      enddo
      if(ysame) then
      kk=0
         do is=1,nsym
            do k=1,ngel(is)
               kk=kk+1
               roij(kk,kk)=2.d0
            enddo
            kk=kk+norbs(is)-ngel(is)
         enddo
      endif

       if(nprint.ge.1) then
      print*,' '
      print*,' '
      print*,' '
      print*,' '
      print*,'MATRICE RO apres reintroduction du gel/del'
      call script(roij,norb2,norb2,maxorb,maxorb)
      endif
      return
      kk=0
      kp=0
      do is=1,nsym
         norbsp=norbs(is)-ngel(is)-ndel(is)
         ll0=kk
         do k=1,ngel(is)
            kk=kk+1
            ll=ll0
            do l=1,norb2
               ll=ll+1
               roij(kk,ll)=0.d0
               roij(ll,kk)=0.d0
            enddo
            if(ysame)roij(kk,kk)=2.d0
         enddo
         ll0=kk
         lp0=kp
         do k=1,norbsp
            kk=kk+1
            kp=kp+1
            ll=ll0
            lp=lp0
            do l=1,norbsp
               ll=ll+1
               lp=lp+1
               roij(kk,ll)=roij1(kp,lp)
               roij(ll,kk)=roij1(lp,kp)
            enddo
         enddo
         ll0=kk
         do k=1,ndel(is)
            kk=kk+1
            ll=ll0
            do l=1,norb2
               ll=ll+1
               roij(kk,ll)=0.d0
               roij(ll,kk)=0.d0
            enddo
         enddo
      enddo
      return
      end



