C EXCELL    SOURCE    FD218221  24/02/21    21:15:03     11844          
      SUBROUTINE EXCELL
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC TMXMAT
-INC SMLREEL
-INC SMLENTI
-INC SMTABLE
      segment ibo
      integer  ibon(n)
      endsegment
      LOGICAL PDR,RSPB,RSPD,TEST,ILOG1,ILOG2,TERMIN
      SEGMENT MBI
        INTEGER MBID(NN)
      ENDSEGMENT
      SEGMENT RBI
        REAL*8  RBID(NN)
      ENDSEGMENT
      LOGICAL LOGIN,LOGRE
      CHARACTER*8 TYPOBJ
      CHARACTER*1 CHARIN,CHARRE
      CHARACTER*3 CMETH
      POINTEUR MLREE4.MLREEL,mlent5.mlenti,mlree5.mlreel,mlree6.mlreel
      DELTA0=50.D0
      XSMAX=500.D0
      IPASS=1
      IPART=0
      MAXITE=100
      ITTER=0
       ITISAV=0
       ITKSAV=0
       IVGP=0
       IVGM=0
       IVGE=0
       IVLAMB=0
       IVXU=0
       IVXL=0
       IVU=0
       IVN=0
       IVD=0
       IS0=0
       IT0=0
       MLAM1=0
       IVGP=0
       IVGE=0
       IVGM=0
       IPBASP=0
*
*
*TAB = EXCELL TAB ;
*
*
      CALL LIROBJ('TABLE',ITAB,1,IRETOU)
      IF(IERR.NE.0) RETURN
*
*
*     TRANSFORMATION DES INFORMATIONS DES TABLES EN SEGMENT
*
*     REEL ( VECTEUR)   OU MXMAT  ( MATRICE) LES VALEURS .0
*     SONT MISES DANS DES VARIABLES SEPAREES
*
*
*   VARIABLES X INITIALES
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES X'')')
      TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN,
     *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(IERR.NE.0) GO TO 1000
      N=0
      CALL TABVEC(ITABLE,IVX0,N)
      IF(IERR.NE.0) RETURN
*   DERIVEES DE F PAR RAPPORT A X. PUIS VALEUR DE F INITIALE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS VF'')')
      TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VF',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(IERR.NE.0) GO TO 1000
      CALL TABVEC(ITABLE,IVF,N)
      IF(IERR.NE.0) RETURN
      TYPOBJ='FLOTTANT'
      I = 0
      CALL ACCTAB(ITABLE,'ENTIER  ',I,XVALIN,CHARIN,LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
*
** verification que pas de derivée nulle
*
      mlree5=ivf
      segact mlree5
      segini ibo
       nsup=0
       xgr= 0.
       do iou=1,n
        if( abs(mlree5.prog(iou)).gt.xgr) xgr = abs(mlree5.prog(iou))
       enddo
       epscri= xgr * 1.e-30
       do iou=1,n
       if( abs(mlree5.prog(iou)).gt.0.d0) then
        ibon(iou)=1
       else
        ibon(iou)=0
* on debranche pour l'instant car pose probleme pour les reprises
*        nsup=nsup+1
       endif
       enddo
* elimination des pas bonnes et recopie des anciennes dans mlree6
       if(nsup.ne.0)then
        jg=n
        mlree5=ivx0
        mlree4=ivf
        segact mlree5,mlree4
        segini mlree6
        jg= n - nsup
        segini mlreel,mlree2
        ia = 0
        do iou=1,n
         mlree6.prog(iou)=mlree5.prog(iou)
         if( ibon(iou).eq.1) then
           ia = ia + 1
           prog(ia)=mlree5.prog(iou)
           mlree2.prog(ia)=mlree4.prog(iou)
         endif
        enddo
        ivx0=mlreel
        ivf=mlree2
        segdes mlree5,mlree4
        nvr = n - nsup
        write(6,*) ' nombre de variables non prises en compte ' , nsup
       endif
      IF(IERR.NE.0) GO TO 1000
      VF0=XVALRE
* DERIVEES DES CJ PAR RAPPORT A X LE CJ0 SONT EN INDICE 0 ET SONT
* RECUPERES JUSTE APRES
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS MC'')')
      TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'MC',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(IERR.NE.0) GO TO 1000
      M = 0
      if (iimpi.eq.1799) write (6,*) ' appel a tabmat(ITABLE,MC,M,N)'
      CALL TABMAT(ITABLE,MC,M,N)
      IF(IERR.NE.0) RETURN
      MXMAT=MC
      SEGACT MXMAT*MOD
      if(nsup.ne.0) then
        ldim2 = nvr
        ldim1=xmat(/1)
        segini mxma1
        do iou=1,ldim1
         ia = 0
         do iyo=1,n
          if(ibon(iyo).eq.1) then
           ia=ia+1
           mxma1.xmat(iou,ia)=xmat(iou,iyo)
           endif
          enddo
         enddo
         segsup mxmat
         mxmat=mxma1
         mc=mxmat
         if( iimpi.eq.1799) then
          write(6,*) ' pointeur de mc ldim1 ldim2 ',mc,xmat(/1),xmat(/2)
          write(6,*) ' mc' , ( xmat(1,iou),iou=1,xmat(/2))
         endif
       endif
      JG=XMAT(/1)
      SEGINI MLREEL
      IMC0=MLREEL
      DO 1 J=1,JG
         TYPOBJ=' '
         CALL ACCTAB(ITABLE,'ENTIER  ',J,XVALIN,CHARIN,LOGIN,IOBIN,
     *                      TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBR)
         IF(TYPOBJ.NE.'TABLE   ') GO TO 1
         I= 0
         TYPOBJ='FLOTTANT'
         CALL ACCTAB(IOBR,'ENTIER  ',I,XVALIN,CHARIN,LOGIN,IOBIN,
     *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
         PROG(J)=XVALRE
   1  CONTINUE
      SEGDES MLREEL
* VALEURS MINIMALES DES VARIABLES X
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS MINI DE X '')')
      TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXMIN',LOGIN,IOBIN,
     *                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(IERR.NE.0) GO TO 1000
      CALL TABVEC(ITABLE,IVXMIN,N)
      if(nsup.ne.0) then
        mlree4=ivxmin
        segact mlree4
        jg=nvr
        segini mlree5
        ia=0
        do iou=1,n
         if(ibon(iou).eq.1) then
          ia=ia+1
          mlree5.prog(ia)=mlree4.prog(iou)
         endif
        enddo
        segsup mlree4
        ivxmin=mlree5
      endif
      IF(IERR.NE.0) RETURN
