      program NOSCF
      use mod_lirorb
!     
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     Optimisation d'orbitales locales
!     programme pilotant les appels a
!     - motra - molcostopenmolcas
!     - casdet - casdi
!     - locnats
!     ... et iterations
!     
!     en entree:
!     liste de donnees (voir plus bas)
!     un fichier d'orbitales de nom "INPORB"
!     
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter (maxsym=8,maxorbcas=16,maxet=100,maxrac=50)
      dimension numac(maxorbcas),numacv(maxorbcas),numac0(maxorbcas)
      integer fermi(maxsym),frozen(maxsym),delete(maxsym)
      integer fermimotra(maxsym),frozenmotra(maxsym),deletemotra(maxsym)
      integer fermi_dolo(maxsym),ideb,ifin
      dimension netat(maxet),metat(maxet),coef(maxet),isym(maxsym)
      dimension e(maxet),ev(maxrac,maxet)
      dimension nocs(0:maxsym),nvirs(0:maxsym)
      dimension nacos(0:maxsym),nacvs(0:maxsym)
      character*1 syspin
      character*8 gener,stop
      character*80 prefix,ref_orb
      character*3 version
      character*80 pgm,casdet,casdi,fil(maxet),locnat,filcas(maxet)
     *,molcost,molcostopenmolcas,reordens,oldorb1,neworb1,chol_X
      character*1280 namel
      character*3 num(999)
      character*1 d
      character*3 r
      character*4 data
      character*2 ald
      character(18),allocatable,dimension(:) :: tipo
      logical exist_labels,ychol
      r='  >'
      d=' '
      data=' '
      print*,' '
      print*,'*******************************************************'
      print*,'======================================================='
      print*,'                       NOSCF'
      print*,'======================================================='
      print*,'*******************************************************'
      print*,' '
      yw=.false.
      include 'pgm.prm0'
      include 'pgm.prm'
c      pgm='/work0/daniel/pgm/'
c      casdet=pgm(1:len_trim(pgm))//'casdet00'
c      casdi=pgm(1:len_trim(pgm))//'casdi01'
c      locnat=pgm(1:len_trim(pgm))//'locnats'
c      print*,'casdet ',casdet
      maxit=50
c
c-----------------------------------------------------
c     lecture des donnees
c-----------------------------------------------------
c
      call sto5_1(5,93,'BID93_noscf')
      call LECNAM('&NOFIL ',namel,93,ierr,1)
      if(ierr.eq.1) then
         print*,'namelist NOFIL non trouvee'
         stop
      endif

      call namela(namel,PREFIX,'PREFIX')
      call LECNAM('&NO ',namel,93,ierr,1)
      if(ierr.eq.1) then
         print*,'namelist NO non trouvee'
         stop
      endif
      gener='CAS+S'
      nmat=1
      fermi=0
      fermimotra=0
      frozen=-1
      frozenmotra=-1
      delete=-1
      deletemotra=-1
      seuil=1.d-4
      ypertu=.false.
      ychol=.false.
      sli1=0.d0
      sli2=0.d0
      molcas=0
      nb_rem=2
      it_rem=4
      isuiv=0
      stop=' '
      version='NEW'
      ref_orb=' '
      call namela(namel,DATA,'DATA')
c     si data='AUTO', fermi,frozen,delete et noac sont mis a -1
      if(data.eq.'AUTO') then
         fermi=-1
         frozen=-1
         delete=-1
         noac=-1
      endif

      Call namela(namel,REF_ORB,'REF_ORB')
      call namela(namel,VERSION,'VERSION')
      call maj(version,3)
      call namell(namel,YPERTU,'YPERTU',1)
      call namell(namel,YCHOL,'YCHOL',4)
      call nameld(namel,sli1,'SLI1',8)
      call nameld(namel,sli2,'SLI2',8)
      call nameli(namel,MAXIT,'MAXIT',4)
      call nameli(namel,molcas,'MOLCAS',4)
      call nameli(namel,FERMI,'FERMI',4)
      yfermi_donne=any(fermi/=-1)
      call nameli(namel,FROZEN,'FROZEN',4)
      call nameli(namel,DELETE,'DELETE',4)
      call nameli(namel,NMAT,'NMAT',4)
      netat(1:nmat)=1
      call nameli(namel,NETAT,'NETAT',4)
      netatot=sum(netat(1:nmat))
      metat(1:netatot)=1
      call nameli(namel,METAT,'METAT',4)
      coef(1:netatot)=1.d0
      call nameld(namel,coef,'COEF',8)
      call nameld(namel,SEUIL,'SEUIL',8)
