      subroutine mlis0 (n,simul,prosca,xn,fn,fpn,t,tmin,tmax,d,g,
     1                  amd,amf,imp,io,logic,nap,napmax,x,niter,ztemp)
c ----
c
c     mlis0 + minuscules + commentaires
c     + version amelioree (XII 88): interpolation cubique systematique
c       et anti-overflows
c     + declaration variables (II/89, JCG).
c     + barr is also progressively decreased (12/93, CL & JChG).
c       barmul is set to 5.
c
c     ----------------------------------------------------------------
c
c        en sortie logic =
c
c        0          descente serieuse
c        1          descente bloquee
c        4          nap > napmax
c        5          retour a l'utilisateur
c        6          fonction et gradient pas d'accord
c        < 0        contrainte implicite active
c
c ----
      use control_vectors
      implicit none
c
c --- arguments
c
      external simul,prosca
      integer n,imp,io,logic,nap,napmax,niter       
      real fn,fpn,t,tmin,tmax,amd,amf
      type (control_vector) :: xn,d,g,x
c
c --- variables locales
c
      integer i,indic,indica,indicd
      real tesf,tesd,tg,fg,fpg,td,ta,fa,fpa,d2,f,fp,ffn,fd,fpd,
     1 z,test,barmin,barmul,barmax,barr,gauche,droite,
     2 taa,ps,zmaxp
      type (control_vector) :: ztemp

c

      if (.not.(n.gt.0 .and. fpn.lt.0. .and. t.gt.0.
     1 .and. tmax.gt.0. .and. amf.gt.0.
     1 .and. amd.gt.amf .and. amd.lt.1.)) then
        logic=6
        goto 999
      endif

      tesf=amf*fpn
      tesd=amd*fpn
      barmin=0.01
      barmul=5.
      barmax=0.3
      barr=barmin
      td=0.
      tg=0.
      fg=fn
      fpg=fpn
      ta=0.
      fa=fn
      fpa=fpn
      call prosca (n,d,d,ps)
      d2=ps
c
c               elimination d'un t initial ridiculement petit
c
      if(t.le.tmin) then
        t=tmin
        if(t.gt.tmax) then
          if (imp.gt.0) write (io,1007)
          tmin=tmax
        endif
      endif

      do
        if (fn+t*fpn.lt.fn+0.9*t*fpn) exit
        t=2.*t
      enddo

      indica=1
      logic=0
      if (t.gt.tmax) then
          t=tmax
          logic=1
      endif
      if (imp.ge.4) write (io,1000) fpn,d2,tmin,tmax
c
c     --- nouveau x
c
      x%data = xn%data + t * d%data
c
c --- boucle
c
      boucle:do
      nap=nap+1
      if(nap.gt.napmax) then
          logic=4
          fn=fg
          xn%data = xn%data + tg * d%data
          exit
      endif
      indic=4
c
c     --- appel simulateur
c
      call simul(indic,n,x,f,g,niter)
      if(indic.eq.0) then
c
c         --- arret demande par l'utilisateur
c
          logic=5
          fn=f
          xn = x
         exit
      endif
      if(indic.lt.0) then
c
c         --- les calculs n'ont pas pu etre effectues par le simulateur
c
          td=t
          indicd=indic
          logic=0
          if (imp.ge.4) write (io,1004) t,indic
          t=tg+0.1*(td-tg)
          go to 905
      endif
c
c     --- les tests elementaires sont faits, on y va
c
      call prosca (n,d,g,ps)
      fp=ps
c
c     --- premier test de Wolfe
c
      ffn=f-fn
      if(ffn.gt.t*tesf) then
          td=t
          fd=f
          fpd=fp
          indicd=indic
          logic=0
          if(imp.ge.4) write (io,1002) t,ffn,fp
          go to 500
      endif
c
c     --- test 1 ok, donc deuxieme test de Wolfe
c
      if(imp.ge.4) write (io,1003) t,ffn,fp
      if(fp.gt.tesd) then
          logic=0
          go to 320
      endif
      if (logic.eq.0) go to 350
c
c     --- test 2 ok, donc pas serieux, on sort
c
  320 continue
      fn=f
      xn =x
      exit
c
c
c
  350 continue
      tg=t
      fg=f
      fpg=fp
      if(td.eq.0.) then
c
c              extrapolation
c
        taa=t
        gauche=(1.+barmin)*t
        droite=10.*t
        call ecube (t,f,fp,ta,fa,fpa,gauche,droite)
        ta=taa
        if(t.ge.tmax) then
          logic=1
          t=tmax
        endif
        go to 900
      endif
c
c              interpolation
c
 500  continue
      if(indica.le.0) then
          ta=t
          t=0.9*tg+0.1*td
      else
        test=barr*(td-tg)
        gauche=tg+test
        droite=td-test
        taa=t
        call ecube (t,f,fp,ta,fa,fpa,gauche,droite)
        ta=taa
        if (t.gt.gauche .and. t.lt.droite) then
          barr=max(barmin,barr/barmul)
c         barr=barmin
        else
          barr=min(barmul*barr,barmax)
        endif
      endif
c
c --- fin de boucle
c     - t peut etre bloque sur tmax
c       (venant de l'extrapolation avec logic=1)
c
  900 continue
      fa=f
      fpa=fp
  905 continue
      indica=indic
c
c --- faut-il continuer ?
c
      if (td.ne.0.) then
      if (td-tg.ge.tmin) then
c
c     --- limite de precision machine (arret de secours) ?
c
      ztemp=0.
!OCL NOALIAS
      do i=1,d%nsizel
          z=xn%data(i)+t*d%data(i)
          ztemp%data(i)=max(abs(z-xn%data(i)),abs(z-x%data(i)))
      enddo
      zmaxp=maxval(ztemp)

      if(zmaxp.ne.0.) go to 950
c
c --- arret sur dxmin ou de secours
c
      endif
      logic=6
c
c     si indicd<0, derniers calculs non faits par simul
c
      if (indicd.lt.0) logic=indicd
c
c     si tg=0, xn = xn_depart,
c     sinon on prend xn=x_gauche qui fait decroitre f
c
      if (tg.ne.0.) then
      fn=fg
      xn%data = xn%data + tg * d%data

      endif
      if (imp.le.0) exit
      write (io,1001)
      write (io,1005) tg,fg,fpg
      if (logic.eq.6) write (io,1005) td,fd,fpd
      if (logic.eq.7) write (io,1006) td,indicd
      exit
c
c               recopiage de x et boucle
c
      endif
  950 continue
      x%data = xn%data + t * d%data

      enddo boucle

  999 continue
      return

 1000 format (/4x," mlis0   ",4x,"fpn=",e10.3," d2=",e9.2,
     1 "  tmin=",e9.2," tmax=",e9.2)
 1001 format (/4x," mlis0",3x,"stop on tmin",8x,
     1   "step",11x,"functions",5x,"derivatives")
 1002 format (4x," mlis0",37x,e10.3,2e11.3)
 1003 format (4x," mlis0",e14.3,2e11.3)
 1004 format (4x," mlis0",37x,e10.3," indic=",i3)
 1005 format (4x," mlis0",14x,2e18.8,e11.3)
 1006 format (4x," mlis0",14x,e18.8,"      indic=",i3)
 1007 format (/4x," mlis0",10x,"tmin forced to tmax")
 1008 format (/4x," mlis0",10x,"inconsistent call")

      end
c
c-----------------------------------------------------------------------
c