* VALEURS MAXIMALES DES VARIABLES X
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS MAXI DE X '')')
      TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXMAX',LOGIN,IOBIN,
     *                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(IERR.NE.0) GO TO 1000
      CALL TABVEC(ITABLE,IVXMAX,N)
      if(nsup.ne.0) then
        mlree4=ivxmax
        segact mlree4
        jg=nvr
        segini mlree5
        ia=0
        do iou=1,n
         if(ibon(iou).eq.1) then
          ia=ia+1
          mlree5.prog(ia)=mlree4.prog(iou)
         endif
        enddo
        segsup mlree4
        ivxmax=mlree5
      endif
      IF(IERR.NE.0) RETURN
* VALEURS MAXIMALES DES CONTRAINTES CJ
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''VALEURS MAXI DE CJ '')')
      TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VCMAX',LOGIN,IOBIN,
     *                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(IERR.NE.0) GO TO 1000
      CALL TABVEC(ITABLE,IVCMAX,M)
      IF(IERR.NE.0) RETURN
* VALEURS DES VARIABLES DISCRETES
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS DE MVD '')')
      TYPOBJ='        '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VDIS',LOGIN,IOBIN,
     *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      NVD=0
      NNVD=0
      IF( ITABLE.NE.0) CALL TABMAT(ITABLE,MVD,NVD,NNVD)
      IF(IERR.NE.0) RETURN
      IF(NVD.NE.0)THEN
          MXMAT=MVD
      if(nsup.ne.0) then
        ldim2 = nvr
        ldim1=xmat(/1)
        segini mxma1
        do iou=1,ldim1
         ia = 0
         do iyo=1,n
          if(ibon(iyo).eq.1) then
           ia=ia+1
           mxma1.xmat(iou,ia)=xmat(iou,iyo)
           endif
          enddo
         enddo
         segsup mxmat
         mxmat=mxma1
         mvd=mxmat
       endif
      ENDIF
* ITERATION IP
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''VALEUR DE IP '')')
      TYPOBJ='      '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'IP',LOGIN,IOBIN,
     *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(TYPOBJ.EQ.'ENTIER  ') THEN
          IP=IVALRE
      ELSE
          IP=1
      ENDIF
* valeur de delta0
      TYPOBJ='      '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'DELTA0',LOGIN,IOBIN,
     *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(TYPOBJ.EQ.'ENTIER  ') THEN
          DELTA0=IVALRE
      ENDIF
      IF(TYPOBJ.EQ.'FLOTTANT') THEN
          DELTA0=XVALRE
      ENDIF
* valeur de xsmax
      TYPOBJ='      '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'XSMAX',LOGIN,IOBIN,
     *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(TYPOBJ.EQ.'ENTIER  ') THEN
          XSMAX=IVALRE
      ENDIF
      IF(TYPOBJ.EQ.'FLOTTANT') THEN
          XSMAX=XVALRE
      ENDIF
* valeur de maxite
      TYPOBJ='      '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'MAXITERATION',LOGIN,
     *  IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
      IF(TYPOBJ.EQ.'ENTIER  ') THEN
          MAXITE=IVALRE
      ENDIF
* LECTURE DE L'OPTION CHOISIE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' OPTION CHOISIE '')')
      TYPOBJ='        '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'METHODE',LOGIN,IOBIN,
     *                     TYPOBJ,IVALRE,XVALRE,CMETH,LOGRE,ITABLE)
      IMETH=1
      IF(TYPOBJ.EQ.'MOT        ') THEN
        IF(CMETH.EQ.'MOV') IMETH=2
      IF(CMETH.EQ.'LIN') IMETH=3
       ENDIF
*
* POINTS PRECEDENTS
* LIMITES PRECEDENTES
      IF(IP.EQ.1) THEN
          JG=N+1
          SEGINI MLREEL,MLREE1
          IVXPR1=MLREEL
          IVXPR2=MLREE1
          SEGINI MLREE2,MLREE3
          IVLL=MLREE2
          IVUL=MLREE3
      ELSE
          IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES XP1'')')
          TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
          IF(IERR.NE.0) GO TO 1000
          CALL TABVEC(ITABLE,IVXPR1,N)
          IF(IERR.NE.0) RETURN
          IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES XP2'')')
          TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN,
     *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
          IF(IERR.NE.0) GO TO 1000
          CALL TABVEC(ITABLE,IVXPR2,N)
          IF(IERR.NE.0) RETURN
          IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES VUL '')')
          TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN,
     *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
          IF(IERR.NE.0) GO TO 1000
          CALL TABVEC(ITABLE,IVUL,N)
          IF(IERR.NE.0) RETURN
          JG=N+1
          MLREEL=IVUL
          SEGADJ MLREEL
          IF(IERR.NE.0) RETURN
          IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES VLL '')')
          TYPOBJ='TABLE'
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
          IF(IERR.NE.0) GO TO 1000
          CALL TABVEC(ITABLE,IVLL,N)
          IF(IERR.NE.0) RETURN
          JG=N+1
          MLREEL=IVLL
          SEGADJ MLREEL
      ENDIF
*
*   VERIFICATION DU POINT DE DEPART
*
      MLREEL=IVX0
      MLREE1=IVXMAX
      MLREE2=IVXMIN
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
      JG=PROG(/1)
      N=jg
      DO 64 I=1,JG
      PROD=(MLREE1.PROG(I)-PROG(I))*(MLREE2.PROG(I)-PROG(I))
      aux=1d0+abs(MLREE2.PROG(I))+abs(MLREE1.PROG(I))
      prod=prod/aux
      IF(PROD.GT.1D-4) THEN
           WRITE(6,63)
           WRITE(6,'(''!!LE POINT DE DEPART EST HORS-DOMAINE!!!'')')
           WRITE(6,63)
   63 FORMAT('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!')
           GOTO 1000
      ENDIF
   64 CONTINUE
*
* calcu des Dj qui permettent de respecter les contraintes
* en supposant que variable de relaxation egale DELTA0
*
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS DE WD '')')
      MLREEL=IVCMAX
      MLREE1=IMC0
      SEGACT MLREEL*MOD,MLREE1*MOD
      JG=M
      SEGINI MLREE2
      IWD=MLREE2
      DO 17 K=1,M
        Z=MLREE1.PROG(K)-PROG(K)
       IF(Z.GT.1.D-20) THEN
          MLREE2.PROG(K)=Z/(1.-1./DELTA0)
       IF(IIMPI.GT.0)
     * WRITE(IOIMP,FMT='('' contrainte '',i3,'' pas satisfaite'')')K
        ELSE
          MLREE2.PROG(K)=0.D0
        ENDIF
   17 CONTINUE
*
*   introduction de la variable  de relaxation
*
      N11 = N + 1
* dans X0
      MLREEL = IVX0
      SEGACT MLREEL*MOD
      JG=PROG(/1) + 1
      IF(JG.NE.N11) GO TO 1000
      SEGADJ MLREEL
      PROG(JG)=DELTA0
      SEGDES MLREEL
* dans Xmin
      MLREEL=IVXMIN
      SEGACT MLREEL*MOD
      JG=PROG(/1) + 1
      IF(JG.NE.N11) GO TO 1000
      SEGADJ MLREEL
      PROG(JG)=1.D0
      SEGDES MLREEL
* dans Xmax
      MLREEL=IVXMAX
      SEGACT MLREEL*MOD
      JG=PROG(/1) + 1
      IF(JG.NE.N11) GO TO 1000
      SEGADJ MLREEL
      PROG(JG)=XSMAX
      SEGDES MLREEL
* dans les derivees de F
      MLREEL=IVF
      SEGACT MLREEL*MOD
      JG=PROG(/1) + 1
      IF(JG.NE.N11) GO TO 1000
      SEGADJ MLREEL
      PROG(JG)=2. ** IP  * (ABS(VF0))
      SEGDES MLREEL
* dans f(x0) contenu dans la variable VF0
      VF0 = VF0 + 2. ** IP * (ABS( VF0)) * DELTA0
* dans les derivees de CJ
      MXMAT=MC
      MLREEL=IWD
      SEGACT MLREEL*MOD,MXMAT*MOD
      LDIM2=XMAT(/2)+1
      LDIM1=XMAT(/1)
      if( iimpi.eq.1799) then
        write(6,*) ' mc pointeur ' , mc
        write(6,*) ' ldim1  ldim2  apres var relax',ldim1,ldim2
      endif
      SEGADJ MXMAT
      DELT=-1. / ( DELTA0 * DELTA0)
      DO 702 I=1,XMAT(/1)
      XMAT(I,LDIM2)=PROG(I)* DELT
  702 CONTINUE
      SEGDES MLREEL,MXMAT
* dans Cjmax
      MLREEL=IVCMAX
      MLREE1=IWD
      SEGACT MLREEL*MOD,MLREE1*MOD
      DO 703 I=1,PROG(/1)
      PROG(I)=PROG(I) + MLREE1.PROG(I)
  703 CONTINUE
      SEGDES MLREEL,MLREE1
*  dans cj0
      MLREEL=IMC0
      MLREE1=IWD
      SEGACT MLREEL*MOD,MLREE1*MOD
      DO 707 I=1,PROG(/1)
      PROG(I)=PROG(I) - MLREE1.PROG(I)/DELTA0
  707 CONTINUE
      SEGDES MLREEL,MLREE1
*
         TYPOBJ=' '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'PREC',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)

           IF(TYPOBJ.EQ.'FLOTTANT') THEN
               XPREC=XVALRE
           ELSEIF(TYPOBJ.EQ.'ENTIER  ') THEN
               XPREC=IVALRE
           ELSE
               XPREC=500d0
           ENDIF
*
*   INTRODUCTION DES MOVE-LIMITS
*
      IF (IMETH.EQ.1) THEN
         TYPOBJ=' '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'T0',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
         IF(TYPOBJ.EQ.'TABLE   ') THEN
            CALL TABVEC(ITABLE,IT0,N11)
            IF(IERR.NE.0) RETURN
         ELSE
           IF(TYPOBJ.EQ.'FLOTTANT') THEN
              XT0=XVALRE
           ELSEIF(TYPOBJ.EQ.'ENTIER  ') THEN
              XT0=IVALRE
           ELSE
              XT0=0.333333d0
           ENDIF
           JG=N11
           SEGINI MLREEL
           IT0=MLREEL
           DO 704 I=1,JG
             PROG(I)=XT0
  704       CONTINUE
         ENDIF
      ENDIF
      IF (IMETH.EQ.2) THEN
         TYPOBJ='        '
      CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'S0',LOGIN,IOBIN,
     *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
         IF(TYPOBJ.EQ.'TABLE') THEN
            CALL TABVEC(ITABLE,IS0,N11)
            IF(IERR.NE.0) RETURN
         ELSE
           IF(TYPOBJ.EQ.'FLOTTANT') THEN
              XS0=XVALRE
           ELSEIF(TYPOBJ.EQ.'ENTIER  ') THEN
              XS0=IVALRE
           ELSE
              XS0=0.7d0
           ENDIF
            JG=N11
            SEGINI MLREEL
            IS0=MLREEL
            DO 705 I=1,JG
             PROG(I)=XS0
  705          CONTINUE
         ENDIF
       ENDIF

         CALL CHGLIM(IVX0,IVXMIN,IVXMAX,IVXPR1,IVXPR2,N11,IP,
     *             IVLL,IVUL,IVMIN,IVMAX,IMETH,IT0,IS0,XSMAX)
*
* SAUVEGARDE DES DERNIERES VALEURS DE VX0
*
      MLREEL=IVX0
      MLREE1=IVXPR1
      MLREE2=IVXPR2
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
      DO 51 I=1,N
         MLREE2.PROG(I)=MLREE1.PROG(I)
         MLREE1.PROG(I)=PROG(I)
   51 CONTINUE
