Télécharger la plaquette Cast3M


fr en

Télécharger excell.eso

Retour à la liste

Numérotation des lignes : 

excell

  1. C EXCELL    SOURCE    FD218221  24/02/21    21:15:03     11844          
  2.       SUBROUTINE EXCELL
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC CCREEL
  9. -INC TMXMAT
  10. -INC SMLREEL
  11. -INC SMLENTI
  12. -INC SMTABLE
  13.       segment ibo
  14.       integer  ibon(n)
  15.       endsegment
  16.       LOGICAL PDR,RSPB,RSPD,TEST,ILOG1,ILOG2,TERMIN
  17.       SEGMENT MBI
  18.         INTEGER MBID(NN)
  19.       ENDSEGMENT
  20.       SEGMENT RBI
  21.         REAL*8  RBID(NN)
  22.       ENDSEGMENT
  23.       LOGICAL LOGIN,LOGRE
  24.       CHARACTER*8 TYPOBJ
  25.       CHARACTER*1 CHARIN,CHARRE
  26.       CHARACTER*3 CMETH
  27.       POINTEUR MLREE4.MLREEL,mlent5.mlenti,mlree5.mlreel,mlree6.mlreel
  28.       DELTA0=50.D0
  29.       XSMAX=500.D0
  30.       IPASS=1
  31.       IPART=0
  32.       MAXITE=100
  33.       ITTER=0
  34.        ITISAV=0
  35.        ITKSAV=0
  36.        IVGP=0
  37.        IVGM=0
  38.        IVGE=0
  39.        IVLAMB=0
  40.        IVXU=0
  41.        IVXL=0
  42.        IVU=0
  43.        IVN=0
  44.        IVD=0
  45.        IS0=0
  46.        IT0=0
  47.        MLAM1=0
  48.        IVGP=0
  49.        IVGE=0
  50.        IVGM=0
  51.        IPBASP=0
  52. *
  53. *
  54. *TAB = EXCELL TAB ;
  55. *
  56. *
  57.       CALL LIROBJ('TABLE',ITAB,1,IRETOU)
  58.       IF(IERR.NE.0) RETURN
  59. *
  60. *
  61. *     TRANSFORMATION DES INFORMATIONS DES TABLES EN SEGMENT
  62. *
  63. *     REEL ( VECTEUR)   OU MXMAT  ( MATRICE) LES VALEURS .0
  64. *     SONT MISES DANS DES VARIABLES SEPAREES
  65. *
  66. *
  67. *   VARIABLES X INITIALES
  68.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES X'')')
  69.       TYPOBJ='TABLE'
  70.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN,
  71.      *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  72.       IF(IERR.NE.0) GO TO 1000
  73.       N=0
  74.       CALL TABVEC(ITABLE,IVX0,N)
  75.       IF(IERR.NE.0) RETURN
  76. *   DERIVEES DE F PAR RAPPORT A X. PUIS VALEUR DE F INITIALE
  77.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS VF'')')
  78.       TYPOBJ='TABLE'
  79.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VF',LOGIN,IOBIN,
  80.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  81.       IF(IERR.NE.0) GO TO 1000
  82.       CALL TABVEC(ITABLE,IVF,N)
  83.       IF(IERR.NE.0) RETURN
  84.       TYPOBJ='FLOTTANT'
  85.       I = 0
  86.       CALL ACCTAB(ITABLE,'ENTIER  ',I,XVALIN,CHARIN,LOGIN,IOBIN,
  87.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  88. *
  89. ** verification que pas de derivée nulle
  90. *
  91.       mlree5=ivf
  92.       segact mlree5
  93.       segini ibo
  94.        nsup=0
  95.        xgr= 0.
  96.        do iou=1,n
  97.         if( abs(mlree5.prog(iou)).gt.xgr) xgr = abs(mlree5.prog(iou))
  98.        enddo
  99.        epscri= xgr * 1.e-30
  100.        do iou=1,n
  101.        if( abs(mlree5.prog(iou)).gt.0.d0) then
  102.         ibon(iou)=1
  103.        else
  104.         ibon(iou)=0
  105. * on debranche pour l'instant car pose probleme pour les reprises
  106. *        nsup=nsup+1
  107.        endif
  108.        enddo
  109. * elimination des pas bonnes et recopie des anciennes dans mlree6
  110.        if(nsup.ne.0)then
  111.         jg=n
  112.         mlree5=ivx0
  113.         mlree4=ivf
  114.         segact mlree5,mlree4
  115.         segini mlree6
  116.         jg= n - nsup
  117.         segini mlreel,mlree2
  118.         ia = 0
  119.         do iou=1,n
  120.          mlree6.prog(iou)=mlree5.prog(iou)
  121.          if( ibon(iou).eq.1) then
  122.            ia = ia + 1
  123.            prog(ia)=mlree5.prog(iou)
  124.            mlree2.prog(ia)=mlree4.prog(iou)
  125.          endif
  126.         enddo
  127.         ivx0=mlreel
  128.         ivf=mlree2
  129.         segdes mlree5,mlree4
  130.         nvr = n - nsup
  131.         write(6,*) ' nombre de variables non prises en compte ' , nsup
  132.        endif
  133.       IF(IERR.NE.0) GO TO 1000
  134.       VF0=XVALRE
  135. * DERIVEES DES CJ PAR RAPPORT A X LE CJ0 SONT EN INDICE 0 ET SONT
  136. * RECUPERES JUSTE APRES
  137.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS MC'')')
  138.       TYPOBJ='TABLE'
  139.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'MC',LOGIN,IOBIN,
  140.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  141.       IF(IERR.NE.0) GO TO 1000
  142.       M = 0
  143.       if (iimpi.eq.1799) write (6,*) ' appel a tabmat(ITABLE,MC,M,N)'
  144.       CALL TABMAT(ITABLE,MC,M,N)
  145.       IF(IERR.NE.0) RETURN
  146.       MXMAT=MC
  147.       SEGACT MXMAT*MOD
  148.       if(nsup.ne.0) then
  149.         ldim2 = nvr
  150.         ldim1=xmat(/1)
  151.         segini mxma1
  152.         do iou=1,ldim1
  153.          ia = 0
  154.          do iyo=1,n
  155.           if(ibon(iyo).eq.1) then
  156.            ia=ia+1
  157.            mxma1.xmat(iou,ia)=xmat(iou,iyo)
  158.            endif
  159.           enddo
  160.          enddo
  161.          segsup mxmat
  162.          mxmat=mxma1
  163.          mc=mxmat
  164.          if( iimpi.eq.1799) then
  165.           write(6,*) ' pointeur de mc ldim1 ldim2 ',mc,xmat(/1),xmat(/2)
  166.           write(6,*) ' mc' , ( xmat(1,iou),iou=1,xmat(/2))
  167.          endif
  168.        endif
  169.       JG=XMAT(/1)
  170.       SEGINI MLREEL
  171.       IMC0=MLREEL
  172.       DO 1 J=1,JG
  173.          TYPOBJ=' '
  174.          CALL ACCTAB(ITABLE,'ENTIER  ',J,XVALIN,CHARIN,LOGIN,IOBIN,
  175.      *                      TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBR)
  176.          IF(TYPOBJ.NE.'TABLE   ') GO TO 1
  177.          I= 0
  178.          TYPOBJ='FLOTTANT'
  179.          CALL ACCTAB(IOBR,'ENTIER  ',I,XVALIN,CHARIN,LOGIN,IOBIN,
  180.      *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  181.          PROG(J)=XVALRE
  182.    1  CONTINUE
  183.       SEGDES MLREEL
  184. * VALEURS MINIMALES DES VARIABLES X
  185.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS MINI DE X '')')
  186.       TYPOBJ='TABLE'
  187.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXMIN',LOGIN,IOBIN,
  188.      *                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  189.       IF(IERR.NE.0) GO TO 1000
  190.       CALL TABVEC(ITABLE,IVXMIN,N)
  191.       if(nsup.ne.0) then
  192.         mlree4=ivxmin
  193.         segact mlree4
  194.         jg=nvr
  195.         segini mlree5
  196.         ia=0
  197.         do iou=1,n
  198.          if(ibon(iou).eq.1) then
  199.           ia=ia+1
  200.           mlree5.prog(ia)=mlree4.prog(iou)
  201.          endif
  202.         enddo
  203.         segsup mlree4
  204.         ivxmin=mlree5
  205.       endif
  206.       IF(IERR.NE.0) RETURN
  207. * VALEURS MAXIMALES DES VARIABLES X
  208.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS MAXI DE X '')')
  209.       TYPOBJ='TABLE'
  210.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXMAX',LOGIN,IOBIN,
  211.      *                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  212.       IF(IERR.NE.0) GO TO 1000
  213.       CALL TABVEC(ITABLE,IVXMAX,N)
  214.       if(nsup.ne.0) then
  215.         mlree4=ivxmax
  216.         segact mlree4
  217.         jg=nvr
  218.         segini mlree5
  219.         ia=0
  220.         do iou=1,n
  221.          if(ibon(iou).eq.1) then
  222.           ia=ia+1
  223.           mlree5.prog(ia)=mlree4.prog(iou)
  224.          endif
  225.         enddo
  226.         segsup mlree4
  227.         ivxmax=mlree5
  228.       endif
  229.       IF(IERR.NE.0) RETURN
  230. * VALEURS MAXIMALES DES CONTRAINTES CJ
  231.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''VALEURS MAXI DE CJ '')')
  232.       TYPOBJ='TABLE'
  233.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VCMAX',LOGIN,IOBIN,
  234.      *                     TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  235.       IF(IERR.NE.0) GO TO 1000
  236.       CALL TABVEC(ITABLE,IVCMAX,M)
  237.       IF(IERR.NE.0) RETURN
  238. * VALEURS DES VARIABLES DISCRETES
  239.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS DE MVD '')')
  240.       TYPOBJ='        '
  241.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VDIS',LOGIN,IOBIN,
  242.      *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  243.       NVD=0
  244.       NNVD=0
  245.       IF( ITABLE.NE.0) CALL TABMAT(ITABLE,MVD,NVD,NNVD)
  246.       IF(IERR.NE.0) RETURN
  247.       IF(NVD.NE.0)THEN
  248.           MXMAT=MVD
  249.       if(nsup.ne.0) then
  250.         ldim2 = nvr
  251.         ldim1=xmat(/1)
  252.         segini mxma1
  253.         do iou=1,ldim1
  254.          ia = 0
  255.          do iyo=1,n
  256.           if(ibon(iyo).eq.1) then
  257.            ia=ia+1
  258.            mxma1.xmat(iou,ia)=xmat(iou,iyo)
  259.            endif
  260.           enddo
  261.          enddo
  262.          segsup mxmat
  263.          mxmat=mxma1
  264.          mvd=mxmat
  265.        endif
  266.       ENDIF
  267. * ITERATION IP
  268.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''VALEUR DE IP '')')
  269.       TYPOBJ='      '
  270.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'IP',LOGIN,IOBIN,
  271.      *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  272.       IF(TYPOBJ.EQ.'ENTIER  ') THEN
  273.           IP=IVALRE
  274.       ELSE
  275.           IP=1
  276.       ENDIF
  277. * valeur de delta0
  278.       TYPOBJ='      '
  279.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'DELTA0',LOGIN,IOBIN,
  280.      *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  281.       IF(TYPOBJ.EQ.'ENTIER  ') THEN
  282.           DELTA0=IVALRE
  283.       ENDIF
  284.       IF(TYPOBJ.EQ.'FLOTTANT') THEN
  285.           DELTA0=XVALRE
  286.       ENDIF
  287. * valeur de xsmax
  288.       TYPOBJ='      '
  289.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'XSMAX',LOGIN,IOBIN,
  290.      *                    TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  291.       IF(TYPOBJ.EQ.'ENTIER  ') THEN
  292.           XSMAX=IVALRE
  293.       ENDIF
  294.       IF(TYPOBJ.EQ.'FLOTTANT') THEN
  295.           XSMAX=XVALRE
  296.       ENDIF
  297. * valeur de maxite
  298.       TYPOBJ='      '
  299.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'MAXITERATION',LOGIN,
  300.      *  IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  301.       IF(TYPOBJ.EQ.'ENTIER  ') THEN
  302.           MAXITE=IVALRE
  303.       ENDIF
  304. * LECTURE DE L'OPTION CHOISIE
  305.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' OPTION CHOISIE '')')
  306.       TYPOBJ='        '
  307.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'METHODE',LOGIN,IOBIN,
  308.      *                     TYPOBJ,IVALRE,XVALRE,CMETH,LOGRE,ITABLE)
  309.       IMETH=1
  310.       IF(TYPOBJ.EQ.'MOT        ') THEN
  311.         IF(CMETH.EQ.'MOV') IMETH=2
  312.       IF(CMETH.EQ.'LIN') IMETH=3
  313.        ENDIF
  314. *
  315. * POINTS PRECEDENTS
  316. * LIMITES PRECEDENTES
  317.       IF(IP.EQ.1) THEN
  318.           JG=N+1
  319.           SEGINI MLREEL,MLREE1
  320.           IVXPR1=MLREEL
  321.           IVXPR2=MLREE1
  322.           SEGINI MLREE2,MLREE3
  323.           IVLL=MLREE2
  324.           IVUL=MLREE3
  325.       ELSE
  326.           IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES XP1'')')
  327.           TYPOBJ='TABLE'
  328.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN,
  329.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  330.           IF(IERR.NE.0) GO TO 1000
  331.           CALL TABVEC(ITABLE,IVXPR1,N)
  332.           IF(IERR.NE.0) RETURN
  333.           IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES XP2'')')
  334.           TYPOBJ='TABLE'
  335.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN,
  336.      *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  337.           IF(IERR.NE.0) GO TO 1000
  338.           CALL TABVEC(ITABLE,IVXPR2,N)
  339.           IF(IERR.NE.0) RETURN
  340.           IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES VUL '')')
  341.           TYPOBJ='TABLE'
  342.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN,
  343.      *                   TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  344.           IF(IERR.NE.0) GO TO 1000
  345.           CALL TABVEC(ITABLE,IVUL,N)
  346.           IF(IERR.NE.0) RETURN
  347.           JG=N+1
  348.           MLREEL=IVUL
  349.           SEGADJ MLREEL
  350.           IF(IERR.NE.0) RETURN
  351.           IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES VLL '')')
  352.           TYPOBJ='TABLE'
  353.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN,
  354.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  355.           IF(IERR.NE.0) GO TO 1000
  356.           CALL TABVEC(ITABLE,IVLL,N)
  357.           IF(IERR.NE.0) RETURN
  358.           JG=N+1
  359.           MLREEL=IVLL
  360.           SEGADJ MLREEL
  361.       ENDIF
  362. *
  363. *   VERIFICATION DU POINT DE DEPART
  364. *
  365.       MLREEL=IVX0
  366.       MLREE1=IVXMAX
  367.       MLREE2=IVXMIN
  368.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  369.       JG=PROG(/1)
  370.       N=jg
  371.       DO 64 I=1,JG
  372.       PROD=(MLREE1.PROG(I)-PROG(I))*(MLREE2.PROG(I)-PROG(I))
  373.       aux=1d0+abs(MLREE2.PROG(I))+abs(MLREE1.PROG(I))
  374.       prod=prod/aux
  375.       IF(PROD.GT.1D-4) THEN
  376.            WRITE(6,63)
  377.            WRITE(6,'(''!!LE POINT DE DEPART EST HORS-DOMAINE!!!'')')
  378.            WRITE(6,63)
  379.    63 FORMAT('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!')
  380.            GOTO 1000
  381.       ENDIF
  382.    64 CONTINUE
  383. *
  384. * calcu des Dj qui permettent de respecter les contraintes
  385. * en supposant que variable de relaxation egale DELTA0
  386. *
  387.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''  VALEURS DE WD '')')
  388.       MLREEL=IVCMAX
  389.       MLREE1=IMC0
  390.       SEGACT MLREEL*MOD,MLREE1*MOD
  391.       JG=M
  392.       SEGINI MLREE2
  393.       IWD=MLREE2
  394.       DO 17 K=1,M
  395.         Z=MLREE1.PROG(K)-PROG(K)
  396.        IF(Z.GT.1.D-20) THEN
  397.           MLREE2.PROG(K)=Z/(1.-1./DELTA0)
  398.        IF(IIMPI.GT.0)
  399.      * WRITE(IOIMP,FMT='('' contrainte '',i3,'' pas satisfaite'')')K
  400.         ELSE
  401.           MLREE2.PROG(K)=0.D0
  402.         ENDIF
  403.    17 CONTINUE
  404. *
  405. *   introduction de la variable  de relaxation
  406. *
  407.       N11 = N + 1
  408. * dans X0
  409.       MLREEL = IVX0
  410.       SEGACT MLREEL*MOD
  411.       JG=PROG(/1) + 1
  412.       IF(JG.NE.N11) GO TO 1000
  413.       SEGADJ MLREEL
  414.       PROG(JG)=DELTA0
  415.       SEGDES MLREEL
  416. * dans Xmin
  417.       MLREEL=IVXMIN
  418.       SEGACT MLREEL*MOD
  419.       JG=PROG(/1) + 1
  420.       IF(JG.NE.N11) GO TO 1000
  421.       SEGADJ MLREEL
  422.       PROG(JG)=1.D0
  423.       SEGDES MLREEL
  424. * dans Xmax
  425.       MLREEL=IVXMAX
  426.       SEGACT MLREEL*MOD
  427.       JG=PROG(/1) + 1
  428.       IF(JG.NE.N11) GO TO 1000
  429.       SEGADJ MLREEL
  430.       PROG(JG)=XSMAX
  431.       SEGDES MLREEL
  432. * dans les derivees de F
  433.       MLREEL=IVF
  434.       SEGACT MLREEL*MOD
  435.       JG=PROG(/1) + 1
  436.       IF(JG.NE.N11) GO TO 1000
  437.       SEGADJ MLREEL
  438.       PROG(JG)=2. ** IP  * (ABS(VF0))
  439.       SEGDES MLREEL
  440. * dans f(x0) contenu dans la variable VF0
  441.       VF0 = VF0 + 2. ** IP * (ABS( VF0)) * DELTA0
  442. * dans les derivees de CJ
  443.       MXMAT=MC
  444.       MLREEL=IWD
  445.       SEGACT MLREEL*MOD,MXMAT*MOD
  446.       LDIM2=XMAT(/2)+1
  447.       LDIM1=XMAT(/1)
  448.       if( iimpi.eq.1799) then
  449.         write(6,*) ' mc pointeur ' , mc
  450.         write(6,*) ' ldim1  ldim2  apres var relax',ldim1,ldim2
  451.       endif
  452.       SEGADJ MXMAT
  453.       DELT=-1. / ( DELTA0 * DELTA0)
  454.       DO 702 I=1,XMAT(/1)
  455.       XMAT(I,LDIM2)=PROG(I)* DELT
  456.   702 CONTINUE
  457.       SEGDES MLREEL,MXMAT
  458. * dans Cjmax
  459.       MLREEL=IVCMAX
  460.       MLREE1=IWD
  461.       SEGACT MLREEL*MOD,MLREE1*MOD
  462.       DO 703 I=1,PROG(/1)
  463.       PROG(I)=PROG(I) + MLREE1.PROG(I)
  464.   703 CONTINUE
  465.       SEGDES MLREEL,MLREE1
  466. *  dans cj0
  467.       MLREEL=IMC0
  468.       MLREE1=IWD
  469.       SEGACT MLREEL*MOD,MLREE1*MOD
  470.       DO 707 I=1,PROG(/1)
  471.       PROG(I)=PROG(I) - MLREE1.PROG(I)/DELTA0
  472.   707 CONTINUE
  473.       SEGDES MLREEL,MLREE1
  474. *
  475.          TYPOBJ=' '
  476.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'PREC',LOGIN,IOBIN,
  477.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  478.  
  479.            IF(TYPOBJ.EQ.'FLOTTANT') THEN
  480.                XPREC=XVALRE
  481.            ELSEIF(TYPOBJ.EQ.'ENTIER  ') THEN
  482.                XPREC=IVALRE
  483.            ELSE
  484.                XPREC=500d0
  485.            ENDIF
  486. *
  487. *   INTRODUCTION DES MOVE-LIMITS
  488. *
  489.       IF (IMETH.EQ.1) THEN
  490.          TYPOBJ=' '
  491.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'T0',LOGIN,IOBIN,
  492.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  493.          IF(TYPOBJ.EQ.'TABLE   ') THEN
  494.             CALL TABVEC(ITABLE,IT0,N11)
  495.             IF(IERR.NE.0) RETURN
  496.          ELSE
  497.            IF(TYPOBJ.EQ.'FLOTTANT') THEN
  498.               XT0=XVALRE
  499.            ELSEIF(TYPOBJ.EQ.'ENTIER  ') THEN
  500.               XT0=IVALRE
  501.            ELSE
  502.               XT0=0.333333d0
  503.            ENDIF
  504.            JG=N11
  505.            SEGINI MLREEL
  506.            IT0=MLREEL
  507.            DO 704 I=1,JG
  508.              PROG(I)=XT0
  509.   704       CONTINUE
  510.          ENDIF
  511.       ENDIF
  512.       IF (IMETH.EQ.2) THEN
  513.          TYPOBJ='        '
  514.       CALL ACCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'S0',LOGIN,IOBIN,
  515.      *                  TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE)
  516.          IF(TYPOBJ.EQ.'TABLE') THEN
  517.             CALL TABVEC(ITABLE,IS0,N11)
  518.             IF(IERR.NE.0) RETURN
  519.          ELSE
  520.            IF(TYPOBJ.EQ.'FLOTTANT') THEN
  521.               XS0=XVALRE
  522.            ELSEIF(TYPOBJ.EQ.'ENTIER  ') THEN
  523.               XS0=IVALRE
  524.            ELSE
  525.               XS0=0.7d0
  526.            ENDIF
  527.             JG=N11
  528.             SEGINI MLREEL
  529.             IS0=MLREEL
  530.             DO 705 I=1,JG
  531.              PROG(I)=XS0
  532.   705          CONTINUE
  533.          ENDIF
  534.        ENDIF
  535.  
  536.          CALL CHGLIM(IVX0,IVXMIN,IVXMAX,IVXPR1,IVXPR2,N11,IP,
  537.      *             IVLL,IVUL,IVMIN,IVMAX,IMETH,IT0,IS0,XSMAX)
  538. *
  539. * SAUVEGARDE DES DERNIERES VALEURS DE VX0
  540. *
  541.       MLREEL=IVX0
  542.       MLREE1=IVXPR1
  543.       MLREE2=IVXPR2
  544.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  545.       DO 51 I=1,N
  546.          MLREE2.PROG(I)=MLREE1.PROG(I)
  547.          MLREE1.PROG(I)=PROG(I)
  548.    51 CONTINUE
  549. *
  550. *  MODIFICATION DE LA VALEUR DE X
  551. *
  552.       MLREEL=IVX0
  553.       MLREE1=IVUL
  554.       MLREE2=IVLL
  555.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  556.       JG=PROG(/1)
  557.       SEGINI MLREE3,MLREE4
  558.       IVX0U=MLREE3
  559.       IVX0L=MLREE4
  560.       DO 52 I=1,JG
  561.          MLREE3.PROG(I)=MLREE1.PROG(I)-PROG(I)
  562.          MLREE4.PROG(I)=PROG(I)-MLREE2.PROG(I)
  563.    52 CONTINUE
  564.       IF(IIMPI.EQ.1799) WRITE(IOIMP,57)(MLREE3.PROG(K),K=1,N11)
  565.    57 FORMAT(' VALEUR DE DEPART EN VX0U : ',/,(1X,5E12.5))
  566.       IF(IIMPI.EQ.1799) WRITE(IOIMP,58)(MLREE4.PROG(K),K=1,N11)
  567.    58 FORMAT(' VALEUR DE DEPART EN VX0L : ',/,(1X,5E12.5))
  568. *
  569. *  LINEARISATIONS CONVEXE DE F
  570. *
  571.       MLREEL=IVF
  572.       MLREE1=IVX0U
  573.       MLREE2=IVX0L
  574.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  575.       JG = PROG(/1)
  576.       SEGINI,MLREE3
  577.       IVFP=MLREE3
  578.       SEGINI,MLREE4
  579.       IVFQ=MLREE4
  580.       DO 3 I=1,JG
  581.       IF(PROG(I).GT.0.D0) THEN
  582.            MLREE3.PROG(I)=PROG(I)*(MLREE1.PROG(I)**2)
  583.       ELSE
  584.            MLREE4.PROG(I)=ABS(PROG(I))*(MLREE2.PROG(I)**2)
  585.       ENDIF
  586.    3  CONTINUE
  587.       IF(IIMPI.EQ.1799) WRITE(IOIMP,4)(MLREE3.PROG(K),K=1,N11)
  588.    4  FORMAT('  SENSIBILITES TYPE + DE F LINEARISEE : ',/,(1X,5E12.5))
  589.       IF(IIMPI.EQ.1799) WRITE(IOIMP,41)(MLREE4.PROG(K),K=1,N11)
  590.   41  FORMAT('  SENSIBILITES TYPE - DE F LINEARISEE : ',/,(1X,5E12.5))
  591.       DO 53 I=1,N11
  592.          VF0=VF0-(MLREE3.PROG(I)/MLREE1.PROG(I))
  593.          VF0=VF0-(MLREE4.PROG(I)/MLREE2.PROG(I))
  594.   53  CONTINUE
  595. *
  596. *  LINEARISATION CONVEXE DES CONTRAINTE CJ
  597. *
  598.       MXMAT=MC
  599.       SEGACT MXMAT*MOD
  600.       LDIM1=XMAT(/1)
  601.       LDIM2=XMAT(/2)
  602.       if(iimpi.eq.1799) then
  603.       write(6,*) ' xmat de mc' , (xmat(1,iou),iou=1,xmat(/2))
  604.       endif
  605.       IF(LDIM2.NE.N11) GO TO 1000
  606.       SEGINI MXMA1
  607.       MCP=MXMA1
  608.       SEGINI MXMA2
  609.       MCQ=MXMA2
  610.       MLREE1=IVX0U
  611.       MLREE3=IVX0L
  612.       MLREEL=IVCMAX
  613.       MLREE2=IMC0
  614.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD
  615.       JG=LDIM1
  616.       SEGINI MLREE4
  617.       IVB=MLREE4
  618.       DO 5 I=1,LDIM1
  619.       MLREE4.PROG(I)=PROG(I)-MLREE2.PROG(I)
  620.       TIN=0.
  621.       DO 7 J=1,N11
  622.       IF(XMAT(I,J).GT.0.D0) THEN
  623.          MXMA1.XMAT(I,J)=XMAT(I,J)*(MLREE1.PROG(J)**2)
  624.       ELSE
  625.          MXMA2.XMAT(I,J)=ABS(XMAT(I,J))*(MLREE3.PROG(J)**2)
  626.       ENDIF
  627.       TIN=TIN+(MXMA1.XMAT(I,J)/MLREE1.PROG(J))
  628.       TIN=TIN+(MXMA2.XMAT(I,J)/MLREE3.PROG(J))
  629.    7  CONTINUE
  630.       MLREE4.PROG(I)=MLREE4.PROG(I)+TIN
  631.    5  CONTINUE
  632.       IF(IIMPI.EQ.1799) WRITE(IOIMP,6)(MLREE4.PROG(I),I=1,M)
  633.       MLREEL=IWD
  634.       MLREE1=IVB
  635.       SEGACT MLREEL*MOD,MLREE1*MOD
  636.       JG=PROG(/1)
  637.       DO 56 I=1,JG
  638.       IF(IIMPI.EQ.1799) WRITE(IOIMP,8)I,(MXMA1.XMAT(I,K),K=1,N11)
  639.   8   FORMAT('  SENSIBILITES TYPE + DE C',I3,' LINEARISEE : ',
  640.      *  /,(1X,5E12.5))
  641.       IF(IIMPI.EQ.1799) WRITE(IOIMP,9)I,(MXMA2.XMAT(I,K),K=1,N11)
  642.   9   FORMAT('  SENSIBILITES TYPE - DE C',I3,' LINEARISEE : ',
  643.      *  /,(1X,5E12.5))
  644.   56  CONTINUE
  645.       IF(IIMPI.EQ.1799) WRITE(IOIMP,6)(MLREE1.PROG(I),I=1,M)
  646.   6   FORMAT(' VALEURS DE IVB LINEARISEE : ',(1X,5E12.5))
  647. *
  648. *  CHANGEMENT DE VARIABLES DE XMAX
  649. *
  650.       MLREEL=IVUL
  651.       MLREE1=IVLL
  652.       MLREE2=IVMAX
  653.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  654.       JG=PROG(/1)
  655.       SEGINI MLREE3,MLREE4
  656.       IVMAXU=MLREE3
  657.       IVMAXL=MLREE4
  658.       DO 10 I=1,JG
  659.         MLREE3.PROG(I)=PROG(I)-MLREE2.PROG(I)
  660.         MLREE4.PROG(I)=MLREE2.PROG(I)-MLREE1.PROG(I)
  661.    10 CONTINUE
  662.       IF(IIMPI.EQ.1799) WRITE(IOIMP,11)(MLREE3.PROG(K),K=1,N11)
  663.    11 FORMAT('  BORNES MAXIMA EN U ',/,(1X,5E12.5))
  664.       IF(IIMPI.EQ.1799) WRITE(IOIMP,12)(MLREE4.PROG(K),K=1,N11)
  665.    12 FORMAT('  BORNES MAXIMA EN L ',/,(1X,5E12.5))
  666. *
  667. *  CHANGEMENT DE VARIABLES DE XMIN
  668. *
  669.       MLREEL=IVUL
  670.       MLREE1=IVLL
  671.       MLREE2=IVMIN
  672.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD
  673.       JG=PROG(/1)
  674.       SEGINI MLREE3,MLREE4
  675.       IVMINU=MLREE3
  676.       IVMINL=MLREE4
  677.       DO 54 I=1,JG
  678.         MLREE3.PROG(I)=PROG(I)-MLREE2.PROG(I)
  679.         MLREE4.PROG(I)=MLREE2.PROG(I)-MLREE1.PROG(I)
  680.    54 CONTINUE
  681.       IF(IIMPI.EQ.1799) WRITE(IOIMP,14)(MLREE3.PROG(K),K=1,N11)
  682.    14 FORMAT('  BORNES MINIMA EN U ',/,(1X,5E12.5))
  683.       IF(IIMPI.EQ.1799) WRITE(IOIMP,15)(MLREE4.PROG(K),K=1,N11)
  684.    15 FORMAT('  BORNES MINIMA EN L ',/,(1X,5E12.5))
  685. *
  686. *  NORMALISATION DES VARIABLES DISCRETES
  687. *
  688.       IF(NVD.NE.0) THEN
  689.          MXMAT=MVD
  690.          SEGACT MXMAT*MOD
  691.          NDIS=XMAT(/2)
  692.          LDIM1=XMAT(/1)
  693.          LDIM2=NDIS+2
  694.          SEGINI MXMA1
  695.          NMVD=MXMA1
  696.          DO 19 I=1,NVD
  697.             DO 19 J=2,NDIS+1
  698.               MXMA1.XMAT(I,J)=XMAT(I,J-1)
  699.    19    CONTINUE
  700.          MLREEL=IVUL
  701.          MLREE1=IVLL
  702.          SEGACT MLREEL*MOD,MLREE1*MOD
  703.          JG=LDIM1
  704.          SEGINI MLENTI
  705.          IDVD=MLENTI
  706.          MVD=NMVD
  707.          MXMAT=MVD
  708.          SEGACT MXMAT*MOD
  709.          LDIM1=XMAT(/1)
  710.          LDIM2=XMAT(/2)
  711.          SEGINI MXMA1,MXMA2
  712.          MVDU=MXMA1
  713.          MVDL=MXMA2
  714.          DO 18 I=1,NVD
  715.            DO 13 J=2,NDIS+2
  716.              MXMA1.XMAT(I,J)=PROG(I)-XMAT(I,J)
  717.              MXMA2.XMAT(I,J)=XMAT(I,J)-MLREE1.PROG(I)
  718.              IF(XMAT(I,J).LT.1.D-20) THEN
  719.                LECT(I)=J-1
  720.                XMAT(I,J)=XGRAND
  721.                MXMA1.XMAT(I,J)=XGRAND
  722.                MXMA2.XMAT(I,J)=XGRAND
  723.                GO TO 18
  724.              ENDIF
  725.    13      CONTINUE
  726.    18    CONTINUE
  727. *
  728.          IF(IIMPI.EQ.1799)THEN
  729.             WRITE(IOIMP,'('' NOUVELLE MATRICE MVDU'')')
  730.             DO 20 I=1,LDIM1
  731.                WRITE(IOIMP,'('' LIGNE  '',I2)')I
  732.                DO 20 J=1,LDIM2
  733.                   WRITE(IOIMP,'(E12.5)')MXMA1.XMAT(I,J)
  734.    20       CONTINUE
  735.          ENDIF
  736.          IF(IIMPI.EQ.1799)THEN
  737.             WRITE(IOIMP,'('' NOUVELLE MATRICE MVDL'')')
  738.             DO 55 I=1,LDIM1
  739.                WRITE(IOIMP,'('' LIGNE  '',I2)')I
  740.                DO 55 J=1,LDIM2
  741.                   WRITE(IOIMP,'(E12.5)')MXMA2.XMAT(I,J)
  742.    55       CONTINUE
  743.          ENDIF
  744.       ENDIF
  745. *
  746. *    INITIALISATION DE L ALGORITHME
  747. *
  748.       JG=M
  749.       SEGINI MLREEL
  750.       IVLAMB=MLREEL
  751.       DO 16 I=1,JG
  752.          PROG(I)=1.D0
  753.   16  CONTINUE
  754. *
  755. *       INITIALISATION DES PARAMETRES DE CONTROLES
  756. *
  757.       TERMIN=.FALSE.
  758.       PDR=.FALSE.
  759.       RSPB=.FALSE.
  760.       RSPD=.FALSE.
  761.       NDR=0
  762.       EPSILO=0.001
  763.       JG=0
  764.       SEGINI MLENT1,MLENT2
  765.       ITI=MLENT1
  766.       ITK=MLENT2
  767.       JG=M
  768.       SEGINI MLENTI
  769.       MDR=MLENTI
  770.       NDP=1
  771.       XL=0.
  772.       NPDR=0
  773.       XLL=0.
  774.       LDIM1=M
  775.       LDIM2=M
  776.       SEGINI MXMAT
  777.       MP=MXMAT
  778. *
  779. *
  780. *  DEBUT DE TOURNER EN ROND
  781. *
  782. *
  783.       IT=0
  784.       JG= M
  785.       SEGINI MLENTI
  786.       IPBASE=MLENTI
  787.   101 CONTINUE
  788.       IF(IIMPI.EQ.1799)
  789.      *WRITE(IOIMP,FMT='('' ETAPE1: CALCUL DE X LAMBDA '')')
  790.       CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
  791.      *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  792.   102 CONTINUE
  793.       IF(IT.EQ.0) THEN
  794.       MLREEL=IVXU
  795.       MLREE3=IVXL
  796.       MLREE1=IVN
  797.       MLREE2=IVD
  798.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD
  799.       ENDIF
  800.       IF(IIMPI.EQ.1799)
  801.      *WRITE(IOIMP,FMT='('' ETAPE2:CALCUL DE LA DIRECTION DE MONTEE'')')
  802.       IF(IT.GT.0 ) THEN
  803.          IVZZ=IVGE
  804.       ENDIF
  805.       CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
  806.       IVDR=IVGM
  807.       IF(IT.EQ.0) THEN
  808.        MLREEL=IVGM
  809.        SEGACT MLREEL*MOD
  810.       IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M)
  811.       IF(IIMPI.EQ.1799) WRITE(IOIMP,10014) (PROG(I),I=1,M)
  812. 10014  FORMAT(' VALEUR DE GRAD ',/ ,(1X,5(E12.5)))
  813.       ENDIF
  814. *       ON CONTINUE OBLIGATOIREMENT EN NDP=3
  815.   103 CONTINUE
  816.       IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M)
  817.       ITTER=ITTER+1
  818.       MLREEL=IVDR
  819.       MLENTI=MDR
  820.       DO 1020 I=1,M
  821.         IF(LECT(I).EQ.1) PROG(I)=0.D0
  822.  1020 CONTINUE
  823.       IF(ITTER.GT.MAXITE) THEN
  824.         INTERR(1)=MAXITE
  825.         CALL ERREUR(602)
  826.         GO TO 116
  827.       ENDIF
  828.       IF(IIMPI.EQ.1799)
  829.      *WRITE(IOIMP,FMT='('' ETAPE3:TEST NORME DIRECTION DE RECHERCHE'')')
  830.       CALL ETAPE3(PROG,M,XNORZ)
  831.       IF(IIMPI.NE.0) WRITE(6,1564) ITTER,XNORZ
  832.  1564 FORMAT(' iteration ', I5,' critere : ',E12.5)
  833. *****   TEST BIDON POUR CREER UN GO TO EN 104|||
  834.       IF(IOIMP.EQ.-598) GO TO 104
  835.       IF(ITTER.EQ.1) THEN
  836.                EPSILO= XNORZ / XPREC
  837. c               WRITE(IOIMP,FMT='('' valeur du test de convergence''
  838. c     $  ,2e12.5 )') EPSILO,XPREC
  839.       ENDIF
  840.       IF( XNORZ.LE.EPSILO.AND.IPART.NE.1) THEN
  841.           GO TO 116
  842.       ELSE
  843.           IPART=0
  844.           GO TO 106
  845.       ENDIF
  846.  104  CONTINUE
  847.       IF(IIMPI.EQ.1799)
  848.      *WRITE(IOIMP,FMT='('' ETAPE4: CALCUL DU HESSIEN'')')
  849.       IF ( IT .GT.0) THEN
  850.          CALL ETAPE4(MCP,MCQ,M,N,IVU,IVXU,IVN,MH)
  851.          CALL TXAY(IVZZ,MH,IVZZ,M,M,XRES)
  852.          IF(XRES.EQ.0.D0) THEN
  853.             IF(IIMPI.GT.1)
  854.      *WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')')
  855.             GO TO 106
  856.          ELSE
  857.             IF(IIMPI.EQ.1799)
  858.      * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES POSSIBLE'')')
  859.             GO TO 105
  860.          ENDIF
  861.       ELSE
  862.             IF(IIMPI.GT.1)
  863.      * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')')
  864.          GO TO 106
  865.       ENDIF
  866.  105  CONTINUE
  867.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT=
  868.      *'('' ETAPE5 CONJUGAISON DES DIRECTIONS DE RECHERCHE'' )')
  869.       CALL ETAPE5(IVZ,IVZZ,MH,M)
  870. * ON VA OBLIGATOIREMENT EN NDP=6
  871.   106 CONTINUE
  872.       IF(IIMPI.EQ.1799)  WRITE(IOIMP,FMT='(
  873.      *'' ETAP6 RECHERCHE LINEAIRE SUIVANT LA DIRECTION DE RECHERCHE'')')
  874.       CALL NTAPE6(MCP,MCQ,IVMINU,IVMINL,IVMAXU,IVMAXL,IVLAMB,
  875.      * M,N,NVD,IVFP,IVFQ,MVDU,MVDL,IVB,IVD,IVN,II,KK,IVDR,IDVD,
  876.      * NDR,TERMIN,IVLL,IVUL,IPBASE)
  877.       IF(TERMIN)THEN
  878.          ITI=ITISAV
  879.          ITK=ITKSAV
  880.          NPDR=NPDRSV
  881.          GO TO 121
  882.       ENDIF
  883.       IF(II.GT.0) THEN
  884.           IF(KK.EQ.-3) THEN
  885.           MLENTI=IPBASE
  886.            SEGACT MLENTI*MOD
  887.            LECT(II)=1
  888.            SEGDES MLENTI
  889.       ENDIF
  890.       ENDIF
  891.       CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
  892.      *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  893.       CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
  894.       MLREEL=IVLAMB
  895.       SEGACT MLREEL*MOD
  896.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT=
  897.      *'(''  LAMBDA OPTIMAL '',/,(1X,5E12.5))')(PROG(I),I=1,M)
  898.       MLREEL=IVGM
  899.       SEGACT MLREEL*MOD
  900.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  901.      *('' VALEUR DU GRADIENT MODIF SORTIE ETAPE6 : '',/,(1X,5E12.5))')
  902.      *(PROG(I),I=1,M)
  903.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE II ETAPE6
  904.      *: '',/,(1X,I2))')II
  905.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE KK ETAPE6
  906.      *: '',/,(1X,I2))')KK
  907.       MLREEL=IVXU
  908.       SEGACT MLREEL*MOD
  909.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXU : ''
  910.      *,/,(1X,5E12.5))')(PROG(I),I=1,N11)
  911.       MLREEL=IVXL
  912.       SEGACT MLREEL*MOD
  913.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXL : ''
  914.      *,/,(1X,5E12.5))')(PROG(I),I=1,N11)
  915. * ON VA OBLIGATOIREMENT EN NDP=7
  916.   107 CONTINUE
  917.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE7: TEST ... '')')
  918.       IF(II.GT.0) THEN
  919.           IF(KK.GT.0) THEN
  920.              RSPD=.TRUE.
  921.              RSPB=.FALSE.
  922.          IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  923.      *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE DISCONTINUITE '')')
  924.              GO TO 111
  925.          ENDIF
  926.       ENDIF
  927.          IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  928.      * ('' LA RECHERCHE NE SE TERMINE'',
  929.      *''PAS SUR UN PLAN DE DISCONTINUITE '')')
  930. * EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=8
  931.   108 CONTINUE
  932.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE8: TEST ... '')')
  933.       IF(II.GT.0) THEN
  934.           IF(KK.EQ.-3) THEN
  935.              RSPD=.FALSE.
  936.              RSPB=.TRUE.
  937.          IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  938.      *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE BASE '')')
  939.              GO TO 110
  940.           ENDIF
  941.       ENDIF
  942.          IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  943.      *('' LA RECHERCHE NE SE TERMINE PAS SUR UN PLAN DE BASE  '')')
  944. * EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=9
  945.   109 CONTINUE
  946.       RSPD=.FALSE.
  947. *      RSPB=.FALSE.
  948.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE9: TEST ... '')')
  949.       IF(IIMPI.EQ.1799)WRITE(IOIMP,FMT='
  950.      *('' PREMIER PLAN DE DISCONTINUITE ?'')')
  951.       IF(PDR) THEN
  952.            GO TO 115
  953.       ELSE
  954.            IF(IPASS.EQ.1) THEN
  955.              MLREEL=IVLAMB
  956.              SEGINI,MLREE1=MLREEL
  957.              MLAM1=MLREE1
  958.              SEGDES MLREE1
  959.            ELSEIF(IPASS.EQ.3) THEN
  960.              CALL PARTAN (IVLAMB,MLAM1,IVGE,IVGM)
  961.              IPART=1
  962.              MLREEL=IVGM
  963.              IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  964.      *       ('' VALEUR DU GRADIENT MODIF SORTIE PARTAN: '',
  965.      *       /,(1X,5E12.5))')(PROG(I),I=1,M)
  966.              IPASS=0
  967.            ENDIF
  968.            IPASS=IPASS + 1
  969.            IT = IT + 1
  970.            IVDR=IVGM
  971.            GO TO 103
  972.       ENDIF
  973.   110 CONTINUE
  974.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE10: TEST ... '')')
  975.       IF(PDR) THEN
  976.            GO TO 114
  977.       ELSE
  978.            IPASS=1
  979.            IT = IT + 1
  980.            IVDR=IVGM
  981.            GO TO 103
  982.       ENDIF
  983.   111 CONTINUE
  984.       NPDR=NPDR + 1
  985.       IF(IIMPI.GT.1)
  986.      *WRITE(IOIMP,FMT='('' ETAPE11: UN NOUVEAU PLAN DE '',
  987.      *''DISCONTINUITE EST PRIS EN COMPTE '')')
  988.       IF(IIMPI.GT.1)
  989.      *WRITE(IOIMP,FMT='('' NOMBRE DE PLAN DE DISCONTINUITE '',
  990.      *''A CONSIDERER :'',I4)')NPDR
  991.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  992.      *('' INDICE DE LA VARIABLE DISCRETE :'',I4)')II
  993.       IF(IIMPI.GT.1)
  994.      *WRITE(IOIMP,FMT='('' INDICE DE SA VALEUR :'',I4)')KK
  995.       JG=NPDR
  996.       MLENT1=ITI
  997.       MLENT2=ITK
  998.       SEGADJ MLENT1
  999.       SEGADJ MLENT2
  1000.       MLENT1.LECT(JG)=II
  1001.       MLENT2.LECT(JG)=KK
  1002.       IF(PDR) THEN
  1003.           GO TO 113
  1004.       ENDIF
  1005. * SINON ON CONTINUE OBLIGATOIREMENT EN 112
  1006.   112 CONTINUE
  1007.       PDR=.TRUE.
  1008.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  1009.      *('' ETAP12 : INITIALISATION DE LA MATRICE DE PROJECTION'')')
  1010.       CALL NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP)
  1011.       MXMAT=MP
  1012.       JG=M
  1013.       SEGINI MLREE1
  1014.       MLREEL=IVGE
  1015.       CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2)
  1016.       IF(IVGP.NE.0) THEN
  1017.          MLREEL=IVGP
  1018.          SEGSUP MLREEL
  1019.       ENDIF
  1020.       IVGP=MLREE1
  1021.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1022.      *('' VALEUR DU GRADIENT PROJETE DANS ETAPE12 : '',/,(1X,5E12.5))')
  1023.      *(MLREE1.PROG(I),I=1,M)
  1024.       MLREE2=IVLAMB
  1025.       JG=0
  1026.       SEGINI MLENTI
  1027.       DO 130 I=1,M
  1028.          IF(MLREE2.PROG(I).EQ.0.D0)THEN
  1029.              IF(MLREE1.PROG(I).LT.0.D0)THEN
  1030.                JG=JG+1
  1031.                SEGADJ MLENTI
  1032.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(
  1033.      *'' ON CONSIDERE DANS L INITIALISATION LE PLAN DE BASE :'',I2)')I
  1034.                LECT(JG)=I
  1035.              ENDIF
  1036.          ENDIF
  1037.   130 CONTINUE
  1038.       IF(JG.NE.0)THEN
  1039.       DO 131 I=1,JG
  1040.           IK=LECT(I)
  1041.           CALL ETAP14(MP,IK,M)
  1042.   131 CONTINUE
  1043.       SEGSUP MLENTI
  1044.       ENDIF
  1045.       GO TO 115
  1046.   113 CONTINUE
  1047.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1048.      *('' ETAPE13 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')')
  1049.       CALL NTAP13(MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II)
  1050.       IF(IIMPI.GT.1)THEN
  1051.       WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR DISCONTI'')')
  1052.       ENDIF
  1053.       GO TO 115
  1054.   114 CONTINUE
  1055.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1056.      *('' ETAPE14 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')')
  1057.       CALL ETAP14(MP,II,M)
  1058.       IF(IIMPI.GT.1)THEN
  1059.       WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR BASE'')')
  1060.       ENDIF
  1061. * ON CONTINUE OBLIGATOIREMENT EN 115
  1062.   115 CONTINUE
  1063.       MXMAT=MP
  1064.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1065.      *('' ETAPE15 : PROJECTION DU GRADIENT DE LA FONCTION DUALE'')')
  1066.       MLREEL=IVGE
  1067.       JG=PROG(/1)
  1068.       SEGINI MLREE1
  1069.       MXMAT=MP
  1070.       CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2)
  1071.       IF( IVGP.NE.0) THEN
  1072.          MLREE2=IVGP
  1073.          SEGSUP MLREE2
  1074.       ENDIF
  1075.       IVGP=MLREE1
  1076.       IT=IT+1
  1077.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1078.      *('' VALEUR DU GRADIENT PROJETE : '',/,(1X,5E12.5))')
  1079.      *(MLREE1.PROG(I),I=1,M)
  1080.       IVDR=IVGP
  1081.       GO TO 103
  1082.   116 CONTINUE
  1083.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  ETAPE 16 : TEST ... '')')
  1084.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1085.      *('' REDEMARRAGE '')')
  1086.       IF(RSPB) THEN
  1087.          IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1088.      *('' PLAN DE BASE RENCONTRE '')')
  1089.         IF(IPBASP.NE.0)  THEN
  1090.           MLENT1=IPBASP
  1091.           SEGACT MLENT1*MOD
  1092.           MLENTI=IPBASE
  1093.           SEGACT MLENTI*MOD
  1094.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1095.      *('' VALEUR DE IPBASE : '',/,(1X,5I2))')
  1096.      *( LECT(I),I=1,M)
  1097.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1098.      *('' VALEUR DE IPBASP : '',/,(1X,5I2))')
  1099.      *( MLENT1.LECT(I),I=1,M)
  1100.  
  1101.           DO 1160 IU=1,M
  1102.           IF( MLENT1.LECT(IU).NE. 0 )GO TO 1161
  1103.  1160     CONTINUE
  1104.           GO TO 1162
  1105.  1161     SEGSUP MLENT1
  1106.         ENDIF
  1107.         IPBASP=IPBASE
  1108.         JG = M
  1109.         SEGINI MLENTI
  1110.         IPBASE=MLENTI
  1111.       CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
  1112.      *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  1113.       CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
  1114. C avant NTAPE2, IVDR=IVGM or IVGM est "recree", on met le nouveau IVGM dans IVDR
  1115.       IVDR=IVGM
  1116.         GO TO 103
  1117.  1162  CONTINUE
  1118. * ON CONTINUE EN 117
  1119.       ENDIF
  1120.       IF(RSPD) THEN
  1121.          IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  1122.      *('' PLAN DE DISCONTINUITE RENCONTRE'')')
  1123.       ENDIF
  1124.       IF(.NOT.PDR) GO TO 122
  1125. * ON CONTINUE EN 117
  1126.   117 CONTINUE
  1127.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  1128.      * (''  ETAPE 17 : TEST DE REDEMARRAGE '')')
  1129.       IF(NDR.EQ.5) GO TO 121
  1130.       CALL NTAP17(IVFP,IVFQ,IVXU,IVXL,IVLAMB,IVB,IBU,IBL,VF0,NDR,N,
  1131.      *MCP,MCQ,M,XL,XLL,TEST,NPDR,MVDU,MVDL,ITI,ITK,VFPMAX,IVN,IVD)
  1132.       MLREE2=IBU
  1133.       MLREE3=IBL
  1134.       SEGACT MLREE2*MOD,MLREE3*MOD
  1135.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17
  1136.      * = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
  1137.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17
  1138.      * = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)
  1139.       IF(TEST) THEN
  1140.         MLENT1=ITI
  1141.         MLENT2=ITK
  1142.         JG=MLENT1.LECT(/1)
  1143.         IF(ITISAV.NE.0) THEN
  1144.             MLENTI= ITISAV
  1145.             SEGSUP MLENTI
  1146.         ENDIF
  1147.         IF(ITKSAV.NE.0) THEN
  1148.             MLENTI= ITKSAV
  1149.             SEGSUP MLENTI
  1150.         ENDIF
  1151.         SEGINI MLENTI
  1152.         SEGINI MLENT3
  1153.         ITISAV=MLENTI
  1154.         ITKSAV=MLENT3
  1155.         NPDRSV=NPDR
  1156.         DO 140 I=1,JG
  1157.           LECT(I)=MLENT1.LECT(I)
  1158.           MLENT3.LECT(I)=MLENT2.LECT(I)
  1159.   140   CONTINUE
  1160.         PDR=.FALSE.
  1161.         MXMAT=MP
  1162.         SEGSUP MXMAT
  1163.         IF(RSPD) THEN
  1164.           MLENT1=ITI
  1165.           MLENT2=ITK
  1166.           MLENT1.LECT(1)=MLENT1.LECT(NPDR)
  1167.           MLENT2.LECT(1)=MLENT2.LECT(NPDR)
  1168.           NPDR=1
  1169.           RSPD=.FALSE.
  1170.           GO TO 112
  1171.         ENDIF
  1172.   119   CONTINUE
  1173.         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  ETAPE19 : TEST ..'')')
  1174.         IF(RSPB)THEN
  1175.            RSPB=.FALSE.
  1176.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE19 PRISE EN COMPTE DU
  1177.      *PLAN DE BASE NO :'',I4)')II
  1178.            MLENTI=MDR
  1179.            LECT(II)=1
  1180.         ENDIF
  1181.         NPDR=0
  1182.         GO TO 101
  1183.       ENDIF
  1184.   121 CONTINUE
  1185.         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  FIN DES RECHERCHES'')')
  1186.         IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE21 : SELECTION DES VARIA
  1187.      *BLES DISCRETES OPTIMALES '')')
  1188.       CALL NTAP21(IVFP,IVFQ,IVLAMB,IVB,IBU,IBL,
  1189.      * NPDR,N,MCP,MCQ,M,MVDU,MVDL,ITI,ITK)
  1190.       MLREE1=IBU
  1191.       MLREE2=IBL
  1192.       SEGACT MLREE1*MOD,MLREE2*MOD
  1193.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
  1194.      *ION = IBU :'',/,(1X,5E12.5))')(MLREE1.PROG(I),I=1,N11)
  1195.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
  1196.      *ION = IBL :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
  1197.       MLREE3=IVXU
  1198.       MLREE4=IVXL
  1199.       SEGACT MLREE3*MOD,MLREE4*MOD
  1200.       JG=MLREE1.PROG(/1)
  1201.       DO 1220 I=1,JG
  1202.          MLREE3.PROG(I)=MLREE1.PROG(I)
  1203.          MLREE4.PROG(I)=MLREE2.PROG(I)
  1204.  1220 CONTINUE
  1205. *   ON CONTINUE EN 122
  1206.   122 CONTINUE
  1207.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE 22 : FIN DE L ALGORITHME
  1208.      *  '')')
  1209. *      CALL ETAP22(IVX,IVX0,N,IVF,IVLL,IVUL)
  1210.       INTERR(1)=ITTER
  1211.       MLREE1=IVXU
  1212.       MLREE2=IVXL
  1213.       MLREE3=IVUL
  1214.       MLREE4=IVLL
  1215.       SEGACT MLREE1*MOD
  1216.       SEGACT MLREE2*MOD
  1217.       SEGACT MLREE3*MOD
  1218.       SEGACT MLREE4*MOD
  1219.       JG=N
  1220.       SEGINI MLREEL
  1221.       IVX=MLREEL
  1222.       DO 1221 I=1,JG
  1223.         PROG(I)=MLREE3.PROG(I)-MLREE1.PROG(I)
  1224.         CST=MLREE2.PROG(I)+MLREE4.PROG(I)
  1225.         IF(IIMPI.EQ.17)
  1226.      *  WRITE(IOIMP,'('' XU , XL '',(1X,I2,2E12.5))')I,PROG(I),CST
  1227.         IF(ABS(PROG(I)-CST).GT.1.D-4) GO TO 1000
  1228.  1221 CONTINUE
  1229.       AAZER=MLREE3.PROG(N11)-MLREE1.PROG(N11)
  1230.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  VALEUR DE X EN SORTIE :'',/,
  1231.      *(1X,5E12.5))')(PROG(I),I=1,N),AAZER
  1232. *
  1233. *  SAUVEGARDE DE VX DANS VX0
  1234.       MLREEL=IVX0
  1235.       MLREE1=IVX
  1236.       SEGACT MLREEL*MOD,MLREE1*MOD
  1237.       DO 65 I=1,N
  1238.          PROG(I)=MLREE1.PROG(I)
  1239.    65 CONTINUE
  1240.       if(nsup.ne.0) then
  1241.       jg=mlree6.prog(/1)
  1242.       n=jg
  1243.       segini mlree5
  1244.       ia=0
  1245.       do iou=1,jg
  1246.       if(ibon(iou).eq.1) then
  1247.         ia=ia+1
  1248.         mlree5.prog(iou)=prog(ia)
  1249.        else
  1250.         mlree5.prog(iou)=mlree6.prog(iou)
  1251.        endif
  1252.        enddo
  1253.        ivx0=mlree5
  1254.        segsup mlreel
  1255.        mlreel=mlree5
  1256.        segsup ibo
  1257.        endif
  1258. *
  1259.       CALL VECTAB(IVX0,N,IRET)
  1260.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN,
  1261.      *                    'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1262.       CALL VECTAB(IVXPR1,N-nsup,IRET)
  1263.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN,
  1264.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1265.       CALL VECTAB(IVXPR2,N-nsup,IRET)
  1266.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN,
  1267.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1268.       CALL VECTAB(IVUL,N-nsup,IRET)
  1269.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN,
  1270.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1271.       CALL VECTAB(IVLL,N-nsup,IRET)
  1272.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN,
  1273.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1274. *
  1275. *
  1276.  
  1277.       CALL ECROBJ('TABLE   ',ITAB)
  1278.       MTABLE=ITAB
  1279.       SEGDES MTABLE
  1280.       MLREEL=IVX
  1281.       MLREE1=IVN
  1282.       MLREE2=IVD
  1283.       MLENTI=IVU
  1284.       SEGSUP MLREEL,MLREE1,MLREE2,MLENTI
  1285.       MLREEL = IVF
  1286.       MXMAT=MC
  1287.       MLREE1=IMC0
  1288.       SEGSUP MLREEL,MXMAT,MLREE1
  1289.       MLREEL=IVXMIN
  1290.       MLREE1=IVXMAX
  1291.       MLREE2=IVCMAX
  1292.       SEGSUP MLREEL,MLREE1,MLREE2
  1293.       MLREEL=IWD
  1294.       MLREE1=IVFP
  1295.       MLREE2=IVFQ
  1296.       SEGSUP MLREEL,MLREE1,MLREE2
  1297.       MXMAT=MCP
  1298.       MXMA1=MCQ
  1299.       SEGSUP MXMAT,MXMA1
  1300.       MLREEL=IVLAMB
  1301.       SEGSUP MLREEL
  1302.       MLENTI=ITI
  1303.       MLENT1=ITK
  1304.       SEGSUP MLENTI,MLENT1
  1305.       IF(NVD.NE.0) THEN
  1306.         MLENTI=IDVD
  1307.         MXMAT=MVD
  1308.         MXMA1=MVDU
  1309.         MXMA2=MVDL
  1310.         SEGSUP MLENTI,MXMAT,MXMA1,MXMA2
  1311.       ENDIF
  1312.       MXMAT=MP
  1313.       SEGSUP MXMAT
  1314.       MLREEL=IVXPR1
  1315.       MLREE1=IVXPR2
  1316.       SEGSUP MLREEL,MLREE1
  1317.       MLREEL=IVMIN
  1318.       MLREE1=IVMAX
  1319.       SEGSUP MLREEL,MLREE1
  1320.       MLREEL=IVXU
  1321.       MLREE1=IVXL
  1322.       MLREE2=IVMINU
  1323.       MLREE3=IVMINL
  1324.       SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
  1325.       MLREEL=IVMAXU
  1326.       MLREE1=IVMAXL
  1327.       MLREE2=IVB
  1328.       SEGSUP MLREEL,MLREE1,MLREE2
  1329.       MLREEL=IVUL
  1330.       MLREE1=IVLL
  1331.       MLREE2=IVX0U
  1332.       MLREE3=IVX0L
  1333.       SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
  1334.       MLREEL=MLAM1
  1335.       MLREE1=IVGE
  1336.       MLREE2=IVGM
  1337.       MLREE3=IVGP
  1338.       SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
  1339.       IF( IT0.NE.0) THEN
  1340.         MLREEL=IT0
  1341.         SEGSUP MLREEL
  1342.       ENDIF
  1343.       IF( IS0.NE.0) THEN
  1344.         MLREEL=IS0
  1345.         SEGSUP MLREEL
  1346.       ENDIF
  1347.       RETURN
  1348.  1000 CONTINUE
  1349.       CALL ERREUR(19)
  1350.       RETURN
  1351.       END
  1352.  
  1353.  
  1354.  
  1355.  
  1356.  
  1357.  
  1358.  
  1359.  
  1360.  
  1361.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales