      subroutine orb_transf
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      if(transf=='CHOLESKY') then
         call orb_transf_cholesky
      else if(transf=='MOTRA') then
         call orb_transf_motra
      else
         print*,"TRANSF must be equal to 'CHOLESKY' or 'MOTRA'"
         stop
      endif
      return
      end
       subroutine orb_transf_cholesky
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(1000) aa
      character*80 ref_orb
      character(40) molcas_command
      yw=.false.
      if(ypiste) print*,'entree orb_transf_cholesky',iter
      open(1,file='IN_motra',status='unknown')
      if(iter==1) then
!
! motra data
!
         write(1,'(a)') ' &motra &end'
         write(1,'(a)') 'title'
         write(1,'(a)') prefix(1:len_trim(prefix))
         write(1,'(a)') 'lumorb'
         write(1,'(a)') 'frozen'
         write(1,'(8i5)')frozen(1:8)
         write(1,'(a)') 'delete'
         write(1,'(8i5)')delete(1:8)
         write(1,'(a)') 'CTONLY'
         write(1,'(a)') 'KPQ'
         write(1,'(a)') 'end of input'
         call display_data(1,'MOTRA')
         close(1)
!
! molcost data
!
         open(1,file='IN_molcost',status='unknown')
         write(1,'(3a)')
     *   ' &cost prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(a,8(i4,'',''))')' frozen=',frozen(1:nsym)
         write(1,'(a,8(i4,'',''))')' fermi=',fermi(1:nsym)
         molcas_command='molcas'
         call namela(namel,MOLCAS_COMMAND,'MOLCAS_COMMAND')
         call nameli(namel,MOLCAS,'MOLCAS',4)
         write(1,'(a,i2)')' molcas=',molcas
         if(density=='RODYALL') then
            !write(1,'(a,8(i4,'',''))')' inact=',inact(1:nsym)
            !write(1,'(a,8(i4,'',''))')' act=',act(1:nsym)
         endif
         write(1,'(a)') " ychol=t,chol_ord='KPQ'"
         write(1,'(a)')' /'
         call display_data(1,'MOLCOST')
         close(1)
!
! chol_X data
!
         open(1,file='IN_chol_X',status='unknown')
         write(1,'(3a)')
     *   ' &chol prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(a)')' semi_active=t'
         write(1,'(a)')" symm='"//trim(symm)//"'"
         write(1,'(a,8(i4,'',''))') ' inact=',inact(1:nsym)
         write(1,'(a,8(i4,'',''))')' act=',act(1:nsym)
         write(1,'(a,i4)')" nactel=",nactel
         write(1,'(a)')' /'
         call display_data(1,'CHOL_X')
         close(1)
      endif
!
! run motra
!
c     fabrication du script xx0
      open(10,file='xx0',status='unknown')
      aa=' '
      ref_orb=trim(prefix)//'ScfOrb'
      call neworb2(version,ref_orb,oldorb,neworb,r)
      if(version=='OLD') then
         write(aa,'(a)')
     *   'molcas run motra IN_motra  '//r//' motraout'//ccc//' 2>&1'
      else
         write(aa,'(a)')
     *   trim(molcas_command)//' IN_motra  '//r//
     *   ' motraout'//ccc//' 2>&1'
      endif
      write(10,'(a)') trim(aa)
      if(r.ne.'#')write(10,'(a)') 'cp motraout'//ccc//' MOTRA.OUT'
      !write(10,'(a)') 'cp INPORB_neworb_sv INPORB >BID 2>&1'
!
! run molcost      include 'pgm.prm0'
!      include 'pgm.prm'
!
      write(aa,'(a)') trim(molcost)//' < IN_molcost  '//r//
     *' molcostout'//ccc
      write(10,'(a)') aa(1:len_trim(aa))
      if(r.ne.'#')write(10,'(a)') 'cp molcostout'//ccc//' MOLCOST.OUT'
      if(yw)print*,'stop ',stop
      if(stop.eq.'MOLCOST') write(10,'(a)') 'exit'
!
! run chol_X
!
      write(aa,'(a)') trim(chol_X)//' < IN_chol_X  '//r//
     *' chol_Xout'//ccc
      write(10,'(a)') aa(1:len_trim(aa))
      if(r.ne.'#')write(10,'(a)') 'cp chol_Xout'//ccc//' CHOL_X.OUT'
      if(yw)print*,'stop ',stop
      if(stop.eq.'CHOL_X') write(10,'(a)') 'exit'
      close(10)
      call system('chmod +x xx0')
      call system('./xx0')
      if(ypiste) print*,'sortie orb_transf_cholesky'
      return



      end


       subroutine orb_transf_motra
      use module
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character(1000) aa
      character*80 ref_orb
      character(40) molcas_command
      yw=.false.
      if(ypiste) print*,'entree orb_transf_motra',iter
      open(1,file='IN_motra',status='unknown')
      if(iter==1) then
!
! motra data
!
         write(1,'(a)') ' &motra &end'
         write(1,'(a)') 'title'
         write(1,'(a)') prefix(1:len_trim(prefix))
         write(1,'(a)') 'lumorb'
         write(1,'(a)') 'frozen'
         write(1,'(8i5)')frozen(1:8)
         write(1,'(a)') 'delete'
         write(1,'(8i5)')delete(1:8)
         write(1,'(a)') 'end of input'
         call display_data(1,'MOTRA')
         close(1)