*
*  MODIFICATION DE LA VALEUR DE X
*
      MLREEL=IVX0
      MLREE1=IVUL
      MLREE2=IVLL
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
      JG=PROG(/1)
      SEGINI MLREE3,MLREE4
      IVX0U=MLREE3
      IVX0L=MLREE4
      DO 52 I=1,JG
         MLREE3.PROG(I)=MLREE1.PROG(I)-PROG(I)
         MLREE4.PROG(I)=PROG(I)-MLREE2.PROG(I)
   52 CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,57)(MLREE3.PROG(K),K=1,N11)
   57 FORMAT(' VALEUR DE DEPART EN VX0U : ',/,(1X,5E12.5))
      IF(IIMPI.EQ.1799) WRITE(IOIMP,58)(MLREE4.PROG(K),K=1,N11)
   58 FORMAT(' VALEUR DE DEPART EN VX0L : ',/,(1X,5E12.5))
*
*  LINEARISATIONS CONVEXE DE F
*
      MLREEL=IVF
      MLREE1=IVX0U
      MLREE2=IVX0L
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
      JG = PROG(/1)
      SEGINI,MLREE3
      IVFP=MLREE3
      SEGINI,MLREE4
      IVFQ=MLREE4
      DO 3 I=1,JG
      IF(PROG(I).GT.0.D0) THEN
           MLREE3.PROG(I)=PROG(I)*(MLREE1.PROG(I)**2)
      ELSE
           MLREE4.PROG(I)=ABS(PROG(I))*(MLREE2.PROG(I)**2)
      ENDIF
   3  CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,4)(MLREE3.PROG(K),K=1,N11)
   4  FORMAT('  SENSIBILITES TYPE + DE F LINEARISEE : ',/,(1X,5E12.5))
      IF(IIMPI.EQ.1799) WRITE(IOIMP,41)(MLREE4.PROG(K),K=1,N11)
  41  FORMAT('  SENSIBILITES TYPE - DE F LINEARISEE : ',/,(1X,5E12.5))
      DO 53 I=1,N11
         VF0=VF0-(MLREE3.PROG(I)/MLREE1.PROG(I))
         VF0=VF0-(MLREE4.PROG(I)/MLREE2.PROG(I))
  53  CONTINUE
*
*  LINEARISATION CONVEXE DES CONTRAINTE CJ
*
      MXMAT=MC
      SEGACT MXMAT*MOD
      LDIM1=XMAT(/1)
      LDIM2=XMAT(/2)
      if(iimpi.eq.1799) then
      write(6,*) ' xmat de mc' , (xmat(1,iou),iou=1,xmat(/2))
      endif
      IF(LDIM2.NE.N11) GO TO 1000
      SEGINI MXMA1
      MCP=MXMA1
      SEGINI MXMA2
      MCQ=MXMA2
      MLREE1=IVX0U
      MLREE3=IVX0L
      MLREEL=IVCMAX
      MLREE2=IMC0
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD
      JG=LDIM1
      SEGINI MLREE4
      IVB=MLREE4
      DO 5 I=1,LDIM1
      MLREE4.PROG(I)=PROG(I)-MLREE2.PROG(I)
      TIN=0.
      DO 7 J=1,N11
      IF(XMAT(I,J).GT.0.D0) THEN
         MXMA1.XMAT(I,J)=XMAT(I,J)*(MLREE1.PROG(J)**2)
      ELSE
         MXMA2.XMAT(I,J)=ABS(XMAT(I,J))*(MLREE3.PROG(J)**2)
      ENDIF
      TIN=TIN+(MXMA1.XMAT(I,J)/MLREE1.PROG(J))
      TIN=TIN+(MXMA2.XMAT(I,J)/MLREE3.PROG(J))
   7  CONTINUE
      MLREE4.PROG(I)=MLREE4.PROG(I)+TIN
   5  CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,6)(MLREE4.PROG(I),I=1,M)
      MLREEL=IWD
      MLREE1=IVB
      SEGACT MLREEL*MOD,MLREE1*MOD
      JG=PROG(/1)
      DO 56 I=1,JG
      IF(IIMPI.EQ.1799) WRITE(IOIMP,8)I,(MXMA1.XMAT(I,K),K=1,N11)
  8   FORMAT('  SENSIBILITES TYPE + DE C',I3,' LINEARISEE : ',
     *  /,(1X,5E12.5))
      IF(IIMPI.EQ.1799) WRITE(IOIMP,9)I,(MXMA2.XMAT(I,K),K=1,N11)
  9   FORMAT('  SENSIBILITES TYPE - DE C',I3,' LINEARISEE : ',
     *  /,(1X,5E12.5))
  56  CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,6)(MLREE1.PROG(I),I=1,M)
  6   FORMAT(' VALEURS DE IVB LINEARISEE : ',(1X,5E12.5))
*
*  CHANGEMENT DE VARIABLES DE XMAX
*
      MLREEL=IVUL
      MLREE1=IVLL
      MLREE2=IVMAX
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
      JG=PROG(/1)
      SEGINI MLREE3,MLREE4
      IVMAXU=MLREE3
      IVMAXL=MLREE4
      DO 10 I=1,JG
        MLREE3.PROG(I)=PROG(I)-MLREE2.PROG(I)
        MLREE4.PROG(I)=MLREE2.PROG(I)-MLREE1.PROG(I)
   10 CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,11)(MLREE3.PROG(K),K=1,N11)
   11 FORMAT('  BORNES MAXIMA EN U ',/,(1X,5E12.5))
      IF(IIMPI.EQ.1799) WRITE(IOIMP,12)(MLREE4.PROG(K),K=1,N11)
   12 FORMAT('  BORNES MAXIMA EN L ',/,(1X,5E12.5))
*
*  CHANGEMENT DE VARIABLES DE XMIN
*
      MLREEL=IVUL
      MLREE1=IVLL
      MLREE2=IVMIN
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
      JG=PROG(/1)
      SEGINI MLREE3,MLREE4
      IVMINU=MLREE3
      IVMINL=MLREE4
      DO 54 I=1,JG
        MLREE3.PROG(I)=PROG(I)-MLREE2.PROG(I)
        MLREE4.PROG(I)=MLREE2.PROG(I)-MLREE1.PROG(I)
   54 CONTINUE
      IF(IIMPI.EQ.1799) WRITE(IOIMP,14)(MLREE3.PROG(K),K=1,N11)
   14 FORMAT('  BORNES MINIMA EN U ',/,(1X,5E12.5))
      IF(IIMPI.EQ.1799) WRITE(IOIMP,15)(MLREE4.PROG(K),K=1,N11)
   15 FORMAT('  BORNES MINIMA EN L ',/,(1X,5E12.5))
