      program LOCCASSCF
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
!     
      print*,' '
      print*,'*******************************************************'
      print*,'======================================================='
      print*,'                       LOCCASCF'
      print*,'======================================================='
      print*,'*******************************************************'
      print*,' '
      include 'pgm.prm0'
      include 'pgm.prm'
!
      open(93,file='LOCCASSCF93',status='unknown')
      call sto5_1(5,93,'BID93_LOCCASSCF')
      call LECNAM('&LOCCASSCF ',namel,93,ierr,1)
      if(ierr==1) stop 'No namelist LOCCASSCF found'
!
      call openf
      call titre('PROGRAMS IN USE#Directory   '//trim(pgm)//
     *'#Programmes : #'//trim(casdet)//'#'//
     *trim(casdi)//'#'//
     *trim(locnat)//'#'//
     *trim(molcost)//'#'//
     *trim(chol_X)//'#'//
     *trim(reordens)//'#'//
     *trim(ijkl)//'#'//
     *trim(rodyall)//'#'//
     *trim(costnevpt)//'#'
     *,40)

!
      call system('cp INPORB INPORB_sv_loccasscf')
      do iter=1,maxit
         write(ccc,'(i3)') iter
         if(ccc(1:1)==' ') ccc(1:1)='0'
         if(ccc(2:2)==' ') ccc(2:2)='0'
         call orb_transf
!         pqrs_already_splitted=.true.

!
! Read COST_MO as created in orb_transf
         if(iter==1) then
            open(99,file=trim(prefix)//'Info',status='old')
            call LECNAM('&COST_MO ',namel,99,ierr,1)
            call nameld(namel,ENUC,'ENUC',8)
            call nameli(namel,NORB,'NORB',4)
            allocate(itsym(norb))
            call nameli(namel,ITSYM,'ITSYM',4)
            close(99)
         endif
         if(stop=='TRANSF')stop

! store preceding density matrix
         if(iter>1) call mix_dens1

! compute density matrix
         call dens
         if(stop=='DENSITY')stop

! mix density matrix with preceding one
         if(iter>1) call mix_dens2

! compute Localised Natural Orbitals
         call conv
         if(.not.yconv) call locnats
         if(stop=='LOCNATS')stop

! copy new orbitals LOCORB2 to INPORB
         open(10,file='xx1',status='unknown')
         write(namel,'(a)') 'cp LOCORB2 INPORB'
         write(10,'(a)') namel(1:len_trim(namel))
         call system('cp LOCORB2 INPORB')

! rewind data file
         rewind 93
         if(yconv) then
            print*,'==== LOCCASSCF converged'
            if(r=='>') then
               do imat=1,nmat
                  call titre('OUTPUT CASDI'//num(imat)//'.OUT#',60)
                  call printout('CASDI'//num(imat)//'.OUT')
               enddo
               call titre('OUTPUT LOCNATS#',60)
               call printout('LOCNAT.OUT')
            endif
            call system('mv INPORB_sv_loccasscf INPORB')
            call system('cp LOCORB2 '//trim(prefix)//'LocCasOrb')
            call system('cp LOCORB2 '//trim(CurrDir)//'/'//
     *      trim(prefix)//'LocCasOrb')
            stop
         endif
      enddo
      print*,'No convergence in ',maxit,' iterations'
      if(r=='>') then
         do imat=1,nmat
            call titre('OUTPUT CASDI'//num(imat)//'.OUT#',60)
            call printout('CASDI'//num(imat)//'.OUT')
         enddo
         call titre('OUTPUT LOCNATS#',60)
         call printout('LOCNAT.OUT')
         endif
      call system('mv INPORB_sv_loccasscf INPORB')
      end
       subroutine printout(aa)
      character(*) aa
      character(135) a
      open(99,file=aa,status='old')
      do
         read(99,'(a)',end=1) a
         print'(a)',trim(a)
      enddo
 1    continue
      close(99)
      return
      end