!
! molcost data
!
         open(1,file='IN_molcost',status='unknown')
         write(1,'(3a)')
     *   ' &cost prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(a,8(i4,'',''))')' frozen=',frozen(1:nsym)
         write(1,'(a,8(i4,'',''))')' fermi=',fermi(1:nsym)
         molcas_command='molcas'
         call namela(namel,MOLCAS_COMMAND,'MOLCAS_COMMAND')
         call nameli(namel,MOLCAS,'MOLCAS',4)
         write(1,'(a,i2)')' molcas=',molcas
         if(density=='RODYALL') then
            write(1,'(a,8(i4,'',''))')' inact=',inact(1:nsym)
            write(1,'(a,8(i4,'',''))')' act=',act(1:nsym)
         endif
         write(1,'(a)')' /'
         call display_data(1,'MOLCOST')
         close(1)
      endif
!
! run motra
!
c     fabrication du script xx0
      open(10,file='xx0',status='unknown')
      aa=' '
      ref_orb=trim(prefix)//'ScfOrb'
      call neworb2(version,ref_orb,oldorb,neworb,r)
      if(version=='OLD') then
         write(aa,'(a)')
     *   'molcas run motra IN_motra  '//r//' motraout'//ccc//' 2>&1'
      else
         write(aa,'(a)')
     *   trim(molcas_command)//' IN_motra  '//r//
     *   ' motraout'//ccc//' 2>&1'
      endif
      write(10,'(a)') trim(aa)
      if(r.ne.'#')write(10,'(a)') 'cp motraout'//ccc//' MOTRA.OUT'
      !write(10,'(a)') 'cp INPORB_neworb_sv INPORB >BID 2>&1'
!
! run molcost      include 'pgm.prm0'
!      include 'pgm.prm'
!
      write(aa,'(a)') trim(molcost)//' < IN_molcost  '//r//
     *' molcostout'//ccc
      write(10,'(a)') aa(1:len_trim(aa))
      if(r.ne.'#')write(10,'(a)') 'cp molcostout'//ccc//' MOLCOST.OUT'
      if(yw)print*,'stop ',stop
      if(stop.eq.'MOLCOST') write(10,'(a)') 'exit'
      close(10)
      call system('chmod +x xx0')
      call system('./xx0')
      if(ypiste) print*,'sortie orb_transf_motra'
      return
      end
       subroutine orb_transf_ijkl
      use module
      character(80) aa
      if(ypiste) print*,'entree orb_transf_ijkl '
!
! ijkl data
!
      open(1,file='IN_ijkl',status='unknown')
      write(1,'(3a)') ' &ijkl prefix=''',trim(prefix),''''
      write(1,'(a,l1)') ' semi_active=',semi_active
      write(1,'(a)') ' ydelf=f'
      if(iter==1) then
         write(1,'(a,l1)') ' pqrs_already_splitted=F'
      else
         write(1,'(a,l1)') ' pqrs_already_splitted=T'
      endif
      write(1,'(a,8(i4,'',''))')' fermi=',fermi(1:nsym)
      write(1,'(a,8(i4,'',''))')' frozen=',frozen(1:nsym)
      if(density=='RODYALL') then
         write(1,'(a)') ' orb_sort=''OAV'''
         write(1,'(a,i4)')' nactel=',nactel
         write(1,'(a,8(i4,'',''))')' inact=',inact(1:nsym)
         write(1,'(a,8(i4,'',''))')' act=',act(1:nsym)
      endif 
      write(1,'(a)')' /'
      if(iter==1) call display_data(1,'IJKL')
      close(1)
!
! run ijkl
!
      open(10,file='xx_ijkl',status='unknown')
      write(aa,'(a)') trim(ijkl)//' < IN_ijkl  '//r//' ijklout'//ccc
      write(10,'(a)') trim(aa)
      if(r.ne.'#')write(10,'(a)') 'cp ijklout'//ccc//' IJKL.OUT'
      close(10)
      call system('chmod +x xx_ijkl')
      call system('./xx_ijkl')
      if(ypiste) print*,'sortie orb_transf_ijkl '
      return
      end
       subroutine neworb2(version,ref_orb,oldorb,neworb,r)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character*3 version
      character r
      character*80 ref_orb
      character*80 oldorb,neworb
      nprint=0
C      if(ypiste) print*,'entree neworb2'
      if(version.ne.'NEW') return
      if(nprint>0)
     *print*,'les orbitales sont reecrites en nouveau format'
c on met a l'abri INPORB
C      write(10,'(a)') 'cp INPORB INPORB_neworb_sv'
C      write(10,'(a)') 'cp '//trim(ref_orb)//' INPORB'
c on fait tourner oldorb pour creer INSERORB
c     write(10,'(a)') 'oldorb'
C      write(10,'(a)') trim(oldorb)//' '//r//' molcostout001'
c on recupere INPORB
C      write(10,'(a)') 'cp INPORB_neworb_sv INPORB'
c on fait tourner NEWORB
c     write(10,'(a)') 'neworb'
      write(10,'(a)') trim(neworb)//' '//r//' molcostout001'
      write(10,'(a)') 'mv OUTORB INPORB'
C      if(ypiste) print*,'sortie neworb2'
      return
      end
       subroutine display_data(ifil,prog)
      character(*) prog
      character(80) aa
      print*,' '
      print*,'==================Data for '//trim(prog)//' ============='
      rewind ifil
      do
         read(ifil,'(a)',end=1) aa
         print'(a)', trim(aa)
      enddo
 1    continue
      print*,'========================================================='
      return
      end
