      subroutine dens0(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,va,
     *vb,istrans)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      common/dim/ iadri
      dimension va(iadri)
      dimension vb(iadri)
      common/opt/ihab,calcul
      character*3 calcul
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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)
      common/l40/ densa(maxorb,maxorb),densb(maxorb,maxorb)
      yw=.false.
      if(istrans.ne.1) return
      nta=(nt+ispt)/2
      npa=(np+ispp)/2
      ntb=nt-nta
      npb=np-npa
      dd=va(iadr1)*vb(iadr1)
      do i=1,nca
         i1=ica(i)
         densa(i1,i1)=densa(i1,i1)+dd
      enddo
      do i=1,ncb
         i1=icb(i)
         densb(i1,i1)=densb(i1,i1)+dd
      enddo
      do i=1,npa
         i1=iorb(ip(i))
         densa(i1,i1)=densa(i1,i1)+dd
      enddo
      do i=1,npb
         i1=iorb(ip(i+npa))
         densb(i1,i1)=densb(i1,i1)+dd
      enddo
      do i=1,nta
         i1=iorb(it(i))
         densa(i1,i1)=densa(i1,i1)-dd
      enddo
      do i=1,ntb
         i1=iorb(it(i+nta))
         densb(i1,i1)=densb(i1,i1)-dd
      enddo
      return
      end