*
*  NORMALISATION DES VARIABLES DISCRETES
*
      IF(NVD.NE.0) THEN
         MXMAT=MVD
         SEGACT MXMAT*MOD
         NDIS=XMAT(/2)
         LDIM1=XMAT(/1)
         LDIM2=NDIS+2
         SEGINI MXMA1
         NMVD=MXMA1
         DO 19 I=1,NVD
            DO 19 J=2,NDIS+1
              MXMA1.XMAT(I,J)=XMAT(I,J-1)
   19    CONTINUE
         MLREEL=IVUL
         MLREE1=IVLL
         SEGACT MLREEL*MOD,MLREE1*MOD
         JG=LDIM1
         SEGINI MLENTI
         IDVD=MLENTI
         MVD=NMVD
         MXMAT=MVD
         SEGACT MXMAT*MOD
         LDIM1=XMAT(/1)
         LDIM2=XMAT(/2)
         SEGINI MXMA1,MXMA2
         MVDU=MXMA1
         MVDL=MXMA2
         DO 18 I=1,NVD
           DO 13 J=2,NDIS+2
             MXMA1.XMAT(I,J)=PROG(I)-XMAT(I,J)
             MXMA2.XMAT(I,J)=XMAT(I,J)-MLREE1.PROG(I)
             IF(XMAT(I,J).LT.1.D-20) THEN
               LECT(I)=J-1
               XMAT(I,J)=XGRAND
               MXMA1.XMAT(I,J)=XGRAND
               MXMA2.XMAT(I,J)=XGRAND
               GO TO 18
             ENDIF
   13      CONTINUE
   18    CONTINUE
*
         IF(IIMPI.EQ.1799)THEN
            WRITE(IOIMP,'('' NOUVELLE MATRICE MVDU'')')
            DO 20 I=1,LDIM1
               WRITE(IOIMP,'('' LIGNE  '',I2)')I
               DO 20 J=1,LDIM2
                  WRITE(IOIMP,'(E12.5)')MXMA1.XMAT(I,J)
   20       CONTINUE
         ENDIF
         IF(IIMPI.EQ.1799)THEN
            WRITE(IOIMP,'('' NOUVELLE MATRICE MVDL'')')
            DO 55 I=1,LDIM1
               WRITE(IOIMP,'('' LIGNE  '',I2)')I
               DO 55 J=1,LDIM2
                  WRITE(IOIMP,'(E12.5)')MXMA2.XMAT(I,J)
   55       CONTINUE
         ENDIF
      ENDIF
*
*    INITIALISATION DE L ALGORITHME
*
      JG=M
      SEGINI MLREEL
      IVLAMB=MLREEL
      DO 16 I=1,JG
         PROG(I)=1.D0
  16  CONTINUE
*
*       INITIALISATION DES PARAMETRES DE CONTROLES
*
      TERMIN=.FALSE.
      PDR=.FALSE.
      RSPB=.FALSE.
      RSPD=.FALSE.
      NDR=0
      EPSILO=0.001
      JG=0
      SEGINI MLENT1,MLENT2
      ITI=MLENT1
      ITK=MLENT2
      JG=M
      SEGINI MLENTI
      MDR=MLENTI
      NDP=1
      XL=0.
      NPDR=0
      XLL=0.
      LDIM1=M
      LDIM2=M
      SEGINI MXMAT
      MP=MXMAT
*
*
*  DEBUT DE TOURNER EN ROND
*
*
      IT=0
      JG= M
      SEGINI MLENTI
      IPBASE=MLENTI
  101 CONTINUE
      IF(IIMPI.EQ.1799)
     *WRITE(IOIMP,FMT='('' ETAPE1: CALCUL DE X LAMBDA '')')
      CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
     *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  102 CONTINUE
      IF(IT.EQ.0) THEN
      MLREEL=IVXU
      MLREE3=IVXL
      MLREE1=IVN
      MLREE2=IVD
      SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD
      ENDIF
      IF(IIMPI.EQ.1799)
     *WRITE(IOIMP,FMT='('' ETAPE2:CALCUL DE LA DIRECTION DE MONTEE'')')
      IF(IT.GT.0 ) THEN
         IVZZ=IVGE
      ENDIF
      CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
      IVDR=IVGM
      IF(IT.EQ.0) THEN
       MLREEL=IVGM
       SEGACT MLREEL*MOD
      IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M)
      IF(IIMPI.EQ.1799) WRITE(IOIMP,10014) (PROG(I),I=1,M)
10014  FORMAT(' VALEUR DE GRAD ',/ ,(1X,5(E12.5)))
      ENDIF
*       ON CONTINUE OBLIGATOIREMENT EN NDP=3
  103 CONTINUE
      IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M)
      ITTER=ITTER+1
      MLREEL=IVDR
      MLENTI=MDR
      DO 1020 I=1,M
        IF(LECT(I).EQ.1) PROG(I)=0.D0
 1020 CONTINUE
      IF(ITTER.GT.MAXITE) THEN
        INTERR(1)=MAXITE
        CALL ERREUR(602)
        GO TO 116
      ENDIF
      IF(IIMPI.EQ.1799)
     *WRITE(IOIMP,FMT='('' ETAPE3:TEST NORME DIRECTION DE RECHERCHE'')')
      CALL ETAPE3(PROG,M,XNORZ)
      IF(IIMPI.NE.0) WRITE(6,1564) ITTER,XNORZ
 1564 FORMAT(' iteration ', I5,' critere : ',E12.5)
*****   TEST BIDON POUR CREER UN GO TO EN 104|||
      IF(IOIMP.EQ.-598) GO TO 104
      IF(ITTER.EQ.1) THEN
               EPSILO= XNORZ / XPREC
