      program LIDET
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      allocatable alpha(:,:),yesp(:)
      character*80 det,prefix,cdi,info
      character(1000) namel
      dimension bb(2048)
      common/debug/ywgen
      yw=yw.or.ywgen
      print*,'------------------------'
      print*,'    LIDET             '
      print*,'------------------------'
      print*,' '
      call LECNAM('&LIDET',namel,5,ierr,1)
      call namela(namel,PREFIX,'PREFIX')
      det=trim(prefix)//'det'
      Info=trim(prefix)//'Info'
      cdi=trim(prefix)//'cdi'
      call namela(namel,DET,'DET')
      call namela(namel,CDI,'CDI')
      call namela(namel,INFO,'INFO')
      open(61,file=det,form='unformatted',status='old')
      info=trim(prefix)//'Info'
      cdi=trim(prefix)//'cdi'
      open(1,file=info,status='old')
      open(2,file=cdi,status='old')
      call LECNAM('&COST_MO',namel,1,ierr,1)
      call nameli(namel,NORB,'NORB',4)
      call LECNAM('&CDI',namel,2,ierr,1)
      call nameli(namel,NDET,'NDET',4)
      call wvec(ndet,norb)
      end


      
       SUBROUTINE script (OAP,M,N,MD,ND)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION OAP(MD,ND)
      nnn=10
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) RETURN
      WRITE(6,1023)
      WRITE(6,1024) (I,I=N1,N2)
      WRITE(6,1022)
      DO 83 JJ=1,M
83    WRITE(6,1025) JJ,(OAP(JJ,II),II=N1,N2)
      WRITE(6,1022)
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) RETURN
      WRITE(6,1023)
      WRITE(6,1024) (I,I=N1,N2)
      WRITE(6,1022)
      DO 84 JJ=1,M
84    WRITE(6,1025) JJ,(OAP(JJ,II),II=N1,N2)
      WRITE(6,1022)
1022  FORMAT(/)
1023  FORMAT(/)
1024  FORMAT(/,1X,10(6X,I2))
1025  FORMAT(3X,I2,10F8.4)
      RETURN
      END



       subroutine venond(ne,ntv,npv,ierr,norb1)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxorb=500,maxorbcas=16,lungo=100,maxne=maxorbcas+2)
      character*1 ctps,cex,c256
      common/detsto/mdestod,ndestod,mdestod1,ndestod1,npie2,mpie2,
     *mpie256,mdestod256,mdestod2561,
     *ctps((maxne)*lungo*2),cex(lungo),c256((maxne/4+1)*lungo)
      common /orb/ norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      dimension ntv(maxorbcas+2),npv(maxorbcas+2)
      dimension np1024(4)
      common/debug/ywgen
      yw=.false.
      yw=yw.or.ywgen
      norb=norb1
      ierr=0
      ndestod1=ndestod1+1
      if(ndestod1.gt.ndestod) then
         read(61,end=1) mdestod,ndestod,(ctps(i),i=1,mdestod),
     *   (cex(i),i=1,ndestod)
     *   ,mdestod256,(c256(i),i=1,mdestod256)
         if(yw)print*,'venond2 lect ndestod,mdestod',ndestod,mdestod
c        print*,'venond2 ctps', (ichar(ctps(i)),i=1,mdestod)
c         print*,'c256',(ichar(c256(k)),k=1,mdestod256)
         ndestod1=1
         mdestod1=0
         mdestod2561=0
         if(yw)print*,'venond2 ndestod',ndestod
      endif
      if(yw)print*,'venond2 ndestod1',ndestod1
      nems=ichar(cex(ndestod1))
      call venond4(nems,ne,mst)
      if(yw)print*,'nems',nems
      msp=mst-(-ms2+1)/2
      if(yw)print*,'nems,ne,mst,msp',nems,ne,mst,msp
      if(yw)print*,'char',(ichar(ctps(k)),k=1,ne+ne)
      if(ne.eq.0) return
      do k=1,mst-1
         mdestod1=mdestod1+1
         it=ichar(ctps(mdestod1))
         if(yw)print*,'it',it
         if(it.le.0) it=it+256
         ntv(k)=it
      enddo
      do k=mst,ne
         mdestod1=mdestod1+1
         it=ichar(ctps(mdestod1))+norb
         if(yw)print*,'it',it,norb
         if(it.le.norb) it=it+256
         ntv(k)=it
      enddo
      do k=1,msp-1
         mdestod1=mdestod1+1
         it=ichar(ctps(mdestod1))
         if(it.le.0) it=it+256
         if(yw)print*,'pit',it
         npv(k)=it
      enddo
      do k=msp,ne
         mdestod1=mdestod1+1
         it=ichar(ctps(mdestod1))+norb
         if(it.le.norb) it=it+256
         if(yw)print*,'4it',it
         npv(k)=it
      enddo
      if(norb.gt.256) then
         do k=1,ne,4
            mdestod2561=mdestod2561+1
            iii=ichar(c256(mdestod2561))
            np1024(4)=iii/64
            np1024(3)=(iii-np1024(4)*64)/16
            np1024(1)=mod(iii,4)
            np1024(2)=mod((iii-np1024(1))/4,4)
            if(yw)print'(2a,i5)','c256',c256(mdestod2561),mdestod2561
            if(yw)print'(a,10i5)','iii,np1024',iii,np1024
            kkk=0
            do kk=k,min(k+3,ne)
               kkk=kkk+1
               npv(kk)=npv(kk)+np1024(kkk)*256
            enddo
         enddo
      endif
      if(yw)print*,'venond2 itv,ipv',(ntv(k),k=1,ne),(npv(k),k=1,ne)
      return
 1    ierr=1
      if(yw)print*,'venond2 lect fin fich',ndestod,ndestod1
      return
      end

       subroutine venond4(nems,ne,mst)
      logical(1) yw,ywgen
      common/debug/ywgen
      yw=.false.
      yw=yw.or.ywgen
