      subroutine openlec
      use module
C     use mod_dav
      use mod_lirorb
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      include '../../param/maxlong.prm'
      integer,parameter :: ngru3=2048
      character(50000) namel,namel1,namel2
      character(80) mono,info,ijcl,davec,topo,ijcl2,ijcl3,ijcl4,ess
     *,dens,det,mat
      character(1000) aa
      dimension ibid(8)
      character(18),allocatable,dimension(:) :: tipo
      real(8) dum(ngru3)
      integer dim_heff_init
      logical all_linked_ijkloc
      real(8) slid_ijkloc(0:maxsl)
      !
      ! MAZ
      !
      !call sto5
      call sto5_1(5,93,'CASDILOC_DATA')
      open(75)
      prefix=' '
      ijcl1=' '
      ijcl21=' '
      ijcl31=' '
      ijcl41=' '
      mono1=' '
      info1=' '
      mat1='MATLOC'
      topo1=' '
      davec1=' '
      ess1=' '
      davec1=' '
      dens1=' '
      det1=' '
      mat='mat'
      info='Infoloc'
      mono='Monoloc'
      ijcl='ijcl'
      ijcl2='ijclloc2'
      ijcl3='ijclloc3'
      ijcl4='ijclloc4'
      topo='topo'
      dens='dens'
      densonly=.false.
      det='det'
      ess='ess'
      davec='davec'
      liens='KIJ'
      ms2=0
      sl(1:maxsl)=-1.d0
      !sl=0.01d0
      !sl2=0.0d0
      !sli=1.d-8
      sl=-1.d0
      sl2=-1.d0
      sli=-1.d0
      sl(0)=0.001d0
      sl2(0)=0.0d0
      sli(0)=1.d-8
      gener='CAS+SD'
      nprint=0
      ygendet=.false.
      calcul='MD'
      ydetv=.false.
      ycaspair=.false.
      ytot=.true.
      nessai=0
      w2=.false.
      nvec=1
      nhab=0
      mhab=0
      iterh=2
      twvec=0.03d0
      twdens=0.003d0
      niter=50
      stop='fin'
      dim_heff_init=50
      prec=1.d-6
      mprint=0
      itest=0
      itest(8)=1
      itest(30)=1
      noac=-1
      w=.false.
      w1=.false.
      w2=.false.
      w3=.false.
      w4=.false.
      w5=.false.
      w6=.false.
      w7=.false.
      si=1.d-9
      ydens=.false.
      ydens2=.false.
      ygenverif=.false.
      ytestgendet=.false.
      lifock=.false.
      is0=0
      zone=' '
      t_zone=.false.
      ysuiv=.false.
      suiv=0.8d0
      nsuiv=0
      orthfile=' '
      maxlong_modif=maxlong
      ytana=.false.
      !
      ! Donnees
      !
      call LECNAM('&LOCCI',namel,93,ierr,1)
      call namell(namel,DEBUG,'DEBUG',1)
      call namell(namel,YTANA,'YTANA',4)
      call namell(namel,YHMONO,'YHMONO',4)
      call namell(namel,DENSONLY,'DENSONLY',1)
      call namell(namel,SEL_OLD,'SEL_OLD',4)
      call namela(namel,prefix,'PREFIX')
      call namela(namel,info1,'INFO1')
      call namela(namel,INFO,'INFO')
      call namela(namel,MONO1,'MONO1')
      call namela(namel,MONO,'MONO')
      call namela(namel,TOPO1,'TOPO1')
      call namela(namel,TOPO,'TOPO')
      call namela(namel,MAT1,'MAT1')
      call namela(namel,MAT,'MAT')
      call namela(namel,ijcl21,'IJCLLOC21')
      call namela(namel,ijcl2,'IJCLLOC2')
      call namela(namel,ijcl31,'IJCLLOC31')
      call namela(namel,ijcl3,'IJCLLOC3')
      call namela(namel,ijcl41,'IJCLLOC41')
      call namela(namel,ijcl4,'IJCLLOC4')
      call namela(namel,ijcl1,'IJCL1')
      call namela(namel,ijcl,'IJCL')
      call namela(namel,DAVEC1,'DAVEC1')
      call namela(namel,DAVEC,'DAVEC')
      call nameli(namel,maxlong_modif,'MAXLONG',4)
      call nameli(namel,NPRINT,'NPRINT',4)
      call nameli(namel,MPRINT,'MPRINT',4)
      call nameli(namel,ITEST,'ITEST',4)
      call nameli(namel,NVEC,'NVEC',4)
      call nameli(namel,NHAB,'NHAB',4)
      call nameli(namel,MHAB,'MHAB',4)
      call nameli(namel,ITERH,'ITERH',4)
      call nameli(namel,NITER,'NITER',4)
      call nameli(namel,noac,'NOAC',4)
      call nameli(namel,NUMAC(1),'NUMAC',4)
      call nameli(namel,IS0,'IS0',4)
      call nameli(namel,MS2,'MS2',4)
      ms2=-abs(ms2)
      call nameli(namel,NESSAI,'NESSAI',4)
      call namela(namel,ess1,'ESS1')
      call namela(namel,ess,'ESS')
      call nameli(namel,MAXLONG,'MAXLONG',4)
      call namela(namel,CALCUL,'CALCUL')
      call namela(namel,STOP,'STOP')
      call namela(namel,LIENS,'LIENS')
      call namela(namel,GENER,'GENER')
      if(gener=='CAS'.and.nessai==3) nessai=0
      call namela(namel,SYSPIN,'SYSPIN')
      call nameld(namel,SL2,'SL2',8)
      call nameld(namel,TWVEC,'TWVEC',8)
      call nameld(namel,TWDENS,'TWDENS',8)
      call namell(namel,ALL_LINKED,'ALL_LINKED',4)
      call nameld(namel,SLID,'SLID',8)
      call nameld(namel,SLI,'SLI',8)
      call nameld(namel,SL,'SL',8)
      call namell(namel,t_zone,'T_ZONE',4)
      call namela(namel,zone,'ZONE')
      call nameli(namel,DIM_HEFF_INIT,'DIM_HEFF',4)
      call init_david(DIM_HEFF_INIT)
      call namell(namel,YGENDET,'YGENDET',1)
      call namell(namel,YTESTGENDET,'YTESTGENDET',1)
      call namell(namel,YDETV,'YDETV',1)
      call namell(namel,YDENS,'YDENS',1)
      call namell(namel,LIFOCK,'LIFOCK',4)
      call namela(namel,dens1,'DENS1')
      call namela(namel,dens,'DENS')
      call namell(namel,YCASPAIR,'YCASPAIR',1)
      call namell(namel,YWCAS,'YWCAS',1)
      call namell(namel,YTOT,'YTOT',4)
      call namell(namel,YGENVERIF,'YGENVERIF',1)
      call nameld(namel,PREC,'PREC',8)
      call namell(namel,W1,'W1',4)
      call namell(namel,W2,'W2',4)
      call namell(namel,W3,'W3',4)
      call namell(namel,W4,'W4',4)
      call namell(namel,W5,'W5',4)
      call namell(namel,W6,'W6',4)
      call namell(namel,W,'W',4)
      call nameld(namel,SI,'SI',8)
      call namell(namel,YSUIV,'YSUIV',4)
      call nameli(namel,NSUIV,'NSUIV',4)
      call nameld(namel,SUIV,'SUIV',8)
      call namela(namel,ORTHFILE,'ORTHFILE')
      call namell(namel,S2EIGEN,'S2EIGEN',4)
      call namell(namel,UCI,'UCI',4)
      call namell(namel,COND_OCC,'COND_OCC',4)

