      subroutine dens
      use module
      if(ypiste) print*,'entree dens'
      if(density=='CASDI') then
         call dens_casdi('CAS+S')
      else if(density=='RODYALL') then
         call dens_casdi('CAS')
         call dens_rodyall
      else
         print*,'bad value for density'
         print*,'Allowed values: DENSITY= ''CASDI'' or ''RODYALL'''
         stop
      endif
      if(ypiste) print*,'sortie dens'
      return
      end
      subroutine dens_casdi(gener0)
      use module
      parameter (maxsym=8,maxorbcas=16,maxet=100,maxrac=50)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(80) fil(maxet)
      character(1000) aa
      character*1 syspin
      character(*) gener0
      logical lex
      if(ypiste) print*,'entree dens_casdi'
!     
! Prepare data for nmat casdi diagonalizations
! (Prepare nmat INi data files, i='nmat')
!     
      do k=1,min(max(nmat,maxit),9)
         num(k)='000'
         write(num(k)(3:3),'(i1)') k
      enddo
      do k=10,min(max(nmat,maxit),99)
         num(k)='000'
         write(num(k)(2:3),'(i2)') k
      enddo
      do k=100,min(max(nmat,maxit),999)
         write(num(k),'(i3)') k
      enddo
      ifin=0
      open(10,file='xx0_casdi',status='unknown')
      y_casdi_bien_fini=.true.
      do imat=1,nmat
! metat(ideb:ifin): roots to be computed
         ideb=ifin+1
         ifin=ifin+netat(imat)
! read data for imat
         rewind 93
         call LECNAM('&CASDI ',namelc,93,ierr,0)
         if(ierr.eq.1) then
            print*,'namelist CASDI not found'
            stop
         endif
         nessai=0
         gener=gener0
         syspin='0'
         is0=1
         iprec=6
         nessai=0
         nessai2=2
         niter=50
         ms2=mod(nactel,2)
         call namela(namelc,GENER,'GENER')
         call calnumac
         call nameli(namelc,MS2,'MS2',4)
         call nameli(namelc,IS0,'IS0',4)
         call namela(namelc,SYSPIN,'SYSPIN')
         call nameli(namelc,IPREC,'IPREC',4)
         call nameli(namelc,NESSAI2,'NESSAI2',4)
         call nameli(namelc,NESSAI,'NESSAI',4)
         call nameli(namelc,NITER,'NITER',4)
! create data file corresponding to casdi calculation Nr. imat
         fil(imat)=' '
         fil(imat)(1:2)='IN'
         write(fil(imat)(3:5),'(i3)') imat
         fil(imat)(3:5)=adjustl(fil(imat)(3:5))
         open(1,file=fil(imat),status='unknown')
