      subroutine openlec
      use module
      use mod_licost
      use mod_script
      use mod_lirorb
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      include '../../param/maxlong.prm'
      character(1280) namel
      character(80) file,blan40
      character(80) inforef,monoref,info,mono
      dimension isymsv(8)
      character(1000) aa
      open(75)
      yw=.false.
      yw1=.false.
!
! store the data in file 93
!
      call sto5
!
! read the data
!
      orb1=' '
      ijkl1=' '
      pqrs1=' '
      aoone1=' '
      call LECNAM('&IJKL ',namel,93,ierr,0)
      if(ierr.eq.1) then
         print*,'namelist IJKL not found'
         stop
      endif
      prefix=blan40
      ycln=.false.
      nprint=0
      mem=256
      frozen=0
      ndelete=0
      orb1='INPORB'
      ywtot=.false.
      call namela(namel,prefix,'PREFIX')
      call namell(namel,YWTOT,'YWTOT',4)
       
      info1=' '
      mono1=' '
      inforef1=' '
      monoref1=' '
      info='Info'
      mono='Mono'
      inforef='Info'
      monoref='Mono'
      inforef1=' '
      monoref1=' '
      ydelf=.true.
      delete=0
      orb_sort='OV'
      maxlong_modif=maxlong
      pqrs_already_splitted=.false.
      call namela(namel,INFO1,'INFO1')
      call namela(namel,INFO,'INFO')
      call namela(namel,MONO1,'MONO1')
      call namela(namel,MONO,'MONO')
      call namela(namel,INFOREF1,'INFOREF1')
      call namela(namel,INFOREF,'INFOREF')
      call namela(namel,MONOREF1,'MONOREF1')
      call namela(namel,MONOREF,'MONOREF')
      if(info1==' ') info1=trim(prefix)//trim(info)
      if(Mono1==' ') Mono1=trim(prefix)//trim(mono)
      if(inforef1==' ') inforef1=trim(prefix)//trim(inforef)
      if(Monoref1==' ') Monoref1=trim(prefix)//trim(monoref)
      call namela(namel,PQRS1,'PQRS1')
      call namela(namel,AOONE1,'AOONE1')
      call namela(namel,ORB_SORT,'ORB_SORT')
      call maj(orb_sort,3)
      call namela(namel,ORB1,'ORB1')
      call namela(namel,IJKL1,'IJKL1')
      call nameli(namel,NPRINT,'NPRINT',4)
      call nameli(namel,MEM,'MEM',4)
      call nameli(namel,FROZEN,'FROZEN',4)
      call nameli(namel,MAXLONG_modif,'MAXLONG',4)
      call nameli(namel,DELETE,'DELETE',4)
      call namell(namel,YCLN,'YCL',4)
      call namell(namel,YDELF,'YDELF',1)
      call namell(namel,PQRS_ALREADY_SPLITTED,'PQRS_ALREADY_SPLITTED',1)
!
! open files
!
      open(20,file=INFOREF1,status='old')
      open(21,file=MONOREF1,status='old',form='unformatted')
 
!
! read inforef file
!
      call licost_ao(20,0)
      if(info1==inforef1) then
! The input and output Info files are the same
         rewind 20
      else
! close inforef1, open info1
         close(20)
         open(20,file=info1,status='replace',form='unformatted')
      endif
      call ecricost_ao(20,0,info1,'ijkl')
      noa=norb
      isymoa=isym
      ycl=ycln
!
! read monoref file
!
      allocate(overlap(noa,noa))
      allocate(hmono(noa,noa))
      call lis(21,overlap,'SYM  ',noa)
      if(yw) print*,'Overlap matrix'
      if(yw) call mscript(overlap)
      if(monoref1==mono1) then
! The input and output Mono files are the same
         rewind 21
      else
! close monoref1, open mono1
         close(21)
         open(21,file=MONO1,status='replace',form='unformatted')
      endif
      call ecris(21,overlap,noa,mono1,'ijkl',.true.,nsym,isymoa,
     *(/(k,k=1,noa)/))
      deallocate(hmono)
      isym=isym-frozen-delete
      !norb=sum(isym(1:nsym))
      allocate(itsym(norb))
! build itsym
      norb=0
      do is=1,nsym
         do i=1,isym(is)
            norb=norb+1
            itsym(norb)=is
         enddo
      enddo