! Valeurs possibles de gener:
      call titre('Gener: Possible Values#',300)
      if(gener(1:3)=='CAS') then
         if(gener(5:8)==' ') print*,'CAS'
         if(gener(5:8)=='S   ') print*,'CAS + 1H + 1P'
         if(gener(5:8)=='DDC2') print*,'CAS + DDC2'
         if(gener(5:8)=='DDCI') print*,'CAS + DDCI'
         if(gener(5:8)=='SD  ') print*,'CAS+SD'
      else
      endif
!
! Introduction de facteurs de correction des integrales d'echange 
! pour PSRCI lambda_uci1, lambda_uci0
!
      lambda_uci1=1.0d0
      lambda_uci0=0.0d0
      if(uci) then
         lambda_uci1=0.5d0
         lambda_uci0=0.5d0
         call nameld(namel,lambda_uci1,'LAMBDA_UCI1',8)
         call nameld(namel,lambda_uci0,'LAMBDA_UCI0',8)
      endif
      if(uci.and.gener(1:3)/='SEL') then
         print*,'uci=T and gener=',gener,'  impossible'
         stop
      endif
      if(uci) s2eigen=.false.
      if(ysuiv.and.nsuiv==0) nsuiv=nvec+3
! verif donnee zone
      do k=1,maxsl
         if(zone(k)==' ') exit
         call maj(zone(k),len_trim(zone(k)))
         if(sl(k)<0.d0) then
            print*,'attention, seuil non defini pour la zone',k
            stop
         endif
      enddo
      namel=' '
      write(namel,'(i20)') maxlong_modif
      namel=adjustl(namel)
      call titre('Longueur max des fichiers (en kb) '
     *//trim(namel)//'#',50)
      if(dens1==' ') dens1=trim(prefix)//trim(dens)
      if(det1==' ') det1=trim(prefix)//trim(det)
      if(mono1==' ') mono1=trim(prefix)//trim(mono)
      if(info1==' ') info1=trim(prefix)//trim(info)
      if(mat1==' ') mat1=trim(prefix)//trim(mat)
      if(ijcl1==' ') ijcl1=trim(prefix)//trim(ijcl)
      if(ijcl21==' ') ijcl21=trim(prefix)//trim(ijcl2)
      if(ijcl31==' ') ijcl31=trim(prefix)//trim(ijcl3)
      if(ijcl41==' ') ijcl41=trim(prefix)//trim(ijcl4)
      if(topo1==' ') topo1=trim(prefix)//trim(topo)
      if(ess1==' ') ess1=trim(prefix)//trim(ess)
      if(davec1==' ') davec1=trim(prefix)//trim(davec)
      if(calcul=='M') nessai=0
      if(calcul=='M') syspin=' '
      if(calcul=='M') itest(8)=1
      if(gener=='CAS') liens='CAS0'
      if(gener=='SEL') liens='CAS0'
      if(ms2/=0) syspin=' '
      if(syspin/='+'.and.syspin/='-') syspin=' '
      if(gener/='CAS'.and.gener/='CAS+S'.and.gener/='CAS+DDC2'.and.
     *gener/='CAS+DDCI'.and.gener/='CAS+SD'.and.
     *gener/='SEL'.and.gener/='SEL+S'.and.gener/='SEL+DDC2'.and.
     *gener/='SEL+DDCI'.and.gener/='SEL+SD'.and.gener/='SEL+S0') then
         print*,'gener= ',gener
         print*,'valeur non prevue'
         stop
      endif
      if(gener(1:3)=='SEL') then
         sel=2
      else
         sel=0
      endif
      if(mhab==0) nhab=0
      if(mhab/=0.and.nhab==0) nhab=1
      if(mhab/=0.and.iterh==0) iterh=2
      if(mhab==0) iterh=niter+1
      if(iterh==-1) iterh=niter+1
!      if(mod(ms2+nelac,2)/=0) then
!         print*,'nelac=',nelac
!         print*,'ms2=  ',ms2
!         print*,'Ces valeurs sont incompatibles'
!         stop
!      endif
      !
      ! Namelist Info
      !
      open(45,file=info1,status='old')
      call LECNAM('&COST_AO',namel2,45,ierr,min(1,nprint))
      if(ierr.eq.1) then
              print*,'il n''y a pas de file info'
              stop
      endif
      call nameli(namel2,nsym,'NSYM',4)
      call nameli(namel2,its(1,1),'ITS',4)
      call nameli(namel2,NATOM,'NATOM',4)
      allocate(atom0(natom))
      call namela(namel2,ATOM0,'ATOM')
      rewind 45
      call LECNAM('&COST_MO',namel1,45,ierr,min(1,nprint))
      if(ierr.eq.1) then
         print*,'incomplete Info file(',trim(info1),')'
         print*,'there is no COST_MO namelist'
         stop
      endif
      call nameld(namel1,enuc,'ENUC',8)
      call namell(namel1,ycl,'YCL',1)
      call nameli(namel1,norb,'NORB',4)
      call nameli(namel1,noc,'NOC',4)
      !
      ! Fichier ijcllocinfo
      !
      open(46,file=trim(prefix)//'ijcllocinfo',status='old')
      call LECNAM('&LOCINF',namel,46,ierr,min(1,nprint))
      intsy=' '
      call namela(namel,INTSY,'INTSY')
      if(intsy=='SYM') then
         call nameli(namel,nsym,'NSYM',4)
         allocate(image(norb,nsym))
         allocate(images(norb,nsym))
         call nameli(namel,images,'IMAGES',4)
         call nameli(namel,image,'IMAGE',4)
         if(nprint>0) then
            do io=1,norb
               print'( a,i4,2x,8i4)','image',io,image(io,:)*images(io,:)
            enddo
         endif
      else
         if(is0/=0) then
            print*,'is0=',is0
            print*,'la symetrie ne peut pas etre prise en compte'//
     *      ' car itest(1)=0 dans ijkloc'
            stop
         endif
      endif
!
! Lecture ALL_LINKED
!
      if(ylocci) then
         aa=' '
! lecture des donnees transmises par ijkloc
         call namell(namel,ALL_LINKED_ijkloc,'ALL_LINKED',4)
         call nameld(namel,slid_ijkloc,'SLID',8)
         slid_ijkloc=slid
         write(aa,*)
     *   'ALL_LINKED, ijkloc value=',all_linked,"#"
         write(aa(len_trim(aa)+1:),*)
     *   'SLID, ijkloc value=',slid_ijkloc(0),'#'
         if(ALL_LINKED_ijkloc) ALL_LINKED=.true.

! re-lecture (en donnee dans &locci)
         rewind 93
         call LECNAM('&LOCCI',namel,93,ierr,1)
         yall_linked=index(namel,'ALL_LINKED=')/=0
         yslid=index(namel,'SLID=')/=0
         call namell(namel,ALL_LINKED,'ALL_LINKED',4)
         call nameld(namel,slid,'SLID',8)

         if(yall_linked.and..not.ALL_LINKED_ijkloc)
     *   write(aa(len_trim(aa)+1:),*)
     *   'ALL_LINKED modified, new value=',all_linked,'#'
         if(yslid) write(aa(len_trim(aa)+1:),*)
     *   'SLID modified, new value=',SLID(0),'##'
         if(slid(0)<slid_ijkloc(0)-1.d-7) then
            print*,len_trim(aa)
            write(aa(len_trim(aa)+1:),'(a,2f12.8,a)')
     *      'Modified slid < ijkloc slid: #SLID_ijkloc,slid='
     *      ,slid_ijkloc(0),slid(0),'#STOP#'
            call titre(aa,70)
            stop
         endif
         if(.not.all_linked_ijkloc.and.all_linked) then
            print*,len_trim(aa)
            write(aa(len_trim(aa)+1:),'(a)')
     *      'all_linked F in ijkloc and T in locci#STOP#'
            call titre(aa,70)
         endif
         call titre(aa,70)
      endif
      close(46)
!
! Fichier dens
!
      if(ydens) then
         if(dens1==' ') dens1=trim(prefix)//'dens'
         open(63,file=dens1,status='UNKNOWN',form='unformatted')
      endif
!
! Calculs d'autres variables du probleme
!
      if(gener(5:8)==' ') igener=0
      if(gener(5:8)=='S   ') igener=1
      if(gener(5:8)=='S0  ') igener=1
      if(gener(5:8)=='DDC2') igener=2
      if(gener(5:8)=='DDCI') igener=3
      if(gener(5:8)=='SD  ') igener=4
      !
      if(noac==-1) then
         ! alors numac est obtenu a partir des orbitales ijkloc
         call lirorb('ORB_IJKLOC',nao,nbid2,ibid,99,98)
         print*,'Les actives sont lues sur les orbitales ijkloc'
         allocate(tipo(nao))
         read(99)
         read(99)
         read(99) tipo
         noac=0
         kk=0
         do k=1,nao
            if(tipo(k)(1:1)=='G') cycle
            kk=kk+1
            if(tipo(k)(1:1)=='A') then
               noac=noac+1
               numac(noac)=kk
            endif
         enddo
         deallocate(tipo)
         close(98)
         close(99,status='delete')
      else
         call reor(noac,numac,idum)
      endif
      noaco=0
      do k=1,noac
         if(numac(k)<=noc) noaco=noaco+1
      enddo
!      if(noaco/=(nelac+1)/2) then
!         print*,'mauvaise occupation'
!         print*,noaco,' orb active(s) en-dessous du niveau de fermi'
!         print*,nelac,' electron(s) actif(s)'
!         stop
!      endif
      noacv=noac-noaco
      nelac=noaco*2-mod(-ms2,2)
      ninac=noc-noaco
      nvirt=norb-noc-noacv
      ninac2=ninac*(ninac-1)/2
      nvirt2=nvirt*(nvirt-1)/2
      nocac0=nelac/2+ms2/2
      nocbc0=(nelac+1)/2-ms2/2
      !
      ! Allocations
      !
      allocate (c(0:noac,-1:noac))
      allocate (iz(min(noac,nocbc0+2),noac,nocac0-2:nocbc0+2))
      allocate (yac(norb))
      yac=.false.
      if(any(numac(1:noac)>norb).or.any(numac(1:noac)<1)) then
         print*,'mauvaise valeur pour numac'
         print'(a,8i4,/,6x,8i4)','numac',numac(1:noac)
         stop
      endif
      yac(numac(1:noac))=.true.
      kk=0
      allocate(numin(ninac),numvir(nvirt),num0(norb))
! num0: num0(orb i)= numero de l'orb quand elles sont rangees dans
! l'ordre occ/cas/virt (ordre de travail de casdiloc)
      do k=1,noc
         if(yac(k)) cycle
         kk=kk+1
         numin(kk)=k
         num0(k)=kk
      enddo
      kk=0
      do k=1+noc,norb
         if(yac(k)) cycle
         kk=kk+1
         numvir(kk)=k
         num0(k)=kk+ninac+noac
      enddo
      do k=1,noac
         num0(numac(k))=k+ninac
      enddo
 
      !
      ! Ecritures
      !
      i=0
      j=60
      namel(i+1:i+20)="NOMBRE D'ORBITALES"
      write(namel(i+22:i+80),1001) norb
      namel(i+60:i+60)='#'
      i=i+j
      namel(i+1:i+20)="NOMBRE D'ELECTRONS"
      write(namel(i+22:i+80),1001) ninac*2+nelac
      namel(i+60:i+60)='#'
      i=i+j
      namel(i+1:i+20)="ORBITALES  ACTIVES"
      write(namel(i+22:i+80),1001) numac(1:min(8,noac))
      if(noac>8) then
         namel(i+60:i+60)='#'
         i=i+j
         if(noac>8) write(namel(i+22:i+80),1001) numac(9:noac)
      endif
      namel(i+60:i+60)='#'
      i=i+j
      namel(i+60:i+60)='#'
      i=i+j
      namel(i+1:i+35)="NOMBRE D'ELECTRONS ACTIFS ALPHA"
      write(namel(i+36:i+80),1001) nocac0
      namel(i+60:i+60)='#'
      i=i+j
      namel(i+1:i+35)="NOMBRE D'ELECTRONS ACTIFS BETA "
      write(namel(i+36:i+80),1001) nocbc0
      namel(i+60:i+60)='#'
 1001 format(20i4)
      i=i+j
      if(ninac==0.and.nvirt==0) then
         mhab=0
         nhab=0
         print*,'ninac==0.and.nvirt==0 : pas d''habillage'
      endif
      if(mhab/=0) then
         namel(i+60:i+60)='#'
         i=i+j
         namel(i+1:i+11)="Habillage :"
         namel(i+60:i+60)='#'
         i=i+j
         write(namel(i+1:i+60),'(a,i1)')'mhab=',mhab
         if(mhab==1)write(namel(i+9:i+60),'(a)')'(MR-CEPA_0)'
         if(mhab==2)write(namel(i+9:i+60),'(a)')'(MR-CEPA_0 raffine)'
         namel(i+60:i+60)='#'
         i=i+j
         write(namel(i+1:i+60),'(a,i1)')'vecteur ref (nhab)=',nhab
         namel(i+60:i+60)='#'
         i=i+j
         write(namel(i+1:i+60),'(a,i3)')
     *   'habillage a partir de l''iteration (iterh) ',iterh
         namel(i+60:i+60)='#'
         i=i+j
      endif
      call titre(namel(1:i),70)

      print*,'Orbitales actives :'
      open(99,file=trim(prefix)//'LOinfo',status='old')
      allocate(loinfo(norb))
      read(99,'(a)') aa
      do k=1,norb
         read(99,'(a)') aa
         read(aa(5:8),'(i4)') i_ijkloc
         loinfo(i_ijkloc)=aa(10:28)
      enddo
      do i=1,noac
         print'(i5,a)',numac(i),'   '//trim(loinfo(numac(i)))
      enddo
      deallocate(loinfo)
      close(99)

      print*,' '
      rewind 93
      call LECNAM('&LOCCI',namel,93,ierr,1)
      rewind 45
      call LECNAM('&COST_MO',namel1,45,ierr,min(1,nprint))
      close(45)
 
 1000 format(a15,i6)
      if(w2) then
      print 1000, 'norb',norb
      print 1000, 'noc',noc
      print 1000, 'noaco',noaco
      print 1000, 'noacv',noacv
      print 1000, 'ninac',ninac
      print 1000, 'nvirt',nvirt
      print 1000, 'nocac0',nocac0
      print 1000, 'nocbc0',nocbc0
      endif
      !
      ! Ouvertures
      !
      open(11,file=davec1,status='unknown',form='unformatted')
      inquire(iolength=long) dum
!      print*,'COUCOU1'
      open(21,status='UNKNOWN',file='LOC_DIRB',access='DIRECT',
     *recl=long,form='UNFORMATTED')
!      print*,'COUCOU2'
      call filesplit('OPEN',21,maxlong_modif,idum,idum2)
!      print*,'COUCOU3'
      open(22,status='UNKNOWN',file='LOC_DIRAB',access='DIRECT',
     *recl=long,form='UNFORMATTED')
!      print*,'COUCOU4'
      call filesplit('OPEN',22,maxlong_modif,idum,idum2)
!      print*,'COUCOU5'
      open(23,status='UNKNOWN',file='LOC_DIRP',access='DIRECT',
     *recl=long,form='UNFORMATTED')
!      print*,'COUCOU6'
      open(24,status='UNKNOWN',file='LOC_DIRR',access='DIRECT',
     *recl=long,form='UNFORMATTED')
!      print*,'COUCOU7'
      open(2,file=trim(prefix)//'fok',status='unknown',
     *form='unformatted')
 
 
 
      return
      end
