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    CB215821  26/08/24    21:16:32     12622          
  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 10015 I=1,NVD
  697.             DO 19 J=2,NDIS+1
  698.               MXMA1.XMAT(I,J)=XMAT(I,J-1)
  699.    19    CONTINUE
  700. 10015    CONTINUE
  701.          MLREEL=IVUL
  702.          MLREE1=IVLL
  703.          SEGACT MLREEL*MOD,MLREE1*MOD
  704.          JG=LDIM1
  705.          SEGINI MLENTI
  706.          IDVD=MLENTI
  707.          MVD=NMVD
  708.          MXMAT=MVD
  709.          SEGACT MXMAT*MOD
  710.          LDIM1=XMAT(/1)
  711.          LDIM2=XMAT(/2)
  712.          SEGINI MXMA1,MXMA2
  713.          MVDU=MXMA1
  714.          MVDL=MXMA2
  715.          DO 18 I=1,NVD
  716.            DO 13 J=2,NDIS+2
  717.              MXMA1.XMAT(I,J)=PROG(I)-XMAT(I,J)
  718.              MXMA2.XMAT(I,J)=XMAT(I,J)-MLREE1.PROG(I)
  719.              IF(XMAT(I,J).LT.1.D-20) THEN
  720.                LECT(I)=J-1
  721.                XMAT(I,J)=XGRAND
  722.                MXMA1.XMAT(I,J)=XGRAND
  723.                MXMA2.XMAT(I,J)=XGRAND
  724.                GO TO 18
  725.              ENDIF
  726.    13      CONTINUE
  727.    18    CONTINUE
  728. *
  729.          IF(IIMPI.EQ.1799)THEN
  730.             WRITE(IOIMP,'('' NOUVELLE MATRICE MVDU'')')
  731.             DO 10016 I=1,LDIM1
  732.                WRITE(IOIMP,'('' LIGNE  '',I2)')I
  733.                DO 20 J=1,LDIM2
  734.                   WRITE(IOIMP,'(E12.5)')MXMA1.XMAT(I,J)
  735.    20       CONTINUE
  736. 10016       CONTINUE
  737.          ENDIF
  738.          IF(IIMPI.EQ.1799)THEN
  739.             WRITE(IOIMP,'('' NOUVELLE MATRICE MVDL'')')
  740.             DO 10017 I=1,LDIM1
  741.                WRITE(IOIMP,'('' LIGNE  '',I2)')I
  742.                DO 55 J=1,LDIM2
  743.                   WRITE(IOIMP,'(E12.5)')MXMA2.XMAT(I,J)
  744.    55       CONTINUE
  745. 10017       CONTINUE
  746.          ENDIF
  747.       ENDIF
  748. *
  749. *    INITIALISATION DE L ALGORITHME
  750. *
  751.       JG=M
  752.       SEGINI MLREEL
  753.       IVLAMB=MLREEL
  754.       DO 16 I=1,JG
  755.          PROG(I)=1.D0
  756.   16  CONTINUE
  757. *
  758. *       INITIALISATION DES PARAMETRES DE CONTROLES
  759. *
  760.       TERMIN=.FALSE.
  761.       PDR=.FALSE.
  762.       RSPB=.FALSE.
  763.       RSPD=.FALSE.
  764.       NDR=0
  765.       EPSILO=0.001
  766.       JG=0
  767.       SEGINI MLENT1,MLENT2
  768.       ITI=MLENT1
  769.       ITK=MLENT2
  770.       JG=M
  771.       SEGINI MLENTI
  772.       MDR=MLENTI
  773.       NDP=1
  774.       XL=0.
  775.       NPDR=0
  776.       XLL=0.
  777.       LDIM1=M
  778.       LDIM2=M
  779.       SEGINI MXMAT
  780.       MP=MXMAT
  781. *
  782. *
  783. *  DEBUT DE TOURNER EN ROND
  784. *
  785. *
  786.       IT=0
  787.       JG= M
  788.       SEGINI MLENTI
  789.       IPBASE=MLENTI
  790.   101 CONTINUE
  791.       IF(IIMPI.EQ.1799)
  792.      *WRITE(IOIMP,FMT='('' ETAPE1: CALCUL DE X LAMBDA '')')
  793.       CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
  794.      *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  795.   102 CONTINUE
  796.       IF(IT.EQ.0) THEN
  797.       MLREEL=IVXU
  798.       MLREE3=IVXL
  799.       MLREE1=IVN
  800.       MLREE2=IVD
  801.       SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD
  802.       ENDIF
  803.       IF(IIMPI.EQ.1799)
  804.      *WRITE(IOIMP,FMT='('' ETAPE2:CALCUL DE LA DIRECTION DE MONTEE'')')
  805.       IF(IT.GT.0 ) THEN
  806.          IVZZ=IVGE
  807.       ENDIF
  808.       CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
  809.       IVDR=IVGM
  810.       IF(IT.EQ.0) THEN
  811.        MLREEL=IVGM
  812.        SEGACT MLREEL*MOD
  813.       IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M)
  814.       IF(IIMPI.EQ.1799) WRITE(IOIMP,10014) (PROG(I),I=1,M)
  815. 10014  FORMAT(' VALEUR DE GRAD ',/ ,(1X,5(E12.5)))
  816.       ENDIF
  817. *       ON CONTINUE OBLIGATOIREMENT EN NDP=3
  818.   103 CONTINUE
  819.       IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M)
  820.       ITTER=ITTER+1
  821.       MLREEL=IVDR
  822.       MLENTI=MDR
  823.       DO 1020 I=1,M
  824.         IF(LECT(I).EQ.1) PROG(I)=0.D0
  825.  1020 CONTINUE
  826.       IF(ITTER.GT.MAXITE) THEN
  827.         INTERR(1)=MAXITE
  828.         CALL ERREUR(602)
  829.         GO TO 116
  830.       ENDIF
  831.       IF(IIMPI.EQ.1799)
  832.      *WRITE(IOIMP,FMT='('' ETAPE3:TEST NORME DIRECTION DE RECHERCHE'')')
  833.       CALL ETAPE3(PROG,M,XNORZ)
  834.       IF(IIMPI.NE.0) WRITE(6,1564) ITTER,XNORZ
  835.  1564 FORMAT(' iteration ', I5,' critere : ',E12.5)
  836. *****   TEST BIDON POUR CREER UN GO TO EN 104|||
  837.       IF(IOIMP.EQ.-598) GO TO 104
  838.       IF(ITTER.EQ.1) THEN
  839.                EPSILO= XNORZ / XPREC
  840. c               WRITE(IOIMP,FMT='('' valeur du test de convergence''
  841. c     $  ,2e12.5 )') EPSILO,XPREC
  842.       ENDIF
  843.       IF( XNORZ.LE.EPSILO.AND.IPART.NE.1) THEN
  844.           GO TO 116
  845.       ELSE
  846.           IPART=0
  847.           GO TO 106
  848.       ENDIF
  849.  104  CONTINUE
  850.       IF(IIMPI.EQ.1799)
  851.      *WRITE(IOIMP,FMT='('' ETAPE4: CALCUL DU HESSIEN'')')
  852.       IF ( IT .GT.0) THEN
  853.          CALL ETAPE4(MCP,MCQ,M,N,IVU,IVXU,IVN,MH)
  854.          CALL TXAY(IVZZ,MH,IVZZ,M,M,XRES)
  855.          IF(XRES.EQ.0.D0) THEN
  856.             IF(IIMPI.GT.1)
  857.      *WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')')
  858.             GO TO 106
  859.          ELSE
  860.             IF(IIMPI.EQ.1799)
  861.      * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES POSSIBLE'')')
  862.             GO TO 105
  863.          ENDIF
  864.       ELSE
  865.             IF(IIMPI.GT.1)
  866.      * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')')
  867.          GO TO 106
  868.       ENDIF
  869.  105  CONTINUE
  870.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT=
  871.      *'('' ETAPE5 CONJUGAISON DES DIRECTIONS DE RECHERCHE'' )')
  872.       CALL ETAPE5(IVZ,IVZZ,MH,M)
  873. * ON VA OBLIGATOIREMENT EN NDP=6
  874.   106 CONTINUE
  875.       IF(IIMPI.EQ.1799)  WRITE(IOIMP,FMT='(
  876.      *'' ETAP6 RECHERCHE LINEAIRE SUIVANT LA DIRECTION DE RECHERCHE'')')
  877.       CALL NTAPE6(MCP,MCQ,IVMINU,IVMINL,IVMAXU,IVMAXL,IVLAMB,
  878.      * M,N,NVD,IVFP,IVFQ,MVDU,MVDL,IVB,IVD,IVN,II,KK,IVDR,IDVD,
  879.      * NDR,TERMIN,IVLL,IVUL,IPBASE)
  880.       IF(TERMIN)THEN
  881.          ITI=ITISAV
  882.          ITK=ITKSAV
  883.          NPDR=NPDRSV
  884.          GO TO 121
  885.       ENDIF
  886.       IF(II.GT.0) THEN
  887.           IF(KK.EQ.-3) THEN
  888.           MLENTI=IPBASE
  889.            SEGACT MLENTI*MOD
  890.            LECT(II)=1
  891.            SEGDES MLENTI
  892.       ENDIF
  893.       ENDIF
  894.       CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
  895.      *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  896.       CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
  897.       MLREEL=IVLAMB
  898.       SEGACT MLREEL*MOD
  899.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT=
  900.      *'(''  LAMBDA OPTIMAL '',/,(1X,5E12.5))')(PROG(I),I=1,M)
  901.       MLREEL=IVGM
  902.       SEGACT MLREEL*MOD
  903.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  904.      *('' VALEUR DU GRADIENT MODIF SORTIE ETAPE6 : '',/,(1X,5E12.5))')
  905.      *(PROG(I),I=1,M)
  906.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE II ETAPE6
  907.      *: '',/,(1X,I2))')II
  908.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE KK ETAPE6
  909.      *: '',/,(1X,I2))')KK
  910.       MLREEL=IVXU
  911.       SEGACT MLREEL*MOD
  912.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXU : ''
  913.      *,/,(1X,5E12.5))')(PROG(I),I=1,N11)
  914.       MLREEL=IVXL
  915.       SEGACT MLREEL*MOD
  916.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXL : ''
  917.      *,/,(1X,5E12.5))')(PROG(I),I=1,N11)
  918. * ON VA OBLIGATOIREMENT EN NDP=7
  919.   107 CONTINUE
  920.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE7: TEST ... '')')
  921.       IF(II.GT.0) THEN
  922.           IF(KK.GT.0) THEN
  923.              RSPD=.TRUE.
  924.              RSPB=.FALSE.
  925.          IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  926.      *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE DISCONTINUITE '')')
  927.              GO TO 111
  928.          ENDIF
  929.       ENDIF
  930.          IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  931.      * ('' LA RECHERCHE NE SE TERMINE'',
  932.      *''PAS SUR UN PLAN DE DISCONTINUITE '')')
  933. * EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=8
  934.   108 CONTINUE
  935.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE8: TEST ... '')')
  936.       IF(II.GT.0) THEN
  937.           IF(KK.EQ.-3) THEN
  938.              RSPD=.FALSE.
  939.              RSPB=.TRUE.
  940.          IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  941.      *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE BASE '')')
  942.              GO TO 110
  943.           ENDIF
  944.       ENDIF
  945.          IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  946.      *('' LA RECHERCHE NE SE TERMINE PAS SUR UN PLAN DE BASE  '')')
  947. * EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=9
  948.   109 CONTINUE
  949.       RSPD=.FALSE.
  950. *      RSPB=.FALSE.
  951.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE9: TEST ... '')')
  952.       IF(IIMPI.EQ.1799)WRITE(IOIMP,FMT='
  953.      *('' PREMIER PLAN DE DISCONTINUITE ?'')')
  954.       IF(PDR) THEN
  955.            GO TO 115
  956.       ELSE
  957.            IF(IPASS.EQ.1) THEN
  958.              MLREEL=IVLAMB
  959.              SEGINI,MLREE1=MLREEL
  960.              MLAM1=MLREE1
  961.              SEGDES MLREE1
  962.            ELSEIF(IPASS.EQ.3) THEN
  963.              CALL PARTAN (IVLAMB,MLAM1,IVGE,IVGM)
  964.              IPART=1
  965.              MLREEL=IVGM
  966.              IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  967.      *       ('' VALEUR DU GRADIENT MODIF SORTIE PARTAN: '',
  968.      *       /,(1X,5E12.5))')(PROG(I),I=1,M)
  969.              IPASS=0
  970.            ENDIF
  971.            IPASS=IPASS + 1
  972.            IT = IT + 1
  973.            IVDR=IVGM
  974.            GO TO 103
  975.       ENDIF
  976.   110 CONTINUE
  977.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE10: TEST ... '')')
  978.       IF(PDR) THEN
  979.            GO TO 114
  980.       ELSE
  981.            IPASS=1
  982.            IT = IT + 1
  983.            IVDR=IVGM
  984.            GO TO 103
  985.       ENDIF
  986.   111 CONTINUE
  987.       NPDR=NPDR + 1
  988.       IF(IIMPI.GT.1)
  989.      *WRITE(IOIMP,FMT='('' ETAPE11: UN NOUVEAU PLAN DE '',
  990.      *''DISCONTINUITE EST PRIS EN COMPTE '')')
  991.       IF(IIMPI.GT.1)
  992.      *WRITE(IOIMP,FMT='('' NOMBRE DE PLAN DE DISCONTINUITE '',
  993.      *''A CONSIDERER :'',I4)')NPDR
  994.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  995.      *('' INDICE DE LA VARIABLE DISCRETE :'',I4)')II
  996.       IF(IIMPI.GT.1)
  997.      *WRITE(IOIMP,FMT='('' INDICE DE SA VALEUR :'',I4)')KK
  998.       JG=NPDR
  999.       MLENT1=ITI
  1000.       MLENT2=ITK
  1001.       SEGADJ MLENT1
  1002.       SEGADJ MLENT2
  1003.       MLENT1.LECT(JG)=II
  1004.       MLENT2.LECT(JG)=KK
  1005.       IF(PDR) THEN
  1006.           GO TO 113
  1007.       ENDIF
  1008. * SINON ON CONTINUE OBLIGATOIREMENT EN 112
  1009.   112 CONTINUE
  1010.       PDR=.TRUE.
  1011.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  1012.      *('' ETAP12 : INITIALISATION DE LA MATRICE DE PROJECTION'')')
  1013.       CALL NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP)
  1014.       MXMAT=MP
  1015.       JG=M
  1016.       SEGINI MLREE1
  1017.       MLREEL=IVGE
  1018.       CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2)
  1019.       IF(IVGP.NE.0) THEN
  1020.          MLREEL=IVGP
  1021.          SEGSUP MLREEL
  1022.       ENDIF
  1023.       IVGP=MLREE1
  1024.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1025.      *('' VALEUR DU GRADIENT PROJETE DANS ETAPE12 : '',/,(1X,5E12.5))')
  1026.      *(MLREE1.PROG(I),I=1,M)
  1027.       MLREE2=IVLAMB
  1028.       JG=0
  1029.       SEGINI MLENTI
  1030.       DO 130 I=1,M
  1031.          IF(MLREE2.PROG(I).EQ.0.D0)THEN
  1032.              IF(MLREE1.PROG(I).LT.0.D0)THEN
  1033.                JG=JG+1
  1034.                SEGADJ MLENTI
  1035.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(
  1036.      *'' ON CONSIDERE DANS L INITIALISATION LE PLAN DE BASE :'',I2)')I
  1037.                LECT(JG)=I
  1038.              ENDIF
  1039.          ENDIF
  1040.   130 CONTINUE
  1041.       IF(JG.NE.0)THEN
  1042.       DO 131 I=1,JG
  1043.           IK=LECT(I)
  1044.           CALL ETAP14(MP,IK,M)
  1045.   131 CONTINUE
  1046.       SEGSUP MLENTI
  1047.       ENDIF
  1048.       GO TO 115
  1049.   113 CONTINUE
  1050.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1051.      *('' ETAPE13 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')')
  1052.       CALL NTAP13(MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II)
  1053.       IF(IIMPI.GT.1)THEN
  1054.       WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR DISCONTI'')')
  1055.       ENDIF
  1056.       GO TO 115
  1057.   114 CONTINUE
  1058.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1059.      *('' ETAPE14 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')')
  1060.       CALL ETAP14(MP,II,M)
  1061.       IF(IIMPI.GT.1)THEN
  1062.       WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR BASE'')')
  1063.       ENDIF
  1064. * ON CONTINUE OBLIGATOIREMENT EN 115
  1065.   115 CONTINUE
  1066.       MXMAT=MP
  1067.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1068.      *('' ETAPE15 : PROJECTION DU GRADIENT DE LA FONCTION DUALE'')')
  1069.       MLREEL=IVGE
  1070.       JG=PROG(/1)
  1071.       SEGINI MLREE1
  1072.       MXMAT=MP
  1073.       CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2)
  1074.       IF( IVGP.NE.0) THEN
  1075.          MLREE2=IVGP
  1076.          SEGSUP MLREE2
  1077.       ENDIF
  1078.       IVGP=MLREE1
  1079.       IT=IT+1
  1080.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1081.      *('' VALEUR DU GRADIENT PROJETE : '',/,(1X,5E12.5))')
  1082.      *(MLREE1.PROG(I),I=1,M)
  1083.       IVDR=IVGP
  1084.       GO TO 103
  1085.   116 CONTINUE
  1086.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  ETAPE 16 : TEST ... '')')
  1087.       IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1088.      *('' REDEMARRAGE '')')
  1089.       IF(RSPB) THEN
  1090.          IF(IIMPI.GT.1)WRITE(IOIMP,FMT='
  1091.      *('' PLAN DE BASE RENCONTRE '')')
  1092.         IF(IPBASP.NE.0)  THEN
  1093.           MLENT1=IPBASP
  1094.           SEGACT MLENT1*MOD
  1095.           MLENTI=IPBASE
  1096.           SEGACT MLENTI*MOD
  1097.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1098.      *('' VALEUR DE IPBASE : '',/,(1X,5I2))')
  1099.      *( LECT(I),I=1,M)
  1100.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='
  1101.      *('' VALEUR DE IPBASP : '',/,(1X,5I2))')
  1102.      *( MLENT1.LECT(I),I=1,M)
  1103.  
  1104.           DO 1160 IU=1,M
  1105.           IF( MLENT1.LECT(IU).NE. 0 )GO TO 1161
  1106.  1160     CONTINUE
  1107.           GO TO 1162
  1108.  1161     SEGSUP MLENT1
  1109.         ENDIF
  1110.         IPBASP=IPBASE
  1111.         JG = M
  1112.         SEGINI MLENTI
  1113.         IPBASE=MLENTI
  1114.       CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL,
  1115.      *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL)
  1116.       CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE)
  1117. C avant NTAPE2, IVDR=IVGM or IVGM est "recree", on met le nouveau IVGM dans IVDR
  1118.       IVDR=IVGM
  1119.         GO TO 103
  1120.  1162  CONTINUE
  1121. * ON CONTINUE EN 117
  1122.       ENDIF
  1123.       IF(RSPD) THEN
  1124.          IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  1125.      *('' PLAN DE DISCONTINUITE RENCONTRE'')')
  1126.       ENDIF
  1127.       IF(.NOT.PDR) GO TO 122
  1128. * ON CONTINUE EN 117
  1129.   117 CONTINUE
  1130.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='
  1131.      * (''  ETAPE 17 : TEST DE REDEMARRAGE '')')
  1132.       IF(NDR.EQ.5) GO TO 121
  1133.       CALL NTAP17(IVFP,IVFQ,IVXU,IVXL,IVLAMB,IVB,IBU,IBL,VF0,NDR,N,
  1134.      *MCP,MCQ,M,XL,XLL,TEST,NPDR,MVDU,MVDL,ITI,ITK,VFPMAX,IVN,IVD)
  1135.       MLREE2=IBU
  1136.       MLREE3=IBL
  1137.       SEGACT MLREE2*MOD,MLREE3*MOD
  1138.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17
  1139.      * = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
  1140.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17
  1141.      * = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11)
  1142.       IF(TEST) THEN
  1143.         MLENT1=ITI
  1144.         MLENT2=ITK
  1145.         JG=MLENT1.LECT(/1)
  1146.         IF(ITISAV.NE.0) THEN
  1147.             MLENTI= ITISAV
  1148.             SEGSUP MLENTI
  1149.         ENDIF
  1150.         IF(ITKSAV.NE.0) THEN
  1151.             MLENTI= ITKSAV
  1152.             SEGSUP MLENTI
  1153.         ENDIF
  1154.         SEGINI MLENTI
  1155.         SEGINI MLENT3
  1156.         ITISAV=MLENTI
  1157.         ITKSAV=MLENT3
  1158.         NPDRSV=NPDR
  1159.         DO 140 I=1,JG
  1160.           LECT(I)=MLENT1.LECT(I)
  1161.           MLENT3.LECT(I)=MLENT2.LECT(I)
  1162.   140   CONTINUE
  1163.         PDR=.FALSE.
  1164.         MXMAT=MP
  1165.         SEGSUP MXMAT
  1166.         IF(RSPD) THEN
  1167.           MLENT1=ITI
  1168.           MLENT2=ITK
  1169.           MLENT1.LECT(1)=MLENT1.LECT(NPDR)
  1170.           MLENT2.LECT(1)=MLENT2.LECT(NPDR)
  1171.           NPDR=1
  1172.           RSPD=.FALSE.
  1173.           GO TO 112
  1174.         ENDIF
  1175.   119   CONTINUE
  1176.         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  ETAPE19 : TEST ..'')')
  1177.         IF(RSPB)THEN
  1178.            RSPB=.FALSE.
  1179.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE19 PRISE EN COMPTE DU
  1180.      *PLAN DE BASE NO :'',I4)')II
  1181.            MLENTI=MDR
  1182.            LECT(II)=1
  1183.         ENDIF
  1184.         NPDR=0
  1185.         GO TO 101
  1186.       ENDIF
  1187.   121 CONTINUE
  1188.         IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  FIN DES RECHERCHES'')')
  1189.         IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE21 : SELECTION DES VARIA
  1190.      *BLES DISCRETES OPTIMALES '')')
  1191.       CALL NTAP21(IVFP,IVFQ,IVLAMB,IVB,IBU,IBL,
  1192.      * NPDR,N,MCP,MCQ,M,MVDU,MVDL,ITI,ITK)
  1193.       MLREE1=IBU
  1194.       MLREE2=IBL
  1195.       SEGACT MLREE1*MOD,MLREE2*MOD
  1196.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
  1197.      *ION = IBU :'',/,(1X,5E12.5))')(MLREE1.PROG(I),I=1,N11)
  1198.       IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT
  1199.      *ION = IBL :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11)
  1200.       MLREE3=IVXU
  1201.       MLREE4=IVXL
  1202.       SEGACT MLREE3*MOD,MLREE4*MOD
  1203.       JG=MLREE1.PROG(/1)
  1204.       DO 1220 I=1,JG
  1205.          MLREE3.PROG(I)=MLREE1.PROG(I)
  1206.          MLREE4.PROG(I)=MLREE2.PROG(I)
  1207.  1220 CONTINUE
  1208. *   ON CONTINUE EN 122
  1209.   122 CONTINUE
  1210.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE 22 : FIN DE L ALGORITHME
  1211.      *  '')')
  1212. *      CALL ETAP22(IVX,IVX0,N,IVF,IVLL,IVUL)
  1213.       INTERR(1)=ITTER
  1214.       MLREE1=IVXU
  1215.       MLREE2=IVXL
  1216.       MLREE3=IVUL
  1217.       MLREE4=IVLL
  1218.       SEGACT MLREE1*MOD
  1219.       SEGACT MLREE2*MOD
  1220.       SEGACT MLREE3*MOD
  1221.       SEGACT MLREE4*MOD
  1222.       JG=N
  1223.       SEGINI MLREEL
  1224.       IVX=MLREEL
  1225.       DO 1221 I=1,JG
  1226.         PROG(I)=MLREE3.PROG(I)-MLREE1.PROG(I)
  1227.         CST=MLREE2.PROG(I)+MLREE4.PROG(I)
  1228.         IF(IIMPI.EQ.17)
  1229.      *  WRITE(IOIMP,'('' XU , XL '',(1X,I2,2E12.5))')I,PROG(I),CST
  1230.         IF(ABS(PROG(I)-CST).GT.1.D-4) GO TO 1000
  1231.  1221 CONTINUE
  1232.       AAZER=MLREE3.PROG(N11)-MLREE1.PROG(N11)
  1233.       IF(IIMPI.GT.1) WRITE(IOIMP,FMT='(''  VALEUR DE X EN SORTIE :'',/,
  1234.      *(1X,5E12.5))')(PROG(I),I=1,N),AAZER
  1235. *
  1236. *  SAUVEGARDE DE VX DANS VX0
  1237.       MLREEL=IVX0
  1238.       MLREE1=IVX
  1239.       SEGACT MLREEL*MOD,MLREE1*MOD
  1240.       DO 65 I=1,N
  1241.          PROG(I)=MLREE1.PROG(I)
  1242.    65 CONTINUE
  1243.       if(nsup.ne.0) then
  1244.       jg=mlree6.prog(/1)
  1245.       n=jg
  1246.       segini mlree5
  1247.       ia=0
  1248.       do iou=1,jg
  1249.       if(ibon(iou).eq.1) then
  1250.         ia=ia+1
  1251.         mlree5.prog(iou)=prog(ia)
  1252.        else
  1253.         mlree5.prog(iou)=mlree6.prog(iou)
  1254.        endif
  1255.        enddo
  1256.        ivx0=mlree5
  1257.        segsup mlreel
  1258.        mlreel=mlree5
  1259.        segsup ibo
  1260.        endif
  1261. *
  1262.       CALL VECTAB(IVX0,N,IRET)
  1263.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN,
  1264.      *                    'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1265.       CALL VECTAB(IVXPR1,N-nsup,IRET)
  1266.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN,
  1267.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1268.       CALL VECTAB(IVXPR2,N-nsup,IRET)
  1269.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN,
  1270.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1271.       CALL VECTAB(IVUL,N-nsup,IRET)
  1272.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN,
  1273.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1274.       CALL VECTAB(IVLL,N-nsup,IRET)
  1275.       CALL ECCTAB(ITAB,'MOT     ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN,
  1276.      *                       'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET)
  1277. *
  1278. *
  1279.  
  1280.       CALL ECROBJ('TABLE   ',ITAB)
  1281.       MTABLE=ITAB
  1282.       SEGDES MTABLE
  1283.       MLREEL=IVX
  1284.       MLREE1=IVN
  1285.       MLREE2=IVD
  1286.       MLENTI=IVU
  1287.       SEGSUP MLREEL,MLREE1,MLREE2,MLENTI
  1288.       MLREEL = IVF
  1289.       MXMAT=MC
  1290.       MLREE1=IMC0
  1291.       SEGSUP MLREEL,MXMAT,MLREE1
  1292.       MLREEL=IVXMIN
  1293.       MLREE1=IVXMAX
  1294.       MLREE2=IVCMAX
  1295.       SEGSUP MLREEL,MLREE1,MLREE2
  1296.       MLREEL=IWD
  1297.       MLREE1=IVFP
  1298.       MLREE2=IVFQ
  1299.       SEGSUP MLREEL,MLREE1,MLREE2
  1300.       MXMAT=MCP
  1301.       MXMA1=MCQ
  1302.       SEGSUP MXMAT,MXMA1
  1303.       MLREEL=IVLAMB
  1304.       SEGSUP MLREEL
  1305.       MLENTI=ITI
  1306.       MLENT1=ITK
  1307.       SEGSUP MLENTI,MLENT1
  1308.       IF(NVD.NE.0) THEN
  1309.         MLENTI=IDVD
  1310.         MXMAT=MVD
  1311.         MXMA1=MVDU
  1312.         MXMA2=MVDL
  1313.         SEGSUP MLENTI,MXMAT,MXMA1,MXMA2
  1314.       ENDIF
  1315.       MXMAT=MP
  1316.       SEGSUP MXMAT
  1317.       MLREEL=IVXPR1
  1318.       MLREE1=IVXPR2
  1319.       SEGSUP MLREEL,MLREE1
  1320.       MLREEL=IVMIN
  1321.       MLREE1=IVMAX
  1322.       SEGSUP MLREEL,MLREE1
  1323.       MLREEL=IVXU
  1324.       MLREE1=IVXL
  1325.       MLREE2=IVMINU
  1326.       MLREE3=IVMINL
  1327.       SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
  1328.       MLREEL=IVMAXU
  1329.       MLREE1=IVMAXL
  1330.       MLREE2=IVB
  1331.       SEGSUP MLREEL,MLREE1,MLREE2
  1332.       MLREEL=IVUL
  1333.       MLREE1=IVLL
  1334.       MLREE2=IVX0U
  1335.       MLREE3=IVX0L
  1336.       SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
  1337.       MLREEL=MLAM1
  1338.       MLREE1=IVGE
  1339.       MLREE2=IVGM
  1340.       MLREE3=IVGP
  1341.       SEGSUP MLREEL,MLREE1,MLREE2,MLREE3
  1342.       IF( IT0.NE.0) THEN
  1343.         MLREEL=IT0
  1344.         SEGSUP MLREEL
  1345.       ENDIF
  1346.       IF( IS0.NE.0) THEN
  1347.         MLREEL=IS0
  1348.         SEGSUP MLREEL
  1349.       ENDIF
  1350.       RETURN
  1351.  1000 CONTINUE
  1352.       CALL ERREUR(19)
  1353.       RETURN
  1354.       END
  1355.  
  1356.  
  1357.  
  1358.  
  1359.  
  1360.  
  1361.  
  1362.  
  1363.  
  1364.  
  1365.  

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