!
! Fermi level and active orbitals
!
!      fermi=0
!      open(99,file='SCH_FERMI',status='old',err=99)
!      call LECNAM('&FERM ',aa,99,ierr,0)
!      if(ierr==1) then
!         print*,'SCH_FERMI exists but does not contain fermi'
!         stop
!      endif
!      call nameli(aa,FERMI,'FERMI',4)
!      close(99)
! 99   continue
      call nameli(namel,FERMI,'FERMI',4)
         
!
! Active orbitals
!
      SEMI_ACTIVE=.false.
      numac=0
      inac=0
      nactel=0
      act=0
      casci_files=.false.
      call namell(namel,SEMI_ACTIVE,'SEMI_ACTIVE',4)
      call nameli(namel,numac,'NUMAC',4)
      call nameli(namel,INAC,'INAC',4)
      call nameli(namel,NACTEL,'NACTEL',4)
      call nameli(namel,ACT,'ACT',4)
      call namell(namel,casci_files,'CASCI_FILES',1)
      if(fermi(1)==0) call calfermi
      call calnumac
      if(SEMI_ACTIVE.and.numac(1)==0) then
         print*,'SEMI_ACTIVE is True and no active orbitals were found'
         stop
      endif
      if(casci_files.and.numac(1)==0) then
         print*,'casci_files is True and no active orbitals were found'
         stop
      endif
      do k=1,maxorbcas
         if(numac(k)==0) then
            noac=k-1
            exit
         endif
      enddo
      call reor(noac,numac,ibid)
         
!
! open ijcl file
!
      print*,'=============open 2-int files============='
      if(pqrs1==' ') pqrs1=trim(prefix)//'AO_Two'
      if(aoone1==' ') aoone1=trim(prefix)//'AO_One'
      print*,'open file ',trim(pqrs1)
      open(11,file=pqrs1,status='old',form='unformatted')
      open(1,file=AOOne1,form='unformatted',status='old')
 
      if(ycln) then
         if(ijkl1==' ') ijkl1=trim(prefix)//'IJCL'
         print*,'open file ',trim(ijkl1)
         open(73,file=ijkl1,status='unknown',form='formatted')
      else
         if(ijkl1==' ') ijkl1=trim(prefix)//'ijcl'
         print*,'open file ',trim(ijkl1)
         open(72,file=ijkl1,status='unknown',form='unformatted')
         call filesplit('OPEN',72,maxlong_modif,idum,idum2)
      endif
      print*,'=========================================='
      print*,' '
      print*,'====================================================='
      print'(2a)'   ,' Prefix                     ',trim(prefix)
      print'(a,8i5)',' Number of atoms            ',natom
      print'(a,8i5)',' Number of AO''s             ',noa
      print'(a,8i5)',' Number of MO''s             ',norb
      print'(a,8i5)',' AOs / sym                  ',isymoa(1:nsym)
      print'(a,8i5)',' Frozen Orb / sym           ',frozen(1:nsym)
      print'(a,8i5)',' Deleted Orb / sym          ',delete(1:nsym)
      print'(a,8i5)',' MOs / sym                  ',isym(1:nsym)
      print'(2a)'   ,' AOTwo file                 ',trim(pqrs1)
      print'(2a)'   ,' AOOne file                 ',trim(aoone1)
      print'(2a)'   ,' ORB_SORT                   ',ORB_SORT
      print'(2a)'   ,'                            '
      print*,'== Fermi level and active orbitals =='
      print'(a,8i4)'   ,' Fermi                      ',Fermi(1:nsym)
      print'(a,i4)'   ,' Noac                       ',noac
      if(noac>0) then
         print'(a,16i4)'   ,' Numac                      ',numac(1:noac)
         print'(a,i4)'   ,' Nactel                     ',Nactel
         print'(a,8i4)'   ,' Act                        ',Act(1:nsym)
         print'(a,8i4)'   ,' Inac                       ',Inac(1:nsym)
      endif
      if(SEMI_ACTIVE) then
         print'(a,8i5)',' Semi-active integrals only '
         print'(a,8i5)',' Active orbitals            ',numac(1:noac)
!         allocate(yac(norb))
!         yac=.false.
!         yac(numac(1:noac))=.true.
      endif
      if(noac>0) then
         allocate(yac(norb))
         yac=.false.
         yac(numac(1:noac))=.true.
         if(yw)print'(a,40l1)','yac openlec ',yac
      endif
      print'(a,l1)',' Ycl=',ycl
      print*,'====================================================='
      print*,' '
      print*,' '
      return
      end
       subroutine calnumac
