      Subroutine Fill_Chol(nSym,isym)
      use molcost

      Implicit Real*8 (a-h,o-z)
      Integer isym(nSym)
      Character*8 Fnam
      Integer c_open,c_lseek,c_read
      logical yw
      integer(8) npq_x_numv_x_8
**************************************************
      MulD2h(i,j) = iEOR(i-1,j-1) + 1
**************************************************
**************************************************
      yw=.false.




      open(20,file='CHOL_VEC',status='unknown',form='unformatted')
      if(chol_ord=='PQK')
     *open(21,file='CHOL_VEC1',status='unknown',form='unformatted')


!
! Loop over symmetry of cholesky index
!
      print*,' '
      print*,'================================================='
      print*,'Transfert des fichiers _CHMOT dans CHOL_VEC'
      print'(a,8i8)',' numcho (nb de vect Cholesky)',numcho(1:nsym)
      Do jSym=1,nSym

! Open motra cholesky file for symmetry jsym
         write(Fnam(1:7),'(A6,I1)') '_CHMOT',jSym
         fnam(8:8)=' '
         print*,'================================================='
         print*,'Transfert du fichier '//trim(Fnam)//' dans CHOL_VEC'
         open(99,file=fnam,status='old')
         jrc=c_open(trim(Fnam)//char(0))
         !print*,'jrc',jrc
         !krc=c_lseek(jrc,0)
         !print*,'1krc',krc

! Loop on symmetry of q index
         lllu=0
         Do iSymp=1,nSym

            iSymq=MulD2h(iSymp,jSym)


            If (iSymp.le.iSymq) Then
               ll=0

! Number of (p,q) pairs
               !print*,'*************************'
               print'(a,2i3)',' Symetries',isymp,isymq
               If (jSym.eq.1) Then
                  Npq=isym(iSymq)*(isym(iSymq)+1)/2
                  print*,
     *            'nb d''orb/sym, nb de paires PQ',isym(iSymq),Npq
               Else
                  Npq=isym(iSymp)*isym(iSymq)
                  print*,'nb d''orb/sym, nb de paires PQ',
     *            isym(iSymp),isym(iSymq),Npq
               EndIf
               if(Npq==0) cycle

! Size of the chol_vec vector to be copied from _CHMOT to CHOL_VEC:
! npq_x_numv_x_8
               numv=numcho(jsym)
               npq_x_numv_x_8=npq
               npq_x_numv_x_8=npq_x_numv_x_8*numv
               npq_x_numv_x_8=npq_x_numv_x_8*8
               write(6,'(a,i8,a,i8,a,i10,a)')
     *         ' (nb de vect cholesky)*(nb de paires PQ)*8 =',
     *         numv,' *',npq,' * 8 =',npq_x_numv_x_8
               print'(a,i20)'
     *         ,' --> longueur (en bits) de l''info a ecrire'//
     *         ' dans CHOL_VEC',npq_x_numv_x_8


! write CHOL_VEC for jsym/isymp
               write(20) jsym,isymp,numv,npq
               call transfere(jrc,npq_x_numv_x_8,fnam)
            endif
         enddo
      enddo
      print*,'================================================='
      end

       subroutine transfere(jrc,npq_x_numv_x_8,fnam)
      use molcost
      parameter (nblock=2048)
      Implicit Real*8 (a-h,o-z)
      real(8) vec(nblock)
      integer(8) npq_x_numv_x_8,ideb,ifin,jfin
      Character*8 Fnam
      Integer c_open,c_lseek,c_read

      ifin=0
      do
         ideb=ifin+1
         ifin=ifin+nblock
         long=nblock
         if(ifin*8>npq_x_numv_x_8) then
            long=nblock-(ifin-npq_x_numv_x_8/8)
         endif
         if(long==0) exit
!  on lit
         !print*,'long',long
         krc=c_read(jrc,vec,long*8)
         !print*,'krc',krc
         !print'(a,2i15,2i8)','krc',ideb,ifin*8,krc,long*8
         call flush(6)
         if(krc<long*8) then
         !   print*,'long',long
         !   print'(a,2i15,2i10)','krc',ideb,ifin,krc,long*8
            call open_close_chmot(vec,Fnam,jrc,krc,long*8)
         endif
         !if(ideb>=640360449) print*,'coucou'
!  on ecrit
         write(20) vec(1:long)
         !if(ideb>=640360449) print*,'coucou1',long
         if(long/=nblock) exit
         !if(ideb>=640360449) print*,'coucou3',long
      enddo
         !if(ideb>=640360449) print*,'coucou2',long
      end
       subroutine open_close_chmot(vec,Fnam,jrc,krc,n)
      use molcost

      Implicit Real*8 (a-h,o-z)
      parameter (nblock=2048)
      real(8) vec(nblock)
      Character*8 Fnam
      Integer c_open,c_lseek,c_read
      krcd=N-krc
      krcs=krc
      print*,'open_close_chmot  file: close ',Fnam
      if(mod(krcs,8).ne.0) stop 'krcs non lultiple de 8'
      krc=c_close(jrc)
      !print*,'close jrc,krc',jrc,krc
      if(fnam(8:8)==' ') then
         fnam(8:8)='1'
      else
         read(Fnam(8:8),'(i1)') incr
         incr=incr+1
         call flush(6)
         if(incr==10) stop'incr too big in open_close_chmot'
         write(Fnam(8:8),'(i1)') incr
      endif
      print*,'open_close_chmot  file: open  ',Fnam
      jrc=c_open(fnam//char(0))
      !print*,'jrc',jrc
      !print*,'krcs,krcd',krcs,krcd
      krc=c_read(jrc,vec(krcs/8+1),krcd)
      !print*,'krc',krc
      end