c               WRITE(IOIMP,FMT='('' valeur du test de convergence''
c     $  ,2e12.5 )') EPSILO,XPREC
      ENDIF
      IF( XNORZ.LE.EPSILO.AND.IPART.NE.1) THEN
          GO TO 116
      ELSE
          IPART=0
          GO TO 106
      ENDIF
 104  CONTINUE
      IF(IIMPI.EQ.1799)
     *WRITE(IOIMP,FMT='('' ETAPE4: CALCUL DU HESSIEN'')')
      IF ( IT .GT.0) THEN
         CALL ETAPE4(MCP,MCQ,M,N,IVU,IVXU,IVN,MH)
         CALL TXAY(IVZZ,MH,IVZZ,M,M,XRES)
         IF(XRES.EQ.0.D0) THEN
            IF(IIMPI.GT.1)
     *WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')')
            GO TO 106
         ELSE
            IF(IIMPI.EQ.1799)
     * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES POSSIBLE'')')
            GO TO 105
         ENDIF
      ELSE
            IF(IIMPI.GT.1)
     * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')')
         GO TO 106
      ENDIF
 105  CONTINUE
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT=
     *'('' ETAPE5 CONJUGAISON DES DIRECTIONS DE RECHERCHE'' )')
      CALL ETAPE5(IVZ,IVZZ,MH,M)
* ON VA OBLIGATOIREMENT EN NDP=6
  106 CONTINUE
      IF(IIMPI.EQ.1799)  WRITE(IOIMP,FMT='(
     *'' ETAP6 RECHERCHE LINEAIRE SUIVANT LA DIRECTION DE RECHERCHE'')')
      CALL NTAPE6(MCP,MCQ,IVMINU,IVMINL,IVMAXU,IVMAXL,IVLAMB,
     * M,N,NVD,IVFP,IVFQ,MVDU,MVDL,IVB,IVD,IVN,II,KK,IVDR,IDVD,
     * NDR,TERMIN,IVLL,IVUL,IPBASE)
      IF(TERMIN)THEN
         ITI=ITISAV
         ITK=ITKSAV
         NPDR=NPDRSV
         GO TO 121
      ENDIF
      IF(II.GT.0) THEN
          IF(KK.EQ.-3) THEN
          MLENTI=IPBASE
           SEGACT MLENTI*MOD
           LECT(II)=1
           SEGDES MLENTI
      ENDIF
      ENDIF
      CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
     *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
      CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
      MLREEL=IVLAMB
      SEGACT MLREEL*MOD
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT=
     *'(''  LAMBDA OPTIMAL '',/,(1X,5E12.5))')(PROG(I),I=1,M)
      MLREEL=IVGM
      SEGACT MLREEL*MOD
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
     *('' VALEUR DU GRADIENT MODIF SORTIE ETAPE6 : '',/,(1X,5E12.5))')
     *(PROG(I),I=1,M)
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE II ETAPE6
     *: '',/,(1X,I2))')II
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE KK ETAPE6
     *: '',/,(1X,I2))')KK
      MLREEL=IVXU
      SEGACT MLREEL*MOD
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXU : ''
     *,/,(1X,5E12.5))')(PROG(I),I=1,N11)
      MLREEL=IVXL
      SEGACT MLREEL*MOD
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXL : ''
     *,/,(1X,5E12.5))')(PROG(I),I=1,N11)
* ON VA OBLIGATOIREMENT EN NDP=7
  107 CONTINUE
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE7: TEST ... '')')
      IF(II.GT.0) THEN
          IF(KK.GT.0) THEN
             RSPD=.TRUE.
             RSPB=.FALSE.
         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
     *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE DISCONTINUITE '')')
             GO TO 111
         ENDIF
      ENDIF
         IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     * ('' LA RECHERCHE NE SE TERMINE'',
     *''PAS SUR UN PLAN DE DISCONTINUITE '')')
* EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=8
  108 CONTINUE
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE8: TEST ... '')')
      IF(II.GT.0) THEN
          IF(KK.EQ.-3) THEN
             RSPD=.FALSE.
             RSPB=.TRUE.
         IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE BASE '')')
             GO TO 110
          ENDIF
      ENDIF
         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
     *('' LA RECHERCHE NE SE TERMINE PAS SUR UN PLAN DE BASE  '')')
* EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=9
  109 CONTINUE
      RSPD=.FALSE.
*      RSPB=.FALSE.
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE9: TEST ... '')')
      IF(IIMPI.EQ.1799)WRITE(IOIMP,FMT='
     *('' PREMIER PLAN DE DISCONTINUITE ?'')')
      IF(PDR) THEN
           GO TO 115
      ELSE
           IF(IPASS.EQ.1) THEN
             MLREEL=IVLAMB
             SEGINI,MLREE1=MLREEL
             MLAM1=MLREE1
             SEGDES MLREE1
           ELSEIF(IPASS.EQ.3) THEN
             CALL PARTAN (IVLAMB,MLAM1,IVGE,IVGM)
             IPART=1
             MLREEL=IVGM
             IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
     *       ('' VALEUR DU GRADIENT MODIF SORTIE PARTAN: '',
     *       /,(1X,5E12.5))')(PROG(I),I=1,M)
             IPASS=0
           ENDIF
           IPASS=IPASS + 1
           IT = IT + 1
           IVDR=IVGM
           GO TO 103
      ENDIF
  110 CONTINUE
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE10: TEST ... '')')
      IF(PDR) THEN
           GO TO 114
      ELSE
           IPASS=1
           IT = IT + 1
           IVDR=IVGM
           GO TO 103
      ENDIF
  111 CONTINUE
      NPDR=NPDR + 1
      IF(IIMPI.GT.1)
     *WRITE(IOIMP,FMT='('' ETAPE11: UN NOUVEAU PLAN DE '',
     *''DISCONTINUITE EST PRIS EN COMPTE '')')
      IF(IIMPI.GT.1)
     *WRITE(IOIMP,FMT='('' NOMBRE DE PLAN DE DISCONTINUITE '',
     *''A CONSIDERER :'',I4)')NPDR
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' INDICE DE LA VARIABLE DISCRETE :'',I4)')II
      IF(IIMPI.GT.1)
     *WRITE(IOIMP,FMT='('' INDICE DE SA VALEUR :'',I4)')KK
      JG=NPDR
      MLENT1=ITI
      MLENT2=ITK
      SEGADJ MLENT1
      SEGADJ MLENT2
      MLENT1.LECT(JG)=II
      MLENT2.LECT(JG)=KK
      IF(PDR) THEN
          GO TO 113
      ENDIF
