      subroutine openf
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(10000) namel1
      character(300) info,info1
      ypiste=.false.
      call namell(namel,YPISTE,'YPISTE',1)
      if(ypiste) print*,'entree openf'
      
!
! Environnement
!
      call readenv('Project',project)
      call readenv('CurrDir',CurrDir)
      call readenv('WorkDir',workdir)
      print*,'============================================'
      print*,'Project             ',trim(project)
      print*,'currdir             ',trim(currdir)
      print*,'workdir             ',trim(workdir)
      prefix=trim(project)//'.'
!
! Read data
!
      frozen=-1
      delete=-1
      nprint=0
      nmat=1
      conv1=1.d-6
      stop=' '
      pqrs_already_splitted=.false.
      call namela(namel,PREFIX,'PREFIX')
      call namela(namel,TRANSF,'TRANSF')
      call maj(transf,10)
      if(transf==' ') then
         print*,'TRANSF must be given in data'
         stop
      endif
      call namela(namel,DENSITY,'DENSITY')
      call maj(density,10)
      print*,'Transf              ',trim(transf)
      print*,'Density             ',trim(density)
      semi_active=.true.
!
      call nameli(namel,NPRINT,'NPRINT',4)
      call nameli(namel,FROZEN,'FROZEN',4)
      call nameli(namel,DELETE,'DELETE',4)
      call nameli(namel,MAXIT,'MAXIT',4)
      call nameld(namel,CONV1,'CONV',8)
      call nameld(namel,AMIX,'AMIX',8)
      symm=' '
      if(index(namel,'SYMM')==0) then
         print*,' ' 
         print*,'SYMM must be given in data'
         stop
      endif
      call namela(namel,SYMM,'SYMM')
      call namela(namel,PGM,'PGM')
      call namela(namel,CASDET,'CASDET')
      call namela(namel,CASDI,'CASDI')
      call namela(namel,LOCNAT,'LOCNAT')
      call namela(namel,MOLCOST,'MOLCOST')
      call namela(namel,CHOL_X,'CHOL_X')
      call namela(namel,OLDORB,'OLDORB')
      call namela(namel,NEWORB,'NEWORB')
      call namela(namel,REORDENS,'REORDENS')
      call namela(namel,COSTNEVPT,'COSTNEVPT')
      call namela(namel,RODYALL,'RODYALL')
      call namela(namel,IJKL,'IJKL')
      call namell(namel,SEMI_ACTIVE,'SEMI_ACTIVE',4)
      call namell(namel,PQRS_ALREADY_SPLITTED,'PQRS_ALREADY_SPLITTED',1)
      call namela(namel,STOP,'STOP')
      call maj(stop,80)
      if(density=='CASDI') semi_active=.false.
      
! NMAT: nb of CASCI calculations
      call nameli(namel,NMAT,'NMAT',4)
      allocate(netat(nmat))
      netat=1
      call nameli(namel,NETAT,'NETAT',4)
      netattot=sum(netat)
      allocate(metat(netattot))
      allocate(coef(netattot))
! default values for coef and metat
!  coef=nractot*1.d0
!  metat=1,2,3... for each casci calculation
      coef=1.d0
      ii=0
      do imat=1,nmat
         do i=1,netat(imat)
            ii=ii+1
            metat(ii)=i
         enddo
      enddo
      call nameld(namel,coef,'COEF',8)
      call nameli(namel,METAT,'METAT',4)
      allocate(nrac(nmat))
      nrac=netat
      ifin=0
      do imat=1,nmat
         ideb=ifin+1
         ifin=ifin+netat(imat)
         nrac(imat)=max(netat(imat),maxval(metat(ideb:ifin)))
      enddo
      ifin=0
      print*,' '
      do imat=1,nmat
         ideb=ifin+1
         ifin=ifin+netat(imat)
         namel1=' '
         write(namel1,'(a,100f8.4)')', COEF',coef(ideb:ifin)
         write(75,*)'CASCI',imat,' :','NUMERO=',metat(ideb:ifin),
     *   ', NRAC=',nrac(imat),trim(namel1),'$'
         call scril
      enddo
C      ii=0
C      do k=1,nmat
C         do l=1,netat(nmat)
C            ii=ii+1
C            metat(ii)=l
C         enddo
C      enddo
      version='NEW'
      call nameli(namel,VERSION,'VERSION',4)
      yhier=.true.
      yreloc=.true.
      alpha=1.d0
      call namell(namel,YHIER,'YHIER',1)
      call namell(namel,YRELOC,'YRELOC',1)
      call nameld(namel,ALPHA,'ALPHA',8)
      call namela(namel,R,'R')
      print*,'R                   ',R
      nactel=0
      call nameli(namel,nactel,'NACTEL',4)
      inact=0
      call nameli(namel,inact,'INACT',4)
      act=0
      call nameli(namel,ACT,'ACT',4)
      print*,trim(namel)
      if((nactel+1)/2>sum(act)) then
         print*,'Too many active electrons for the active orbitals'
         print*,'================================================='
         stop
      endif
! normalize coef
      coef=coef/sum(coef)
!
! Read nsym and isym (with frozen and deleted orbitals) from Info file
!
      open(99,file=trim(prefix)//'Info',status='old')
      call LECNAM('&COST_AO ',namel1,99,ierr,0)
      call nameli(namel1,nsym,'NSYM',4)
      call nameli(namel1,ISYM,'ISYM',4)
      close(99)
!
! get Fermi level
      call calfermi
!
! Read info from INPORB
      call li_inporb

! If Cholesky, frozen and delete must be 0
      if(transf=='CHOLESKY') then
         if(frozen(1)>0.or.delete(1)>0) then
            print*,'frozen and delete must be zero in '//
     *      'Cholesky caluclations'
            print*,'At this stage:'
            print'(a,8i4)','frozen',frozen(1:nsym)
            print'(a,8i4)','delete',delete(1:nsym)
            stop
         endif
         frozen=0
         delete=0
      endif
! if frozen of delete are unknown, get them from INPORB
      if(frozen(1)==-1.or.delete(1)==-1) then
         call fr_del_el_inporb
     *   ('INPORB',frozen,delete,fermi,ierr)
         if(ierr==1) then
            print*,'frozen or fermi (or both of them) is not given'
            print*,'and file INPORB was not found'
            print*,'give frozen and delete in &NO'
            print*,'At this stage:'
            print'(a,8i4)','frozen',frozen(1:nsym)
            print'(a,8i4)','delete',delete(1:nsym)
            stop
         endif
      endif
      fermi(1:nsym)=fermi(1:nsym)-frozen(1:nsym)
      isym(1:nsym)=isym(1:nsym)-frozen(1:nsym)-delete(1:nsym)
      do is=1,nsym+1
         isymt(is)=sum(isym(1:is-1))
      enddo
      !if(frozen(1)==-1) frozen=0
      !if(delete(1)==-1) delete=0
      
      
      print*,'============================================'
      if(ypiste) print*,'sortie openf'
      return
      end
       subroutine calfermi
      use module
      use mod_lirorb
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(1000) namel1
      if(ypiste) print*,'entree calfermi'
      open(99,file='SCH_FERMI',status='old')
      call LECNAM('&FERM ',namel1,99,ierr,1)
      call nameli(namel1,FERMI,'FERMI',4)
      if(ypiste) print*,'sortie calfermi'
      return
      end
       subroutine li_inporb
      use module
      use mod_lirorb
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(1000) namel1
      character(18) label(1)
      real(8) orb(1,1),occup(1)
C      real(8),allocatable :: orb(:,:),occup(:)
C      character(18),allocatable :: label(:)
C      dimension isy(16),occ(16)
C      dimension ml(1)
C      logical exist_label
C      character cc
C      yw=.false.
      if(ypiste) print*,'entree li_inporb'
C      open(99,file='SCH_FERMI',status='old')
C      call LECNAM('&FERM ',namel1,99,ierr,1)
C      call nameli(namel1,FERMI,'FERMI',4)
C      call system('cp INPORB INPORB_SV_CALFERMI')
C      call system('oldorb > calfermi_out')
C      call system('mv OUTORB INPORB')
C      allocate(orb(1,1),occup(1),label(1))
      call lirorb_direct('INPORB',0,0,norb,nsym,isym,98,99,
     *orb,occup,label,n)
C      deallocate(orb,occup,label)
C      fermi=inac
C      ii=0
C      exist_label=.false.
C      do is=1,nsym
C         if(act(is)==0) cycle
C         n=isym(is)
C         allocate(orb(n,n),occup(n),label(n))
C         call lirorb_direct('INPORB',1,is,norb,nsym,isym,98,99,
C     *   orb,occup,label,n)
C         do i=inac(is)+1,inac(is)+act(is)
C            ii=ii+1
C            occ(ii)=occup(i)
C            isy(ii)=is
C         enddo
C         exist_label=exist_label.or.any(label/=' ')
C         deallocate(orb,occup,label)
C      enddo
C      print*,'exist_label   ',exist_label
C      close(98,status='delete')
C      if(yw) then
C         do k=1,ii
C            print*,'occ,isy',k,occ(k),isy(k)
C         enddo
C      endif
C      nl=(nactel+1)/2
C      if(yw)print*,'fermi avant',fermi
C      do k=1,nl
C         ml=maxloc(occ)
C         fermi(isy(ml(1)))=fermi(isy(ml(1)))+1
C         occ(ml(1))=-1.d0
C      enddo
C      !print'(a,8i3)','fermi level',fermi(1:nsym)
CC      open(2,file='SCH_FERMI',status='unknown')
CC      write(2,'(" &ferm fermi=",8(i4,","),a)') fermi(1:8),' /'
CC      close(2)
C      call system('mv INPORB_SV_CALFERMI INPORB')
C! if there are no labels on orbitals, add labels on INPORB,
C! indicating if the orbitals are active
C      if(.not.exist_label) then
C         call lirorb('INPORB',norb,nsym,isym,98,99)
C         do
C            read(98,end=1)
C         enddo
C 1       continue
C         do is=1,nsym
C            write(cc,'(i1)') is
C            n=isym(is)
C            allocate(label(n))
C            label='O_'//cc
C            do k=inac(is)+1,inac(is)+act(is)
C               label(k)='A_'//cc
C            enddo
C            write(98) label
C            deallocate(label)
C         enddo
C         close(99,status='delete')
C         call ecriorb('ORB LOCCASSCF  Labels Added'
C     *   ,'INPORB',nsym,isym,98,99)
C      endif
      if(ypiste) print*,'sortie li_inporb'
      return
      end
       subroutine readenv(var1,var2)
      use module
      character(*) var1,var2
      if(ypiste) print*,'entree readenv'
      call system('echo $'//trim(var1)//' > LOCCASSCF_BID')
      open(99,file='LOCCASSCF_BID',status='old')
      read(99,'(a)') var2
      close(99,status='delete')
      if(ypiste) print*,'sortie readenv'
      return
      end
      