c--------------------------------------------------
c     on a la formule nems=ne*(ne+1)/2+mst
c     on doit trouver ne et mst a partir de nems
c     on peut demontrer que :
c--------------------------------------------------
      ne=(  int(dsqrt(8.d0*nems))   -1)/2
      if(yw)print*,'ne',ne
c     alors...
      mst=nems-ne*(ne+1)/2
      if(yw)print*,'nems,ne,mst',nems,ne,mst
      return
      end




       subroutine wvec(ndet,norb)
      parameter (maxal=56)
      PARAMETER (maxorb=500)
      parameter (maxorbcas=16,ngru3=2048)
      IMPLICIT REAL*8 (A-H,O-x,z),LOGICAL*1(y)
      dimension itv(18),ipv(18)
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      character*2 iwspin(maxorb*2)
      character*2 ibla2
      character virg*1,fn*4,itc*4,ipc*4,icc*4
      character*50 detc
      common/opt/ihab,calcul
      character*3 calcul
      common/debug/ywgen
      real*4 b4
      allocatable iorb(:)
      allocate (iorb(norb*2))
      iorb(1:norb)=(/(i,i=1,norb)/)
      iorb(norb+1:norb+norb)=(/(i,i=1,norb)/)
      virg=','
      ibla1=0
      print*,'norb',norb
      twvec=0.08
      do k=1,norb
         iwspin(k)='+ '
         iwspin(k+norb)='- '
      enddo
         write(6,'(a25,i4,''   E='',f12.8,''    '',f18.8)')
     *   'VECTEUR PROPRE NUMERO'
         call rew61
         do ll=1,ndet
            if(ll.gt.1764698) ywgen=.true.
            if(ll.gt.1764703) stop
            call venond(ne,itv,ipv,ierr,norb)
            ne1=ne
            if(ne.ne.0) then
               if(ipv(ne).eq.norb+norb+1)ne1=ne-1
            endif
            ibla2='=>'
 3          continue
            ywv=.true.
            if(ywv) then
               l=(ne)*10+5
               if(l.gt.50) then
                  write(6,6666)(IORB(itv(I)),IWSPIN(itv(I)),I=1,ne),
     *            ibla1,ibla2
                  detc(1:35)='                                   '
                  write(detc,6666)(IORB(ipv(I)),IWSPIN(ipv(I)),I=1,ne1)
                  if(calcul.eq.'MD') then
                     write(6,'(a35)')detc(1:35)
                  else
                     write(6,'(a35,15x,3X,i8)')detc(1:35),ll
                  endif
               else
                  detc(1:50)=' '
                  write(detc,6666) (IORB(itv(I)),IWSPIN(itv(I)),I=1,ne),
     *            ibla1,ibla2, (IORB(ipv(I)),IWSPIN(ipv(I)),I=1,ne1)
                  if(calcul.eq.'MD') then
                     write(6,'(a50,3X,i8)')
     *               detc(1:50)
                  else
                     write(6,'(a50,3X,i8)')
     *               detc(1:50),ll
                  endif
               endif
            endif
6666        FORMAT(1X, 10(I3,A2))
c
         enddo
      return
      end
       subroutine rew61
      implicit real*8(a-h,o-x,z),logical*1(y)
      parameter(lungo=100,maxorbcas=16,maxne=maxorbcas+2)
      character*1 ctps,cex,c256
      common/test/itest(100)
      common/detsto/mdestod,ndestod,mdestod1,ndestod1,npie2,mpie2,
     *mpie256,mdestod256,mdestod2561,
     *ctps((maxne)*lungo*2),cex(lungo),c256((maxne/4+1)*lungo)
      yw=.false.
      mdestod=0
      ndestod=0
      mdestod256=0
      if(yw)print*,'rew61'
      rewind 61
      return
      end