!
!============================================================
!     In the standard use of the program:
!     1. If orb_sort=='SYM' no data concerning active orbitals is 
!        necessary. The orbitals are ordered symmetry by symmetry.
!     2. otherwise:
!        The data to be given are inac, act and nactel. Noac and 
!        Numac are then generated by this subroutine, and used in the
!        following of the program.
!     3. It is possible to give also noac and numac, but in this case
!        inac and act must not be given in data and fermi must be given,
!        or SCH_FERMI must exist
!============================================================
!
      use module
      use mod_licost
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      if(numac(1)/=0) then
         if(any(inac/=0)) then
            print*,'Contradiction in data: numac/=0 and inac/=0'
            stop
         endif
         if(any(act/=0)) then
            print*,'Contradiction in data: numac/=0 and act/=0'
            stop
         endif
         n=0
         inac=fermi
         noc=sum(fermi(1:nsym)) 
         do k=1,maxorbcas
            if(numac(k)==0) exit
            n=n+1
            is=itsym(numac(k))
            if(numac(k)<=sum(isym(1:is-1))+fermi(is))
     *      inac(itsym(numac(k)))=inac(itsym(numac(k)))-1
            act(itsym(numac(k)))=act(itsym(numac(k)))+1
         enddo
      else
!        compute numac
         n=0
         do is=1,nsym
            do k=inac(is)+1,inac(is)+act(is)
               n=n+1
               numac(n)=k+sum(isym(1:is-1))
            enddo
         enddo
      endif
      return
      end
       subroutine calfermi
      use module
      use mod_lirorb
      use mod_licost
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      real(8),allocatable :: orb_loc(:,:),occup(:)
      character(18),allocatable :: label_loc(:)
      dimension isy(16),occ(16),isym_loc(8)
      dimension ml(1)
      logical exist_label
      character cc
      yw=.false.
      if(yw)print*,'entree calfermi'
      
      if(all(inac==0).and.all(act==0)) then
         print*,'if inac and act are not given, fermi MUST be given'
         print*,'inac',inac
         print*,'act',act
         stop
      endif
      call lirorb_direct('INPORB',0,0,norb_loc,nsym,isym_loc,98,99,
     *orb_loc,occup,label_loc,n)
      fermi=inac
      ii=0
      exist_label=.false.
      do is=1,nsym
         if(act(is)==0) cycle
         n=isym_loc(is)
         allocate(orb_loc(n,n),occup(n),label_loc(n))
         call lirorb_direct('INPORB',1,is,norb_loc,nsym,isym_loc,98,99,
     *   orb_loc,occup,label_loc,n)
         do i=inac(is)+1,inac(is)+act(is)
            ii=ii+1
            occ(ii)=occup(i)
            isy(ii)=is
         enddo
         exist_label=exist_label.or.any(label_loc/=' ')
         deallocate(orb_loc,occup,label_loc)
      enddo
      close(98,status='delete')
      if(yw) then
         do k=1,ii
            print*,'occ,isy',k,occ(k),isy(k)
         enddo
      endif
      nl=(nactel+1)/2
      if(yw)print*,'fermi avant',fermi
      do k=1,nl
         ml=maxloc(occ)
         fermi(isy(ml(1)))=fermi(isy(ml(1)))+1
         occ(ml(1))=-1.d0
      enddo
      if(yw)print*,'fermi apres',fermi
      !print'(a,8i3)','fermi level',fermi(1:nsym)
      open(99,file='SCH_FERMI',status='unknown')
      write(99,'(" &ferm fermi=",8(i4,","),a)') fermi(1:8),' /'
      close(99)
! if there are no labels on orbitals, add labels on INPORB,
! indicating if the orbitals are active
      if(.not.exist_label) then
         call lirorb('INPORB',norb_loc,nsym,isym_loc,98,99)
         do
            read(98,end=1)
         enddo
 1       continue
         do is=1,nsym
            write(cc,'(i1)') is
            n=isym_loc(is)
            allocate(label_loc(n))
            label_loc='O_'//cc
            do k=inac(is)+1,inac(is)+act(is)
               label_loc(k)='A_'//cc
            enddo
            write(98) label_loc
            deallocate(label_loc)
         enddo
         close(99,status='delete')
         call ecriorb('ORB LOCCASSCF  LABELS ADDED'
     *   ,'INPORB',nsym,isym_loc,98,99)
      endif
      return
      end