! casdet data
         write(1,'(3a)')
     *   ' &cdfil prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(2a)')' det1=''DET'//num(imat),''''
         !call aldon('CDFIL'//ald(1:lald),1)
         write(1,'(a)')' /'
         write(1,'(a,a,a)')' &cd gener=''',
     *   gener(1:len_trim(gener)),''''
         write(1,'(a,i2)')' noac=',noac
         noac0=noac
         write(1,'(a,i2)')' nelac=',nactel
         write(1,'(a,i2)')' is0=',is0
         write(1,'(a,i2)')' ms2=',ms2
         if(noac.ne.0) write(1,'(a,16(i3,a))')
     *   ' numac=',(numac(k),',',k=1,noac)
         write(1,'(a)')' /'
! casdi data
         write(1,'(3a)')
     *   ' &cdifil prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(2a)')' det1=''DET'//num(imat),''''
         write(1,'(2a)')' davec1=''DAVEC'//num(imat),''''
         if(density=='CASDI')
     *   write(1,'(2a)')' dens1=''DENS'//num(imat),''''
         write(1,'(2a)')' ess1='//"'"//'ESS'//num(imat)//"'"
         write(1,'(a)')' /'
         write(1,'(a,a,a)')' &dav syspin=''',syspin,''''
         if(iter==1) write(1,'(a,i1)')' nessai=',nessai
         if(iter>1) write(1,'(a,i1)')' nessai=',nessai2
         write(1,'(a,i3)')' iprec=',iprec
         if(niter/=50) write(1,'(a,i4)')' niter=',niter
         write(1,'(a,i3)')' nvec=',nrac(imat)
         write(1,'(a)') ' /'
         if(iter==1) call display_data(1,'casdet - casdi')
         close(1)
! casdet script
         aa=' '
         write(aa,'(4a)') trim(casdet),' < ',trim(fil(imat))
     *   ,'  '//r//' casdetout'//num(imat)
         write(10,'(a)') aa(1:len_trim(aa))
         if(r.ne.'#')write(10,'(a)') 'cp casdetout'//num(imat)//
     *   ' CASDET'//num(imat)//'.OUT'
         aa=' '
! casdi script
         !write(10,'(a)') 'rm DAVEC'//num(imat)
         write(aa,'(4a)') casdi(1:len_trim(casdi)),' < '
     *   ,fil(imat)(1:len_trim(fil(imat))),'  '//r//' casdiout'//ccc//
     *   '_'//num(imat)
         write(10,'(a)') aa(1:len_trim(aa))
c         write(10,'(a)') 'exit'
         if(r.ne.'#')write(10,'(a)')
     *   'cp casdiout'//ccc//'_'//num(imat)//' CASDI'//num(imat)//'.OUT'
         write(10,'(a)')'cp DAVEC'//num(imat)//' ESS'//num(imat)
         write(10,'(a)')'cp CASDI_BIEN_FINI CASDI_BIEN_FINI'//num(imat)
      enddo
      close(10)
      call system('chmod +x xx0_casdi')
      call system('./xx0_casdi')
! Test: all casdi calculations succeded?
      do imat=1,nmat
         inquire(FILE='CASDI_BIEN_FINI'//num(imat),EXIST=lex)
         if(.not.lex) then
            print*,'CASDI did no succed for matrix',imat
            stop
         endif
      enddo
      if(nprint>0)print*,' '
      if(nprint>0)print*,'############# ITERATION',iter
      do imat=1,nmat
         call output_casdi
      enddo
      if(ypiste) print*,'sortie dens_casdi'
      return
      end
       subroutine calnumac
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      noac=0
      nn=0
! If density=='RODYALL' and in cholesky calculations, the active 
! orbitals are grouped and positioned between the occ and virt
      if(density=='RODYALL'.or.transf=='CHOLESKY') then
         nact=sum(act)
         ninac=sum(inact)
         do k=ninac+1,ninac+nact
            noac=noac+1
            numac(noac)=k
         enddo
      else
! Active orbitals below fermi level
         do is=1,nsym
            if(act(is)/=0) then
               do k=inact(is)+1,fermi(is)
                  noac=noac+1
                  numac(noac)=nn+k
               enddo
            endif
            nn=nn+fermi(is)
         enddo
! Active orbitals over fermi level
         do is=1,nsym
            if(act(is)/=0) then
               do k=1,inact(is)+act(is)-fermi(is)
                  noac=noac+1
                  numac(noac)=nn+k
               enddo
            endif
            nn=nn+isym(is)-fermi(is)
         enddo
      endif
      return
      end
      subroutine dens_rodyall
      use module
      parameter (maxsym=8,maxorbcas=16,maxet=100,maxrac=50)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      logical,allocatable :: zact(:)
      character(3) cc,ddd
      norb=sum(isym(1:nsym))
      allocate(zact(norb))
      zact=.false.
      zact(numac(1:noac))=.true.
      ii=0
      do imat=1,nmat
         do net=1,netat(imat)
            ii=ii+1
            cc='000'
            if(ii<10) then
               write(cc(3:3),'(i1)') ii
            else if (ii<100) then
               write(cc(2:3),'(i2)') ii
            else if (ii<1000) then
               write(cc(1:3),'(i3)') ii
            endif
            ddd='000'
            if(net<10) then
               write(ddd(3:3),'(i1)') net
            else if (net<100) then
               write(ddd(2:3),'(i2)') net
            else if (net<1000) then
               write(ddd(1:3),'(i3)') net
            endif
!     
! Wrapper data
!     
            open(1,file='IN_costnevpt',status='unknown')
            write(1,'(a)') ' &CNEVPT prefix='//"'"//trim(prefix)//"'"
            write(1,'(a,i4)')' numero=',metat(ii)
            write(1,'(a)')' /'
            if(iter==1.and.imat==1.and.net==1)
     *      call display_data(1,'COSTNEVPT')
            close(1)
!     
! exec wrapper
!     
            open(1,file='xx_costnevpt',status='unknown')
            write(1,'(a)') 'cp DAVEC'//num(imat)//' '//
     *      trim(prefix)//'davec'
            write(1,'(a)') 'cp DET'//num(imat)//' '//
     *      trim(prefix)//'det'
            write(1,'(a)') trim(costnevpt)//' < IN_costnevpt '//
     *      r//' costnevptout_'//
     *      ccc
            close(1)
            !print*,'############COSTNEVPT'
            call system('chmod +x xx_costnevpt')
            !call system('ls -l')
            call system('./xx_costnevpt')
!     
! Rodyall data
!     
            open(1,file='IN_rodyall',status='unknown')
            write(1,'(a)') ' &FILES'
            write(1,'(a)') ' FILE04='//"'"//trim(Project)//'.f04'','
            write(1,'(a)') ' FILE25='//"'"//trim(Project)//'.f25'','
            write(1,'(a)') ' FILE26='//"'"//trim(Project)//'.mono'','
            write(1,'(a)') ' FILE27='//"'"//trim(Project)//'.rho'','
            write(1,'(a)') ' FILE29='//"'"//trim(Project)//'.NATUORB'','
            write(1,'(a)') ' FILE50='//"'"//trim(Project)//
     *      '.ijcl'',  &END'
            write(1,'(a)') ' eccS3'
            write(1,'(a)')
     *      ' &ICINP ZSHEPS=T,SHEPSC=-0.5,SHEPSV=0.5,ZTOUL=T,'
            do k=1,norb
               if(zact(k)) then
                  if(k<10) then
                     write(1,'(a,i1,a)') ' ZACT(',k,')=T,'
                  else if(k<100) then
                     write(1,'(a,i2,a)') ' ZACT(',k,')=T,'
                  else if(k<1000) then
                     write(1,'(a,i3,a)') ' ZACT(',k,')=T,'
                  endif
               endif
            enddo
            write(1,'(a)')' &END'
            if(iter==1.and.imat==1.and.net==1)
     *      call display_data(1,'RODYALL')
            close(1)
!     
! exec rodyall
!     
            !print*,'############RODYALL'
            open(1,file='xx_rodyall',status='unknown')
            write(1,'(a)') trim(rodyall)//' < IN_rodyall '//
     *      r//' rodyallout_'//ccc//'_'//ddd
            write(1,'(a)') 'mv '//trim(prefix)//'rho DENS'//cc
            close(1)
            call system('chmod +x xx_rodyall')
            call system('./xx_rodyall')
         enddo
      enddo
      return
      end
       subroutine output_casdi
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(80) aa
      logical yliste
      yliste=.false.
      if(yliste) print*,'entree output'
      if(r=='#') return
      aa="casdiout"//ccc//'_'//num(imat)
      if(nprint>0)call system('grep \| '//aa)
      if(yliste) print*,'sortie output'
      return
      end
      
      
      