* SINON ON CONTINUE OBLIGATOIREMENT EN 112
  112 CONTINUE
      PDR=.TRUE.
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
     *('' ETAP12 : INITIALISATION DE LA MATRICE DE PROJECTION'')')
      CALL NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP)
      MXMAT=MP
      JG=M
      SEGINI MLREE1
      MLREEL=IVGE
      CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2)
      IF(IVGP.NE.0) THEN
         MLREEL=IVGP
         SEGSUP MLREEL
      ENDIF
      IVGP=MLREE1
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
     *('' VALEUR DU GRADIENT PROJETE DANS ETAPE12 : '',/,(1X,5E12.5))')
     *(MLREE1.PROG(I),I=1,M)
      MLREE2=IVLAMB
      JG=0
      SEGINI MLENTI
      DO 130 I=1,M
         IF(MLREE2.PROG(I).EQ.0.D0)THEN
             IF(MLREE1.PROG(I).LT.0.D0)THEN
               JG=JG+1
               SEGADJ MLENTI
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(
     *'' ON CONSIDERE DANS L INITIALISATION LE PLAN DE BASE :'',I2)')I
               LECT(JG)=I
             ENDIF
         ENDIF
  130 CONTINUE
      IF(JG.NE.0)THEN
      DO 131 I=1,JG
          IK=LECT(I)
          CALL ETAP14(MP,IK,M)
  131 CONTINUE
      SEGSUP MLENTI
      ENDIF
      GO TO 115
  113 CONTINUE
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' ETAPE13 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')')
      CALL NTAP13(MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II)
      IF(IIMPI.GT.1)THEN
      WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR DISCONTI'')')
      ENDIF
      GO TO 115
  114 CONTINUE
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' ETAPE14 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')')
      CALL ETAP14(MP,II,M)
      IF(IIMPI.GT.1)THEN
      WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR BASE'')')
      ENDIF
* ON CONTINUE OBLIGATOIREMENT EN 115
  115 CONTINUE
      MXMAT=MP
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' ETAPE15 : PROJECTION DU GRADIENT DE LA FONCTION DUALE'')')
      MLREEL=IVGE
      JG=PROG(/1)
      SEGINI MLREE1
      MXMAT=MP
      CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2)
      IF( IVGP.NE.0) THEN
         MLREE2=IVGP
         SEGSUP MLREE2
      ENDIF
      IVGP=MLREE1
      IT=IT+1
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
     *('' VALEUR DU GRADIENT PROJETE : '',/,(1X,5E12.5))')
     *(MLREE1.PROG(I),I=1,M)
      IVDR=IVGP
      GO TO 103
  116 CONTINUE
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  ETAPE 16 : TEST ... '')')
      IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' REDEMARRAGE '')')
      IF(RSPB) THEN
         IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
     *('' PLAN DE BASE RENCONTRE '')')
        IF(IPBASP.NE.0)  THEN
          MLENT1=IPBASP
          SEGACT MLENT1*MOD
          MLENTI=IPBASE
          SEGACT MLENTI*MOD
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
     *('' VALEUR DE IPBASE : '',/,(1X,5I2))')
     *( LECT(I),I=1,M)
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
     *('' VALEUR DE IPBASP : '',/,(1X,5I2))')
     *( MLENT1.LECT(I),I=1,M)

          DO 1160 IU=1,M
          IF( MLENT1.LECT(IU).NE. 0 )GO TO 1161
 1160     CONTINUE
          GO TO 1162
 1161     SEGSUP MLENT1
        ENDIF
        IPBASP=IPBASE
        JG = M
        SEGINI MLENTI
        IPBASE=MLENTI
      CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
     *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
      CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
C avant NTAPE2, IVDR=IVGM or IVGM est "recree", on met le nouveau IVGM dans IVDR
      IVDR=IVGM
        GO TO 103
 1162  CONTINUE
* ON CONTINUE EN 117
      ENDIF
      IF(RSPD) THEN
         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
     *('' PLAN DE DISCONTINUITE RENCONTRE'')')
      ENDIF
      IF(.NOT.PDR) GO TO 122
* ON CONTINUE EN 117
  117 CONTINUE
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
     * (''  ETAPE 17 : TEST DE REDEMARRAGE '')')
      IF(NDR.EQ.5) GO TO 121
      CALL NTAP17(IVFP,IVFQ,IVXU,IVXL,IVLAMB,IVB,IBU,IBL,VF0,NDR,N,
     *MCP,MCQ,M,XL,XLL,TEST,NPDR,MVDU,MVDL,ITI,ITK,VFPMAX,IVN,IVD)
      MLREE2=IBU
      MLREE3=IBL
      SEGACT MLREE2*MOD,MLREE3*MOD
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17
     * = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17
     * = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)
      IF(TEST) THEN
        MLENT1=ITI
        MLENT2=ITK
        JG=MLENT1.LECT(/1)
        IF(ITISAV.NE.0) THEN
            MLENTI= ITISAV
            SEGSUP MLENTI
        ENDIF
        IF(ITKSAV.NE.0) THEN
            MLENTI= ITKSAV
            SEGSUP MLENTI
        ENDIF
        SEGINI MLENTI
        SEGINI MLENT3
        ITISAV=MLENTI
        ITKSAV=MLENT3
        NPDRSV=NPDR
        DO 140 I=1,JG
          LECT(I)=MLENT1.LECT(I)
          MLENT3.LECT(I)=MLENT2.LECT(I)
  140   CONTINUE
        PDR=.FALSE.
        MXMAT=MP
        SEGSUP MXMAT
        IF(RSPD) THEN
          MLENT1=ITI
          MLENT2=ITK
          MLENT1.LECT(1)=MLENT1.LECT(NPDR)
          MLENT2.LECT(1)=MLENT2.LECT(NPDR)
          NPDR=1
          RSPD=.FALSE.
          GO TO 112
        ENDIF
  119   CONTINUE
        IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  ETAPE19 : TEST ..'')')
        IF(RSPB)THEN
           RSPB=.FALSE.
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE19 PRISE EN COMPTE DU
     *PLAN DE BASE NO :'',I4)')II
           MLENTI=MDR
           LECT(II)=1
        ENDIF
        NPDR=0
        GO TO 101
      ENDIF
  121 CONTINUE
        IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  FIN DES RECHERCHES'')')
        IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE21 : SELECTION DES VARIA
     *BLES DISCRETES OPTIMALES '')')
      CALL NTAP21(IVFP,IVFQ,IVLAMB,IVB,IBU,IBL,
     * NPDR,N,MCP,MCQ,M,MVDU,MVDL,ITI,ITK)
      MLREE1=IBU
      MLREE2=IBL
      SEGACT MLREE1*MOD,MLREE2*MOD
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
     *ION = IBU :'',/,(1X,5E12.5))')(MLREE1.PROG(I),I=1,N11)
      IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
     *ION = IBL :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
      MLREE3=IVXU
      MLREE4=IVXL
      SEGACT MLREE3*MOD,MLREE4*MOD
      JG=MLREE1.PROG(/1)
      DO 1220 I=1,JG
         MLREE3.PROG(I)=MLREE1.PROG(I)
         MLREE4.PROG(I)=MLREE2.PROG(I)
 1220 CONTINUE
