      subroutine casci
      use module
      use mod_licost
      use mod_tijkl
      use mod_script
      use mod_sto
!
!--------------------------------------------------------------
! prepare files Info, Mono and ijcl to run CASCI calculation
!
! Info: modify enuc in &cost_mo, to take into account the occupied
!       orbitals, as if they were frozen
! Mono: modify One-electron molecular integrals, for the same reason
! ijcl: build a subset of the ijcl file, containing only active indices
!
! The files are Info_casci, Mono_casci, ijcl_casci
!--------------------------------------------------------------
!
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      double precision,allocatable,dimension(:) :: h8,h8_ac
      double precision,allocatable,dimension(:,:) :: hmonot
      character(80) aaa
      integer frozen_sv(8),inac_sv(8),isym_sv(8)
      yw=.false.
      if(yw)print*,'entree casci'
      print*,' '
      print*,'================================================='
      print*,'               casci_files=T'
!
! modify enuc from One-electron integrals
!
      ii=sum(num1(isym(:)+1))
      allocate(h8(ii))
      rewind 26
      do is=1,nsym
         if(isym(is)==0) cycle
         read(26) h8(1:num1(isym(is)+1))
         kk=0
         do k=1,inac(is)
            kk=kk+k
            enuc=enuc+h8(kk)*2
            if(yw)print*,'enuc',is,k,enuc,h8(kk)
         enddo
      enddo
!
! declare occupied as frozen to run tijklfr. Modifies enuc and
! One-electron integrals
!
      frozen_sv=frozen
      inac_sv=inac
      isym_sv=isym
      frozen=inac
      inac=0
      isym=act
      norb=sum(isym)
      msym1=maxval(isymoa(1:nsym))
      msym2=maxval(frozen(1:nsym)+act(1:nsym))
      allocate(om1(msym1,msym2))
      rewind 33
      rewind 34
      open(99,form='unformatted',status='unknown',file='TEMP')
      do is=1,nsym
         read(33) om1(1:isymoa(is),1:frozen(is)+act(is))
         write(34) om1(1:isymoa(is),1:frozen(is))
         write(99) om1(1:isymoa(is),frozen(is)+1:frozen(is)+act(is))
      enddo
      close(99)
      open(33,form='unformatted',status='old',file='TEMP')
!
! Modify enuc and one-electron integrals from two-electron integrals
!
      if(any(frozen/=0)) then
         !call maxallo
! transfer active one-el integrals of h8 into h8_ac
!   allocate h8_ac
         ii=sum(num1(isym(:)+1))
         allocate(h8_ac(ii))
!   read h8
         ifing=0
         rewind 26
         do is=1,nsym
            if(isym_sv(is)==0) cycle
            read(26) h8(1:num1(isym_sv(is)+1))
            idebg=ifing+1
            ifing=ifing+num1(isym(is)+1)
            h8_ac(idebg:ifing)=h8(frozen(is)+1:frozen(is)+isym(is))
         enddo
!    write h8_ac to 26
         rewind 26
         ifin=0
         do is=1,nsym
            if(isym(is)==0) cycle
            ideb=ifin+1
            ifin=ifin+num1(isym(is)+1)
            write(26) h8_ac(ideb:ifin)
         enddo
!   modify One-el integrals in tijklfr 
         rewind 26
         call tijklfr!(hhh,hhh(nfr*idimfr+1))
         rewind 26
         ifin=0
         if(yw)print*,'casci isym',isym
         do is=1,nsym
            if(isym(is)==0) cycle
            ideb=ifin+1
            ifin=ifin+num1(isym(is)+1)
            read(26) h8_ac(ideb:ifin)
         enddo
         if(yw)print*,'h8_ac'
         if(yw)print'(10f10.6)',h8_ac
         !deallocate(hhh)
      endif
            if(yw)print*,'enuc',enuc
      frozen=frozen_sv
      inac=inac_sv
      isym=isym_sv
!
! Modify Info
!
      open(99,file=trim(info1)//'_casci',status='unknown')
      rewind 20
! copy cost_AO
      do
         read(20,'(a)') aaa
         if(index(aaa,'&cost_MO')/=0) exit
         write(99,'(a)') trim(aaa)
         if(yw)write(6,'(a)') trim(aaa)
      enddo
! Modify enuc in cost_MO
      write(99,'(a)') ' &cost_MO'
      do
         read(20,'(a)',end=1) aaa
         if(index(aaa,'enuc')/=0) then
            write(99,'(a,f20.12)') ' enuc=',enuc
            if(yw)write(6,'(a,f20.12)') ' enuc=',enuc
            cycle
         endif
         write(99,'(a)') trim(aaa)
         if(yw)write(6,'(a)') trim(aaa)
      enddo
 1    continue
      close(99)
!
! Modify Mono
!
      open(99,file=trim(mono1)//'_casci',status='unknown',
     *form='unformatted')
      rewind 21
! write overlap matrix
      call lis(21,overlap,'SYM  ',noa)
      call ecris(99,overlap,noa,trim(mono1)//'_casci',
     *'ijkl',.true.,nsym,isymoa,(/(k,k=1,noa)/))
! Modify Hmono matrix
      norb=sum(isym)
      ii=0
      jj=0
      h8=0.d0
      allocate(hmonot(norb,norb))
      hmonot=0.d0
      if(yw)print*,'yac',yac
      do is=1,nsym
         iss=sum(isym(1:is-1))
         do i=1,isym(is)
            do j=1,i
               ii=ii+1
               if(yac(i+iss).and.yac(j+iss)) then
                  jj=jj+1
                  h8(ii)=h8_ac(jj)
                  hmonot(i+iss,j+iss)=h8_ac(jj)
                  hmonot(j+iss,i+iss)=h8_ac(jj)
               endif
            enddo
         enddo
      enddo
      if(yw)print*,'hmonot'
      if(yw)call mscript(hmonot)
      if(yw)print*,'insinv',insinv
      call ecris(-99,hmonot,norb,'BID','BID',.false.,nsym,isym,
     *insinv)
      close(99)
!
! Modify ijcl
!
      ninac=sum(inac)
      yac=.false.
      yac(ninac+1:ninac+noac)=.true.
      if(yw)print*,'inac',inac
      if(yw)print*,'yac',yac
      open(99,file=trim(ijkl1)//'_casci',status='unknown',
     *form='unformatted')
      call filesplit('OPEN',99,maxlong_modif,idum,idum2)
      rewind 72
      call stoijkl(ibid,jbid,kbid,lbid,abid,0)
      call lirijcl(0,ijkl0,a,72,idum1,idum2)
      !if(all(yac(ijkl0))) print*,'ijkl0',ijkl0,a
      do
         !if(ijkl0(4)==0) exit
         !if(all(yac(ijkl0))) print*,'ijkl',ijkl0,a
         call lirijcl(1,ijkl0,a,72,idum1,idum2)
         if(yw)print'(a,4i4,f10.6)','ijkl0',ijkl0,a

         if(ijkl0(4)==0) exit
         if(all(yac(ijkl0)))
     *   call stoijkl(ijkl0(1),ijkl0(2),ijkl0(3),ijkl0(4),a,99)
      enddo
      call stoijklf(99)
      print*,'            3 files generated:'
      print*,'              '//trim(info1)//'_casci'
      print*,'              '//trim(mono1)//'_casci'
      print*,'              '//trim(ijkl1)//'_casci'
      print*,'================================================='
      print*,' '
                  
               
      
      
      
      
      return
      end

