      subroutine dens(va,vb,istrans,roij)
      parameter(maxsym=8,maxorbcas=16,maxal=56)
      include 'maxorb.prm'
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
c
c    |-*-*-*-*-*-*-*-|
c    |       b       |
c
      common/dim/ iadri
      common/pr/nprint,mprint(10)
      common/opt/ihab,calcul
      character*3 calcul
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      dimension ntv(maxorbcas+2),npv(maxorbcas+2)
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      common/l40/ densa(maxorb,maxorb),densb(maxorb,maxorb)
      dimension roij(maxorb,maxorb)
      character*4 hab
      common/infdav/ twcas,alam(maxal),tau,twvec,twess,sint,sh
     *,hab,N,nvec,ngao,niter,iprec,lvec(maxal),nfrag,ipresc,irest
     *,jrest
     *,iunit,ihprec,ihvec,ifiess,NESSAI,nf8,maxda2,bidia,ywvec,ytana
     *,yhmono,ydens,ywcas
      logical*1 bidia
      common/adr/iadr0(maxsym),nbint
      dimension va(iadri),vb(iadri)
      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/test/itest(100)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
     *,iodro(maxorb*2)
     *,numinb(maxorb),numvib(maxorb)
c
c-----------------------------------------------------------
c     matrice densite
c-----------------------------------------------------------
c
      yw=.false.
      yw1=.false.
      if(yw)write(6,*)'debut dens',norb
      if(ytana.or.yw)write(6,*)'matrice densite'
c-- mise a zero
      do i=1,norb
         do j=1,norb
            densa(j,i)=0.d0
            densb(j,i)=0.d0
         enddo
      enddo
      do k=1,ninac
         i=numina(k)
         densa(i,i)=1.d0
         densb(i,i)=1.d0
      enddo
c--   lecture des determinants
      iadr1=0
      call rew61
 1    continue
      call venond(ne,ntv,npv,ierr)
      if(ierr.eq.1) goto 100
c      read(61,end=100)ne
c      if(ne.ne.0) read(61)(ntv(k),k=1,ne),(npv(k),k=1,ne)
      iadr1=iadr1+1
      call trad(ne,ntv,npv,nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,ierr)
      coef=1.d0
      b0=va(iadr1)
      if(yw)write(6,*)' di de depart',(ntv(k),k=1,ne),'  ',
     *(npv(k),k=1,ne)
      if(yw)write(6,*)'dens   adresse du di de depart',iadr1
      call dens0(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,
     *va,vb,istrans)
      if(yw)write(6,*)'avant densc '
      call densc(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,vb,
     *istrans)
      if(ygcas) goto 1
      if(yw)write(6,*)'avant densp '
c     print*,'appel densp'
      call densp(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,vb,
     *istrans)
      if(yw)write(6,*)'avant denscp '
      call denscp(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,vb,
     *istrans)
      if(yw)write(6,*)'avant denstp '
      call denstp(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,vb,
     *istrans)
      if(yw)write(6,*)'avant denst '
      call denst(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,vb,
     *istrans)
C      if(yw)write(6,*)'avant denstc '
      call denstc(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,vb,
     *istrans)
      goto 1
 100  continue
c      rewind 63
c      a voir en cas de sc2
!      yw=.true.
!      nprint=2
      if(yw) then
         write(6,*)' '
         print*,'matrice densite alpha'
         write(6,*)' '
         call script(densa,norb,norb,maxorb,maxorb)
         aa=0.d0
         do k=1,norb
            aa=aa+densa(k,k)
         enddo
         print*,'aa',aa
         write(6,*)' '
         print*,'matrice densite beta'
         write(6,*)' '
         call script(densb,norb,norb,maxorb,maxorb)
      endif
      do k=1,norb
         do l=1,norb
            roij(l,k)=densa(l,k)+densb(l,k)
         enddo
      enddo
      if(nprint.ge.2) then
         write(6,*)' '
         print*,'matrice densite '
         write(6,*)' '
         call script(roij,norb,norb,maxorb,maxorb)
      endif
!      yw=.false.
      nprint=0
      return
      end