*   ON CONTINUE EN 122
  122 CONTINUE
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE 22 : FIN DE L ALGORITHME
     *  '')')
*      CALL ETAP22(IVX,IVX0,N,IVF,IVLL,IVUL)
      INTERR(1)=ITTER
      MLREE1=IVXU
      MLREE2=IVXL
      MLREE3=IVUL
      MLREE4=IVLL
      SEGACT MLREE1*MOD
      SEGACT MLREE2*MOD
      SEGACT MLREE3*MOD
      SEGACT MLREE4*MOD
      JG=N
      SEGINI MLREEL
      IVX=MLREEL
      DO 1221 I=1,JG
        PROG(I)=MLREE3.PROG(I)-MLREE1.PROG(I)
        CST=MLREE2.PROG(I)+MLREE4.PROG(I)
        IF(IIMPI.EQ.17)
     *  WRITE(IOIMP,'('' XU , XL '',(1X,I2,2E12.5))')I,PROG(I),CST
        IF(ABS(PROG(I)-CST).GT.1.D-4) GO TO 1000
 1221 CONTINUE
      AAZER=MLREE3.PROG(N11)-MLREE1.PROG(N11)
      IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  VALEUR DE X EN SORTIE :'',/,
     *(1X,5E12.5))')(PROG(I),I=1,N),AAZER
*
*  SAUVEGARDE DE VX DANS VX0
      MLREEL=IVX0
      MLREE1=IVX
      SEGACT MLREEL*MOD,MLREE1*MOD
      DO 65 I=1,N
         PROG(I)=MLREE1.PROG(I)
   65 CONTINUE
      if(nsup.ne.0) then
      jg=mlree6.prog(/1)
      n=jg
      segini mlree5
      ia=0
      do iou=1,jg
      if(ibon(iou).eq.1) then
        ia=ia+1
        mlree5.prog(iou)=prog(ia)
       else
        mlree5.prog(iou)=mlree6.prog(iou)
       endif
       enddo
       ivx0=mlree5
       segsup mlreel
       mlreel=mlree5
       segsup ibo
       endif
*
      CALL VECTAB(IVX0,N,IRET)
      CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN,
     *                    'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
      CALL VECTAB(IVXPR1,N-nsup,IRET)
      CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN,
     *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
      CALL VECTAB(IVXPR2,N-nsup,IRET)
      CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN,
     *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
      CALL VECTAB(IVUL,N-nsup,IRET)
      CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN,
     *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
      CALL VECTAB(IVLL,N-nsup,IRET)
      CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN,
     *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
*
*

      CALL ECROBJ('TABLE   ',ITAB)
      MTABLE=ITAB
      SEGDES MTABLE
      MLREEL=IVX
      MLREE1=IVN
      MLREE2=IVD
      MLENTI=IVU
      SEGSUP MLREEL,MLREE1,MLREE2,MLENTI
      MLREEL = IVF
      MXMAT=MC
      MLREE1=IMC0
      SEGSUP MLREEL,MXMAT,MLREE1
      MLREEL=IVXMIN
      MLREE1=IVXMAX
      MLREE2=IVCMAX
      SEGSUP MLREEL,MLREE1,MLREE2
      MLREEL=IWD
      MLREE1=IVFP
      MLREE2=IVFQ
      SEGSUP MLREEL,MLREE1,MLREE2
      MXMAT=MCP
      MXMA1=MCQ
      SEGSUP MXMAT,MXMA1
      MLREEL=IVLAMB
      SEGSUP MLREEL
      MLENTI=ITI
      MLENT1=ITK
      SEGSUP MLENTI,MLENT1
      IF(NVD.NE.0) THEN
        MLENTI=IDVD
        MXMAT=MVD
        MXMA1=MVDU
        MXMA2=MVDL
        SEGSUP MLENTI,MXMAT,MXMA1,MXMA2
      ENDIF
      MXMAT=MP
      SEGSUP MXMAT
      MLREEL=IVXPR1
      MLREE1=IVXPR2
      SEGSUP MLREEL,MLREE1
      MLREEL=IVMIN
      MLREE1=IVMAX
      SEGSUP MLREEL,MLREE1
      MLREEL=IVXU
      MLREE1=IVXL
      MLREE2=IVMINU
      MLREE3=IVMINL
      SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
      MLREEL=IVMAXU
      MLREE1=IVMAXL
      MLREE2=IVB
      SEGSUP MLREEL,MLREE1,MLREE2
      MLREEL=IVUL
      MLREE1=IVLL
      MLREE2=IVX0U
      MLREE3=IVX0L
      SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
      MLREEL=MLAM1
      MLREE1=IVGE
      MLREE2=IVGM
      MLREE3=IVGP
      SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
      IF( IT0.NE.0) THEN
        MLREEL=IT0
        SEGSUP MLREEL
      ENDIF
      IF( IS0.NE.0) THEN
        MLREEL=IS0
        SEGSUP MLREEL
      ENDIF
      RETURN
 1000 CONTINUE
      CALL ERREUR(19)
      RETURN
      END