!      open(4,status='old',form='unformatted',file='S2')
!      read(4) nsym,isym(1:nsym),progr
      call namela(namel,R,'R')
      call namela(namel,STOP,'STOP')
      call namela(namel,CASDI,'CASDI')
      call nameli(namel,NB_REM,'NB_REM',4)
      call nameli(namel,IT_REM,'IT_REM',4)
      call nameli(namel,ISUIV,'ISUIV',4)
      if(ref_orb==' ') ref_orb=trim(prefix)//'ScfOrb'
      call titre('PROGRAMMES UTILISES#Directory   '//trim(pgm)//
     *'#Programmes : #'//trim(casdet)//'#'//trim(casdi)//
     *'#'//trim(locnat)//'#'//trim(molcostopenmolcas)//'#'//
     *trim(reordens)//'#',40)
c
c-----------------------------------------------------
c     fabrication des donnees
c-----------------------------------------------------
c
      if(nmat.ge.100) then
         print*,'nmat trop grand', nmat
      endif
      do k=1,max(nmat,maxit)
         write(num(k),'(''00'',i1)') k
      enddo
      do k=10,max(nmat,maxit)
         write(num(k),'(''0'',i2)') k
      enddo
      do k=100,max(nmat,maxit)
         write(num(k),'(i3)') k
      enddo
c     si fermi est donne a -1, on prend les valeurs definies dans 
c     schmudorb
      if(any(fermi==-1)) then
         open(51,file='SCH_FERMI',status='old',form='formatted')
         call lecnam('&FERM',namel,51,ierr,1)
         call nameli(namel,FERMI_dolo,'FERMI',4)
         close(51)
         do k=1,maxsym
            if(fermi(k)==-1) fermi(k)=fermi_dolo(k)
         enddo
      endif
c     si frozen-1 ou delete=-1 ces donnees sont a chercher dans INPORB
c      open(51,file='INPORB',status='old',form='formatted')
      call lirorb('INPORB',norb,nsym,isym,51,54,
     *exist_labels=exist_labels)
      do is=1,nsym
         if(isym(is)==0) cycle
         read(51)
      enddo
      do is=1,nsym
         if(isym(is)==0) cycle
         read(51)
      enddo
      yfr=frozen(1)==-1
      ydel=delete(1)==-1
      if(yfr)  frozen=0
      if(ydel)  delete=0
      !print*,'frozen',frozen(1),frozen(1)==-1
      !print*,'delete',delete(1)
      !print*,yfr,ydel
      if(ydel.or.yfr) then
         if(.not.exist_labels) then
            print*,'les labels no sont pas donnes dans INPORB'
            print*,'dans ce cas,  frozen et delete doivent etre donnes'
     *      //' dans &no'
            print*,'*************************************************'
            print*,' '
            stop
         endif  
         do is=1,nsym
            !print*,'is,isym(is)',is,isym(is)
            if(isym(is)==0) cycle
            allocate(tipo(isym(is)))
            read(51) tipo
c           si frozen est donne a -1, on prend les valeurs definies dans 
c           schmudorb. On modifie alors fermi
            if(yfr) then
               frozen(is)=0
               do k=1,fermi(is)
                  if(tipo(k)(1:2)=='G_') frozen(is)=frozen(is)+1
               enddo
            endif
c           si delete est donne a -1, on prend les valeurs definies dans 
c           schmudorb
            if(ydel) then
               delete(is)=0
               do k=1+fermi(is),isym(is)
                  if(tipo(k)(1:2)=='G_') delete(is)=delete(is)+1
               enddo
            endif
            deallocate(tipo)
         enddo
      endif
      fermimotra(1:nsym)=fermi(1:nsym)
c Le gel/delete ne fonctionne pas dans motra. On les met à zéro
      frozenmotra(1:nsym)=0
      deletemotra(1:nsym)=0
      fermi(1:nsym)=fermi(1:nsym)-frozen(1:nsym)
      print'(a,8i4)','Frozen orbitals ',frozen(1:nsym)
      print'(a,8i4)','Deleted orbitals',delete(1:nsym)
      print'(a,8i4)','Fermi level     ',fermi(1:nsym)
      !if(yfr) fermi(1:nsym)=fermi(1:nsym)-frozen(1:nsym)
c-------
c     fabrication du premier fichier de donnees IN0
c     Ce sont les donnees communes pour toutes les matrices densite
      open(1,file='MOTRAIN0',status='unknown')
c     donnees motra
      write(1,'(a)') ' &motra &end'
      write(1,'(a)') 'title'
      write(1,'(a)') prefix(1:len_trim(prefix))
      write(1,'(a)') 'lumorb'
      if (ychol) then
         write(1,'(a)') 'CTONLY'
         write(1,'(a)') 'KPQ'
         write(1,'(a)') 'frozen'
         write(1,'(8i5)')frozenmotra(1:nsym)
         write(1,'(a)') 'delete'
         write(1,'(8i5)')deletemotra(1:nsym)
      else
         write(1,'(a)') 'frozen'
         write(1,'(8i5)')frozen(1:nsym)
         write(1,'(a)') 'delete'
         write(1,'(8i5)')delete(1:nsym)
      endif
      write(1,'(a)') 'end of input'
      close(1)
c     donnees molcostopenmolcas
      open(1,file='IN0',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)
      write(1,'(a,i2)')' molcas=',molcas
      if (ychol) then
         write(1,'(a)') ' ychol=t,'
      endif
      write(1,'(a)')' /'
c     donnees chol_X
      if (ychol) then
         write(1,'(a,d12.4,a,d12.4)') ' &chol sli1=',sli1,',sli2=',sli2
         write(1,'(a)')' /'
      endif
c     donnees locnat
      write(1,'(3a)')' &locn prefix=''',prefix(1:len_trim(prefix)),''''
      write(1,'(a,8(i4,'',''))')' ngel=',frozen(1:nsym)
      write(1,'(a,8(i4,'',''))')' ndel=',delete(1:nsym)
      if(yfermi_donne)
     *write(1,'(a,8(i4,'',''))')' fermi=',fermi(1:nsym)
      write(1,'(a,i3)')' nmat=',nmat
      write(1,'(a,f20.15)')' seuil=',seuil
c      write(1,*)' seuil=',seuil
      if(yw)print*,'seuil',seuil
      write(1,'(a)')' densmat='
      do k=1,min(9,nmat)
         write(1,'(a)')' ''DENS'//num(k)//''''
      enddo
      do k=10,min(99,nmat)
         write(1,'(a)')' ''DENS'//num(k)//''''
      enddo
      write(1,'(a,8(i3,'',''))')' netat=',netat(1:nmat)
      write(1,'(a,8(i3,'',''))')' metat=',metat(1:netatot)
      write(1,'(a,8(f4.2,'',''))')' coef=',coef(1:netatot)
      write(1,'(a)')' orbv=''INPORB'',orbn=''LOCORB2'''
      call aldon('LOCN',1)
      write(1,'(a)')' /'
      close(1)
      
c
      ifin=0
      syspin='0'
      iprec=6
      nessai2=2
      nessai=0
      nvec=1
      noac=0
      if(data.eq.'AUTO') noac=-1
      nelac=0
      numac=0
      ms2=0
      is0=1
c     Generation des fichiers de donnees pour les calculs multiples
c     les fichiers s'appellent INi i=1,2,...,nmat
      do imat=1,nmat
         if(imat.le.9) then
            write(ald(1:1),'(i1)') imat
            lald=1
         else
            write(ald,'(i2)') imat
            lald=2
         endif
         ideb=ifin+1
         ifin=ideb+netat(imat)-1
!        print *,'ifin=ideb+netat(imat)-1=',ifin,'imat=',imat,
!    *'netat(imat)=',netat(imat) 
         do ibid=1,imat-1
            call LECNAM('&CASDI ',namel,93,ierr,0)
         enddo
         call LECNAM('&CASDI ',namel,93,ierr,1)
         if(ierr.eq.1) then
            print*,'namelist CASDI non trouvee'
            stop
         endif
         call namela(namel,GENER,'GENER')
         call nameli(namel,NOAC,'NOAC',4)
         call nameli(namel,NUMAC,'NUMAC',4)
         call nameli(namel,NELAC,'NELAC',4)
         call nameli(namel,MS2,'MS2',4)
         call nameli(namel,IS0,'IS0',4)
         call namela(namel,SYSPIN,'SYSPIN')
         call nameli(namel,IPREC,'IPREC',4)
         call nameli(namel,NESSAI2,'NESSAI2',4)
         call nameli(namel,NESSAI,'NESSAI',4)
c
c        si noac=-1, on genere noac, numac, nelac a partir de INPORB
c

         if(noac.eq.-1) then
            do is=1,nsym
               if(isym(is)==0) cycle
               backspace(51)
            enddo
            kk=0
            noac=0
            do is=1,nsym
               if(isym(is)==0) cycle
               allocate(tipo(isym(is)))
               read(51) tipo
               do k=frozen(is)+1,frozen(is)+fermi(is)
                  kk=kk+1
                  if(tipo(k)(1:2)=='A_') then
                     noac=noac+1
                     numac(noac)=kk
                  endif
               enddo
               deallocate(tipo)
            enddo
            do is=1,nsym
               if(isym(is)==0) cycle
               backspace(51)
            enddo
            do is=1,nsym
               if(isym(is)==0) cycle
               allocate(tipo(isym(is)))
               read(51) tipo
               do k=frozen(is)+fermi(is)+1,isym(is)-delete(is)
                  kk=kk+1
                  if(tipo(k)(1:2)=='A_') then
                     noac=noac+1
                     numac(noac)=kk
                  endif
               enddo
               deallocate(tipo)
            enddo
            close(51,status='delete')
c            print*,'noacv',noacv
c            print*,'numacv',numacv(1:noacv)
            nocs(0)=0
            nvirs(0)=0
            nocs(1:nsym)=frozen(1:nsym)+fermi(1:nsym)
            nvirs(1:nsym)=isym(1:nsym)-nocs(1:nsym)
c            print*,'nocs',nocs(1:nsym)
c            print*,'nvirs',nvirs(1:nsym)
            do k=2,nsym
               nocs(k)=nocs(k)+nocs(k-1)
               nvirs(k)=nvirs(k)+nvirs(k-1)
            enddo
            noc=nocs(nsym)
            nvir=nvirs(nsym)
            norb=noc+nvir
            if(yw)print*,'nocs',nocs(1:nsym)
            if(yw)print*,'nvirs',nvirs(1:nsym)
            if(yw)print*,'fermi',fermi(1:nsym)
            if(yw)print*,'frozen',frozen(1:nsym)
            if(yw)print*,'delete',delete(1:nsym)
            if(yw)print*,'fermi',fermi(1:nsym)
         endif
         !print*,'numac',numac(1:noac)
! NADIA
!        yw=.true.
         if(yw) then
            print'(3a)',' &cdfil prefix=''',
     *      prefix(1:len_trim(prefix)),''''
            print'(a)',' /'
            print'(a,a,a)',' &cd gener=''',gener(1:len_trim(gener)),''''
            print'(a,i2)',' noac=',noac
            print'(a,i2)',' nelac=',nelac
            if(noac.ne.0) print1000,' numac=',(numac(k),',',k=1,noac)
            print'(a)',' /'
            print'(3a)',
     *      ' &cdifil prefix=''',prefix(1:len_trim(prefix)),''''
            print'(a)',' /'
            print'(a,a,a)',' &dav ydens=T,syspin=''',syspin,''''
            if (ychol) write(6,'(a)') ' itest(63)=1'
            print'(a,i1)',' nessai=',nessai
            print'(a,i3)',' iprec=',iprec
            print'(a,i3)',' nvec=',maxval(metat(ideb:ifin))
!           print'(a,i1)',' ideb=',ideb
!           print'(a,i2)',' ifin=',ifin
!           print1000,' metat=',metat(ideb:ifin)
            print'(a)',' /'
         endif
!     yw=.false.
! FIN NADIA
         fil(imat)=' '
         filcas(imat)=' '
         fil(imat)(1:2)='IN'
         filcas(imat)(1:2)='CA'
         if(imat.lt.10) then
            write(fil(imat)(3:3),'(i1)') imat
            write(filcas(imat)(3:3),'(i1)') imat
            open(1,file=fil(imat),status='unknown')
            if(ypertu) open(2,file=filcas(imat),status='unknown')
c            print*,'file1',fil(imat)
         else
            write(fil(imat)(3:4),'(i2)') imat
            write(filcas(imat)(3:4),'(i2)') imat
            open(1,file=fil(imat),status='unknown')
            if(ypertu) open(2,file=filcas(imat),status='unknown')
         endif
c        fichiers de donnees pour le 1er calcul
c        donnees pour casdet
         if(ypertu) then
            write(2,'(3a)')
     *      ' &cdfil prefix=''',prefix(1:len_trim(prefix)),''''
            write(2,'(2a)')' det1=''DETC'//num(imat),''''
            write(2,'(a)')' /'
            write(2,'(a)') ' &cd gener=''CAS'''
            write(2,'(a,i2)')' noac=',noac
            write(2,'(a,i2)')' nelac=',nelac
            write(2,'(a,i2)')' ms2=',ms2
            write(2,'(a,i2)')' is0=',is0
            if(noac.ne.0) write(2,'(a,16(i3,a))') 
     *      'numac=',(numac(k),',',k=1,noac)
 1000       format(a,16(i3,a))
            write(2,'(a)')' /'
c           donnees pour casdi
            write(2,'(3a)')
     *      ' &cdifil prefix=''',prefix(1:len_trim(prefix)),''''
            write(2,'(2a)') ' det1=''DETC'//num(imat),''''
            write(2,'(2a)') ' davec1=''DAVECC'//num(imat),''''
c            write(2,'(2a)') ' dens1=''DENS'//num(imat),''''
            write(2,'(a)') ' /'
            write(2,'(a,a,a)') ' &dav ydens=T,syspin=''',syspin,''''
            if (ychol) write(2,'(a)') ' itest(63)=1'
            write(2,'(a,i1)') ' nessai=',nessai
            write(2,'(a,i3)') ' iprec=',iprec
            write(2,'(a,i3)') ' nvec=',maxval(metat(ideb:ifin))
            call aldon('DAV'//ald(1:lald),2)
            write(2,'(a)') ' /'
            close(2)
         endif
         write(1,'(3a)')
     *   ' &cdfil prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(2a)')' det1=''DET'//num(imat),''''
         call aldon('CDFIL'//ald(1:lald),1)
         write(1,'(a)')' /'
         write(1,'(a,a,a)')' &cd gener=''',gener(1:len_trim(gener)),''''
         write(1,'(a,i2)')' noac=',noac
         noac0=noac
         write(1,'(a,i2)')' nelac=',nelac
         write(1,'(a,i2)')' is0=',is0
         write(1,'(a,i2)')' ms2=',ms2
         if(noac.ne.0) write(1,'(a,16(i3,a))')
     *   ' numac=',(numac(k),',',k=1,noac)
         numac0(1:noac)=numac(1:noac)
         call aldon('CD'//ald(1:lald),1)
         write(1,'(a)')' /'
c        donnees pour casdi
         write(1,'(3a)')
     *   ' &cdifil prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(2a)')' det1=''DET'//num(imat),''''
         write(1,'(2a)')' davec1=''DAVEC'//num(imat),''''
         write(1,'(2a)')' dens1=''DENS'//num(imat),''''
         call aldon('CDIFIL'//ald(1:lald),1)
         write(1,'(a)')' /'
         write(1,'(a,a,a)')' &dav ydens=T,syspin=''',syspin,''''
         if (ychol) write(1,'(a)') ' itest(63)=1'
         write(1,'(a,i1)')' nessai=',nessai
         write(1,'(a,i3)')' iprec=',iprec
         write(1,'(a,i3)')' nvec=',maxval(metat(ideb:ifin))
         if(ypertu) write(1,'(a)')' ypertu=T,nessai=1'
         call aldon('DAV'//ald(1:lald),1)
         write(1,'(a)') ' /'
         if(ypertu) write(1,'(a)') ' &ess file=''ESSOUT''  /'
         close(1)
      enddo
c
c---------------------------
c     calculs faits une fois
c---------------------------
c
c     fabrication du script xx0
      open(10,file='xx0',status='unknown')
      namel=' '
c      write(namel,'(a)') 'cp LOCORB LOCORB2'
c      write(10,'(a)') namel(1:len_trim(namel))
c      write(namel,'(a)') 'cp LOCORB2 INPORB'
c      write(10,'(a)') namel(1:len_trim(namel))
      call neworb12(version,ref_orb,oldorb1,neworb1,r)
      if(version=='OLD') then
         write(namel,'(a)')
     *   'molcas run motra MOTRAIN0  '//r//' motraout001 2>&1'
      else
         write(namel,'(a)')
     *   'pymolcas MOTRAIN0  '//r//' motraout001 2>&1'
      endif
      write(10,'(a)') namel(1:len_trim(namel))
      if(r.ne.' # ')write(10,'(a)') 'cp motraout001 MOTRA.OUT'
c      write(10,'(a)') 'exit'
      write(10,'(a)') 'cp INPORB_neworb1_sv INPORB'
      write(namel,'(a)') trim(molcostopenmolcas)//' < IN0  '//r//'
     *molcostout001'
      write(10,'(a)') namel(1:len_trim(namel))
      if(r.ne.' # ')write(10,'(a)') 'cp molcostout001 MOLCOST.OUT'
      if(yw)print*,'stop ',stop
      if(stop.eq.'MOLCOST') write(10,'(a)') 'exit'
      if (ychol) then
         namel=' '
         write(namel,'(a)') trim(chol_X)//' < IN0  '//r//' cholXout'
         write(10,'(a)') namel(1:len_trim(namel))
         if(r.ne.' # ')write(10,'(a)') 'cp cholXout CHOLX.OUT'
      endif

c      print*,'nmat2',nmat
      do imat=1,nmat
c         print*,'file2',fil(imat)
!         if(ypertu) then
!            namel=' '
!            write(namel,'(4a)') casdet(1:len_trim(casdet)),' < '
!     *      ,filcas(imat)(1:len_trim(filcas(imat)))
!     *      ,'  '//r//' casdetout'//num(imat)
!            write(10,'(a)') namel(1:len_trim(namel))
!            if(r.ne.' # ')write(10,'(a)') 'cp casdetout'//num(imat)//
!     *      ' CASDET'//num(imat)//'.OUT'
!            namel=' '
!            write(namel,'(4a)') casdi(1:len_trim(casdi)),' < '
!     *      ,filcas(imat)(1:len_trim(filcas(imat)))
!     *      ,'  '//r//' casdiout001_'
!     *      //num(imat)
!            write(10,'(a)') namel(1:len_trim(namel))
!            if(r.ne.' # ')
!     *      write(10,'(a)') 'cp casdiout001_'//num(imat)//
!     *      ' CASDI'//num(imat)//'.OUT
!     &      '
!         endif
         namel=' '
         write(namel,'(4a)') casdet(1:len_trim(casdet)),' < '
     *   ,fil(imat)(1:len_trim(fil(imat)))
     *   ,'  '//r//' casdetout'//num(imat)
         write(10,'(a)') namel(1:len_trim(namel))
         if(r.ne.' # ')write(10,'(a)') 'cp casdetout'//num(imat)//
     *   ' CASDET'//num(imat)//'.OUT'
         namel=' '
         write(namel,'(4a)') casdi(1:len_trim(casdi)),' < '
     *   ,fil(imat)(1:len_trim(fil(imat))),'  '//r//' casdiout001_'
     *   //num(imat)
         write(10,'(a)') namel(1:len_trim(namel))
c         write(10,'(a)') 'exit'
         if(r.ne.' # ')write(10,'(a)') 'cp casdiout001_'//num(imat)//
     *   ' CASDI'//num(imat)//'.OUT'
         write(10,'(a)')'mv DAVEC'//num(imat)//' ESS'//num(imat)
         if(ypertu)
     *   write(10,'(a)')'mv DAVECC'//num(imat)//' ESSC'//num(imat)
      enddo
      write(namel,'(2a)') locnat(1:len_trim(locnat)),
     *' < IN0  '//r//' locnatout001'
      write(10,'(a)') namel(1:len_trim(namel))
      if(r.ne.' # ')write(10,'(a)') 'cp locnatout001 LOCNAT.OUT'
      close(10)
      call system('chmod +x xx0')
      call system('./xx0')
      do imat=1,nmat
         open(12,file='ESS'//num(imat),form='unformatted',status='old')
         read(12) ndet,nrac
         read(12) e(1:nrac),enuc,eref
         ev(1:nrac,imat)=e(1:nrac)+enuc+eref
         do k=1,nrac
           print'(a,i3,a,i3,a,4f14.8)',
     *    'Iter',1,'   imat',imat,'   E=',e(k)+enuc+eref
           call flush(6)
         enddo
         open(10,file='xxx',status='unknown')
         write(10,'(a)') 'grep "| " casdiout001_'//trim(num(imat))
     *   //' | grep "=>"'
  
         close(10)
         call system('chmod +x xxx')
         call system('./xxx')
         close(12)
      enddo
      open(22,status='old',file='LOCNAT_CONV')
      read(22,*) aaa
      print'(a,d10.3)','  Convergence ',aaa
      call flush(6)
      close(22)
      print*,'-----------------------------'
c
c---------------------------
c     boucle
c---------------------------
c
c     nouvelles donnees de casdet/casdi
c      print*,'nouvelles donnees'
      nessai=nessai2
      rewind 93
      ifin=0
      syspin='0'
      iprec=6
      nvec=1
      noac=0
      if(data.eq.'AUTO') noac=-1
      nelac=0
      numac=0
      ms2=0
      is0=1
      do imat=1,nmat
         if(imat.le.9) then
            write(ald(1:1),'(i1)') imat
            lald=1
         else
            write(ald,'(i2)') imat
            lald=2
         endif
         ideb=ifin+1
         ifin=ideb+netat(imat)-1
         rewind 93
         do ibid=1,imat-1
            call LECNAM('&CASDI ',namel,93,ierr,0)
         enddo
         call LECNAM('&CASDI ',namel,93,ierr,0)
         if(ierr.eq.1) then
            print*,'Namelist CASDI non trouvee'
            stop
         endif
         call namela(namel,GENER,'GENER')
         call nameli(namel,NOAC,'NOAC',4)
         call nameli(namel,NUMAC,'NUMAC',4)
         call nameli(namel,NELAC,'NELAC',4)
         call nameli(namel,MS2,'MS2',4)
         call nameli(namel,IS0,'IS0',4)
         call namela(namel,SYSPIN,'SYSPIN')
         call nameli(namel,IPREC,'IPREC',4)
         if(noac.eq.-1) then
            noac=noac0
            numac(1:noac)=numac0(1:noac)
         endif
         fil(imat)=' '
         filcas(imat)=' '
         fil(imat)(1:2)='IN'
         filcas(imat)(1:2)='CA'
         if(imat.lt.10) then
            write(fil(imat)(3:3),'(i1)') imat
            write(filcas(imat)(3:3),'(i1)') imat
            open(1,file=fil(imat),status='unknown')
            if(ypertu) open(2,file=filcas(imat),status='unknown')
c            print*,'file1',fil(imat)
         else
            write(fil(imat)(3:4),'(i2)') imat
            open(1,file=fil(imat),status='unknown')
            if(ypertu) open(2,file=filcas(imat),status='unknown')
         endif
!         if(ypertu) then
!            write(2,'(3a)')
!     *      ' &cdfil prefix=''',prefix(1:len_trim(prefix)),''''
!            write(2,'(2a)')' det1=''DETC'//num(imat),''''
!            write(2,'(a)')' /'
!            write(2,'(a)') ' &cd gener=''CAS'''
!            write(2,'(a,i2)')' noac=',noac
!            write(2,'(a,i2)')' nelac=',nelac
!            write(2,'(a,i2)')' is0=',is0
!            write(2,'(a,i2)')' ms2=',ms2
!            if(noac.ne.0) write(2,'(a,16(i3,a))')
!     *      ' numac=',(numac(k),',',k=1,noac)
!            write(2,'(a)')' /'
!            donnees pour casdi
!            write(2,'(3a)')
!     *      ' &cdifil prefix=''',prefix(1:len_trim(prefix)),''''
!            write(2,'(2a)') ' det1=''DETC'//num(imat),''''
!            write(2,'(2a)') ' davec1=''DAVECC'//num(imat),''''
!             write(2,'(2a)') ' dens1=''DENS'//num(imat),''''
!            write(2,'(2a)')' ess1=''ESSC'//num(imat),''''
!            write(2,'(a)') ' /'
!            write(2,'(a,a,a)') ' &dav ydens=T,syspin=''',syspin,''''
!            write(2,'(a,i1)') ' nessai=',nessai
!            write(2,'(a,i3)') ' iprec=',iprec
!            write(2,'(a,i1)') ' nvec=',maxval(metat(ideb:ifin))
!            call aldon('DAV'//ald(1:lald),2)
!            write(2,'(a)') ' /'
!            close(2)
!         endif
c        donnees pour casdet
         write(1,'(3a)')
     *   ' &cdfil prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(2a)')' det1=''DET'//num(imat),''''
         call aldon('CDFIL'//ald(1:lald),1)
         write(1,'(a)')' /'
         write(1,'(a,a,a)')' &cd gener=''',gener(1:len_trim(gener)),''''
         write(1,'(a,i2)')' noac=',noac
         write(1,'(a,i2)')' nelac=',nelac
         write(1,'(a,i2)')' is0=',is0
         write(1,'(a,i2)')' ms2=',ms2
         if(noac.ne.0) write(1,'(a,16(i3,a))')
     *   ' numac=',(numac(k),',',k=1,noac)
         call aldon('CD'//ald(1:lald),1)
         write(1,'(a)')' /'
c        donnees pour casdi
         write(1,'(3a)')
     *   ' &cdifil prefix=''',prefix(1:len_trim(prefix)),''''
         write(1,'(2a)')' det1=''DET'//num(imat),''''
         write(1,'(2a)')' davec1=''DAVEC'//num(imat),''''
         write(1,'(2a)')' dens1=''DENS'//num(imat),''''
         write(1,'(2a)')' ess1=''ESS'//num(imat),''''
         call aldon('CDIFIL'//ald(1:lald),1)
         write(1,'(a)')' /'
         write(1,'(a,a,a)')' &dav ydens=T,syspin=''',syspin,''''
         if (ychol) write(1,'(a)') ' itest(63)=1'
         write(1,'(a,i1)')' nessai=',nessai
         write(1,'(a,i3)')' iprec=',iprec
         write(1,'(a,i3)')' nvec=',maxval(metat(ideb:ifin))
         if(ypertu) write(1,'(a)')' ypertu=T,nessai=1'
         call aldon('DAV'//ald(1:lald),1)
         write(1,'(a)')' /'
         if(ypertu) write(1,'(a)') ' &ess file=''ESSOUT''  /'
c        donnees pour reordens
         if(isuiv==1) then
            write(1,'(a)')" &reordens dens0='DENS"//num(imat)//"'"
            write(1,'(a)')" davec1='DAVEC"//num(imat)//"'"//
     *      ",davec0='ESS"//num(imat)//"',"
            write(1,'(a)')" dens1='DENSTMP',"
            write(1,'(a)')" prefix='"//trim(prefix)//"'  /"
         endif
         close(1)
      enddo
      call system ('rm CONV '//r//' bid 2>&1')
      nrem=0
      do iter=2,maxit
         !print*,'iteration',iter
         open(10,file='xx1',status='unknown')
         write(namel,'(a)') 'cp LOCORB2 INPORB'
         write(10,'(a)') namel(1:len_trim(namel))
         call neworb12(version,ref_orb,oldorb1,neworb1,r)
         if(version=='OLD') then
            write(namel,'(3a)')
     *      'molcas run motra MOTRAIN0  '//r//' motraout'
     *      ,num(iter),' 2>&1'
         else
            write(namel,'(3a)')
     *      'pymolcas MOTRAIN0  '//r//' motraout',num(iter),' 2>&1'
         endif
         write(10,'(a)') namel(1:len_trim(namel))
         if(r.ne.' # ')write(10,'(a)') 
     *    'cp motraout'//num(iter)//' MOTRA.OUT'
         write(10,'(a)') 'cp INPORB_neworb1_sv INPORB'
         write(namel,'(a)')
     *trim(molcostopenmolcas)//' < IN0  '//r//' molcostout'//num(iter)
         write(10,'(a)') namel(1:len_trim(namel))
         if(r.ne.' # ')
     *   write(10,'(a)') 'cp molcostout'//num(iter)//' MOLCOST.OUT'
         if (ychol) then
            namel=' '
            write(namel,'(a)') 
     *      trim(chol_X)//' < IN0  '//r//' cholXout'//num(iter)
            write(10,'(a)') namel(1:len_trim(namel))
            if(r.ne.' # ')
     *      write(10,'(a)') 'cp cholXout'//num(iter)//' CHOLX.OUT'
         endif
         do imat=1,nmat
!            if(ypertu) then
!               namel=' '
!               write(namel,'(4a)') casdet(1:len_trim(casdet)),' < '
!     *         ,filcas(imat)(1:len_trim(filcas(imat)))
!     *         ,'  '//r//' casdetoutc'//num(imat)
!               write(10,'(a)') namel(1:len_trim(namel))
!               if(r.ne.' # ')write(10,'(a)') 
!     *         'cp casdetoutc'//num(imat)//
!     *         ' CASDET'//num(imat)//'.OUT'
!               namel=' '
!               write(namel,'(4a)') casdi(1:len_trim(casdi)),' < '
!     *         ,filcas(imat)(1:len_trim(filcas(imat)))
!     *         ,'  '//r//' casdioutc'//num(iter)
!     *         //num(imat)
!               write(10,'(a)') namel(1:len_trim(namel))
!               if(r.ne.' # ')write(10,'(a)') 
!     *         'cp casdioutc'//num(imat)//
!     *         ' CASDI'//num(imat)//'.OUT'
!            endif
            namel=' '
            write(namel,'(4a)') casdet(1:len_trim(casdet)),' < '
     *      ,fil(imat)(1:len_trim(fil(imat))),'  '//r//' casdetout'
     *      //num(imat)
            write(10,'(a)') namel(1:len_trim(namel))
            if(r.ne.' # ')write(10,'(a)') 'cp casdetout'//num(imat)//
     *      ' CASDET'//num(imat)//'.OUT'
            namel=' '
            write(namel,'(4a)') casdi(1:len_trim(casdi)),' < '
     *      ,fil(imat)(1:len_trim(fil(imat)))
     *      ,'  '//r//' casdiout'//num(iter)
     *      //'_'//num(imat)
            write(10,'(a)') namel(1:len_trim(namel))
            if(r.ne.' # ')write(10,'(a)') 
     *      'cp casdiout'//num(iter)//'_'//
     *      num(imat)//' CASDI'//num(imat)//'.OUT'
            if(isuiv==1) then
               write(10,'(a)') trim(reordens)//' < '//
     *         trim(fil(imat))//r//
     *         'reordensout'//num(imat)//'_'//num(iter)
            endif
            !
            write(10,'(a)')'mv DAVEC'//num(imat)//' ESS'//num(IMAT)
            if(ypertu)
     *      write(10,'(a)')'mv DAVECC'//num(imat)//' ESSC'//num(IMAT)
         enddo
         write(namel,'(2a)') locnat(1:len_trim(locnat))
     *   ,' < IN0  '//r//' locnatout'//num(iter)
         write(10,'(a)') namel(1:len_trim(namel))
         if(r.ne.' # ')write(10,'(a)') 
     *   'cp locnatout'//num(iter)//' LOCNAT.OUT'
         close(10)
         call system('chmod +x xx1')
         call system('./xx1')
         yrem=.true.
         do imat=1,nmat
            open(12,file='ESS'//num(imat),
     *      form='unformatted',status='old')
            read(12) ndet,nrac
            read(12) e(1:nrac),enuc,eref
            do k=1,nrac
               write(6,'(a,i3,a,i3,a,f14.8)',advance='NO')
     *         'Iter',iter,'   imat',imat,'   E=',e(k)+enuc+eref
               call flush(6)
c              l'energie remonte ?
               print'(a,f20.8)',
     *         '    difference d''energie',e(k)+enuc+eref-ev(k,imat)
c               print*,e(k),enuc,eref,ev(k,imat)
               if(e(k)+enuc+eref.le.ev(k,imat)) yrem=.false.
            enddo
               call flush(6)
               open(10,file='xxx',status='unknown')
               write(10,'(a)') 'grep "|" casdiout'//num(iter)//'_'//
     *         trim(num(imat))
     *         //' | grep "=>"'
               close(10)
               call system('chmod +x xxx')
               call system('./xxx')
            ev(1:nrac,imat)=e(1:nrac)+enuc+eref
            close(12)
         enddo
         if(yrem) then
            nrem=nrem+1
         else
            nrem=0
         endif
         if(yrem.and.nrem.ge.nb_rem.and.iter.ge.it_rem) then
            print*,'l''ENERGIE REMONTE'
            goto 4
         endif
         open(22,status='old',file='LOCNAT_CONV')
         read(22,*) aaa
         print'(a,d10.3)','  Convergence ',aaa
         call flush(6)
         close(22)
         print*,'-----------------------------'
         open(11,file='CONV',status='old',err=2)
         print*,'le calcul a converge'
         goto 4
 2       continue
c         print*,'maxit',maxit
         cycle
      enddo
      print*,'le calcul n''a pas converge'
 4    continue
      close(93,status='delete')
      end
       subroutine aldon(a,ifil)
      character*(*) a
      character*80 f
      longa=len_trim(a)
      rewind 93
      do
         read(93,'(a)',end=1) f
         longf=len_trim(f)
c         print*, ' aldon1',f(1:longf),' ',a(1:longa)
c         print*, ' aldon2',longf,longa
         if(longf.ne.longa) cycle
         if(f(1:longf).eq.a(1:longa)) then
            do
               read(93,'(a80)') f
               if(f(1:3).eq.'FIN') goto 1
c               print*,'aldon ajout ',f
               write(ifil,'(a80)') f
c               write(6,'(a80)') f
            enddo
         endif
      enddo
 1    continue
c      print*,'sortie aldon'
      rewind 93
      return
      end
       subroutine neworb12(version,ref_orb,oldorb1,neworb1,r)
      character*3 version,r
      character*80 ref_orb
      character*80 oldorb1,neworb1
          !print*,'entree neworb12',version
      if(version.ne.'NEW') return
      !print*,'les orbitales sont reecrites en nouveau format'
c on met a l'abris INPORB
      write(10,'(a)') 'cp INPORB INPORB_neworb1_sv'
      write(10,'(a)') 'cp '//trim(ref_orb)//' INPORB'
c on fait tourner oldorb1 pour creer INSERORB
c     write(10,'(a)') 'oldorb1'
      write(10,'(a)') trim(oldorb1)//r//' molcostout001'
c on recupere INOPEB
      write(10,'(a)') 'cp INPORB_neworb1_sv INPORB'
c on fait tourner NEWORB
c     write(10,'(a)') 'neworb1'
      write(10,'(a)') trim(neworb1)//r//' molcostout001'
      write(10,'(a)') 'mv OUTORB INPORB'
      return
      end
      
      
      
      
      
