Télécharger la plaquette Cast3M


fr en

Télécharger mma.eso

Retour à la liste

Numérotation des lignes : 

mma

  1. C MMA       SOURCE    FD218221  26/10/07    21:15:07     12662          
  2.       SUBROUTINE MMA
  3.  
  4. C     Gestion de l'operateur MMA (Method of Moving Asymptotes)
  5. C
  6. C     Effectue une iteration de la methode :
  7. C     - transofrme le probleme d'optimisation complexe (non lineaire)
  8. C       en un sous-probleme strictement convexe (MMASUB ou GCMMASUB)
  9. C     - resout ce sous-probleme (SUBSOLVE)
  10.  
  11.  
  12.  
  13. C     Typages implicites habituels
  14.       IMPLICIT INTEGER(I-N)
  15.       IMPLICIT REAL*8 (A-H,O-Z)
  16.  
  17. C     Les includes necessaires
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC CCREEL
  21. -INC SMLREEL
  22. -INC SMLOBJE
  23. -INC SMTABLE
  24.  
  25. C     N    : nombre de variables   du probleme d'optimisation
  26. C     M    : nombre de contraintes du probleme d'optimisation
  27. C     NMAT : taille de la matrice du systeme lineaire dans SUBSOLVE
  28. C            NMAT = MIN(N,M) + 1
  29. C     NR   : taille du vecteur residu pour les conditions kkt
  30. C            NR   = 4M + 3N + 2
  31.  
  32. C     Segment des tableaux de travail pour MMASUB
  33.       SEGMENT KMMA
  34.         REAL*8  XVAL(N),XMIN(N),XMAX(N),XOLD1(N),XOLD2(N)
  35.         REAL*8  DF0DX(N),FVAL(M),DFDX(M,N),FAPP(M)
  36.         REAL*8  LOW(N),UPP(N),ALFA(N),BETA(N)
  37.         REAL*8  P0(N),Q0(N),P(M,N),Q(M,N),A(M),B(M),C(M),D(M)
  38.         REAL*8  XMMA(N),YMMA(M),LAM(M),XSI(N),ETA(N),MU(M),S(M)
  39.       ENDSEGMENT
  40.  
  41. C     Segment des tableaux de travail pour GCMMASUB
  42.       SEGMENT KGCMMA
  43.         REAL*8  RAA(M),RAAEPS(M),FVALNEW(M)
  44.       ENDSEGMENT
  45.  
  46. C     Segment des tableaux de travail pour SUBSOLVE
  47.       SEGMENT KSUB
  48.         INTEGER IPIV(NMAT)
  49.         REAL*8   XS(N), YS(M), LAMS(M), XSIS(N), ETAS(N), MUS(M), SS(M)
  50.         REAL*8  DXS(N),DYS(M),DLAMS(M),DXSIS(N),DETAS(N),DMUS(M),DSS(M)
  51.         REAL*8   XO(N), YO(M), LAMO(M), XSIO(N), ETAO(N), MUO(M), SO(M)
  52.         REAL*8  PLAM(N),QLAM(N),GVEC(M),GG(M,N)
  53.         REAL*8  DIAGX(N),DIAGXINV(N),DIAGY(M),DIAGYINV(M)
  54.         REAL*8  DIAGLAM(M),DIAGLAMYI(M),DIAGLAMYIINV(M)
  55.         REAL*8  DELX(N),DELY(M),DELLAM(M),DELLAMYI(M)
  56.         REAL*8  AA(NMAT,NMAT),BB(NMAT)
  57.         REAL*8  RESIDU(NR)
  58.       ENDSEGMENT
  59.  
  60. C     Autres variables scalaires
  61.       REAL*8 ZMMA,ZET,R0,F0APP,F0VALNEW
  62.  
  63. C     Indicateurs pour la GCMMA
  64.       LOGICAL BGCMMA,BCONS
  65.       INTEGER SSITER
  66.  
  67. C     Variables pour la lecture/ecriture dans les objets TABLE
  68.       LOGICAL BIND,BVALE
  69.       CHARACTER*1 MOTVAL
  70.       CHARACTER*8 TYPE,MOT1
  71.  
  72. C     Parametres de la methode
  73.       REAL*8 MOVE,ALBEFA,RAA0,ASYINIT,ASYINCR,ASYDECR,ASYMIN,ASYMAX
  74.       REAL*8 EPSIMIN
  75. C     Listes des noms (MOTPAR1, MOTPAR2), des valeurs par defaut
  76. C     (VAPDEF1, VAPDEF2) et des valeurs lues (VALPAR2)
  77.       PARAMETER    (NPAR1=4,NPAR2=9)
  78.       CHARACTER*2  MOTPAR1(NPAR1)
  79.       CHARACTER*8  MOTPAR2(NPAR2)
  80.       REAL*8       VAPDEF1(NPAR1),VAPDEF2(NPAR2),VALPAR2(NPAR2)
  81.       DATA MOTPAR1 /'A0'     ,'A'     ,'C'     ,'D'/
  82.       DATA VAPDEF1 /1.0D0    ,0.0D0   ,1.0D4   ,1.0D0/
  83.       DATA MOTPAR2 /'MOVE'   ,'ALBEFA','RAA0'  ,'ASYINIT','ASYINCR',
  84.      &              'ASYDECR','ASYMIN','ASYMAX','EPSIMIN'/
  85.       DATA VAPDEF2 /0.1D0    ,0.1D0   ,1.0D-5  ,0.5D0    ,1.2D0,
  86.      &              0.7D0    ,0.01D0  ,10.D0   ,1.0D-7/
  87.       DATA RAADEF  /1.0D-5/
  88.  
  89.  
  90.  
  91.  
  92. C----------- A C Q U I S I T I O N   D E S   D O N N E E S ------------C
  93. C                  E T   P R E P A R A T I O N   D E S                 C
  94. C                 T A B L E A U X   D E   T R A V A I L                C
  95.  
  96. C     Acquisition des donnees d'entree utilisateur
  97. C---- La table principale
  98.       CALL LIROBJ('TABLE',ITAB,1,IRETOU)
  99.       IF(IERR.NE.0) RETURN
  100. C---- Vecteur des inconnues : X
  101.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'X',BIND,IOIND,
  102.      &            'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  103.       IF (IERR.NE.0) GOTO 999
  104.       SEGACT MLREE1
  105. C     Nombre d'inconnues : N
  106.       N=MLREE1.PROG(/1)
  107.       IF (N.LT.1) THEN
  108.         CALL ERREUR(641)
  109.         RETURN
  110.       ENDIF
  111. C---- Vecteur des fonctions contraintes en X : FVAL
  112.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'FVAL',BIND,IOIND,
  113.      &            'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE2)
  114.       IF (IERR.NE.0) GOTO 999
  115.       SEGACT MLREE2
  116. C     Nombre de fonctions contraintes : M
  117.       M=MLREE2.PROG(/1)
  118.       IF (M.LT.1) THEN
  119.         CALL ERREUR(641)
  120.         RETURN
  121.       ENDIF
  122. C---- Initialisation du segment pour la MMA
  123.       SEGINI KMMA
  124. C     Remplissage des premiers tableaux du segment
  125.       DO I=1,N
  126.         XVAL(I)=MLREE1.PROG(I)
  127.       ENDDO
  128.       DO J=1,M
  129.         FVAL(J)=MLREE2.PROG(J)
  130.       ENDDO
  131.       IXVAL=MLREE1
  132.       SEGDES MLREE1,MLREE2
  133. C---- Numero d'iteration : ITER (facultatif, defaut = 0)
  134.       TYPE='        '
  135.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'ITER',BIND,IOIND,
  136.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  137.       IF (IERR.NE.0) GOTO 999
  138.       IF (TYPE.EQ.'ENTIER  ') THEN
  139.         ITER=IVALE
  140.       ELSE
  141.         ITER=0
  142.       ENDIF
  143. C---- Vecteur des bornes inferieures : XMIN (LISTREEL ou FLOTTANT)
  144.       TYPE='        '
  145.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'XMIN',BIND,IOIND,
  146.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  147.       IF (IERR.NE.0) GOTO 999
  148. C     Si on a lu un LISTREEL, on le prend
  149.       IF (TYPE.EQ.'LISTREEL') THEN
  150.         MLREE1=IOVALE
  151.         SEGACT MLREE1
  152.         IF (MLREE1.PROG(/1).NE.N) THEN
  153.           write(ioimp,*) 'Mauvaise dimension pour XMIN'
  154.           INTERR(1)=N
  155.           CALL ERREUR(1158)
  156.           RETURN
  157.         ENDIF
  158.         DO I=1,N
  159.           XMIN(I)=MLREE1.PROG(I)
  160.         ENDDO
  161.         SEGDES MLREE1
  162. C     Si on a lu un FLOTTANT, on l'utilise pour toutes les inconnues
  163.       ELSEIF (TYPE.EQ.'FLOTTANT') THEN
  164.         DO I=1,N
  165.           XMIN(I)=XVALE
  166.         ENDDO
  167. C     Dans les autres cas, erreur
  168.       ELSE
  169.         MOTERR(1:11)='XMIN'
  170.         MOTERR(12:20)='LISTREEL'
  171.         CALL ERREUR(627)
  172.         RETURN
  173.       ENDIF
  174. C---- Vecteur des bornes superieures : XMAX (LISTREEL ou FLOTTANT)
  175.       TYPE='        '
  176.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'XMAX',BIND,IOIND,
  177.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  178.       IF (IERR.NE.0) GOTO 999
  179. C     Si on a lu un LISTREEL, on le prend
  180.       IF (TYPE.EQ.'LISTREEL') THEN
  181.         MLREE1=IOVALE
  182.         SEGACT MLREE1
  183.         IF (MLREE1.PROG(/1).NE.N) THEN
  184.           write(ioimp,*) 'Mauvaise dimension pour XMAX'
  185.           INTERR(1)=N
  186.           CALL ERREUR(1158)
  187.           RETURN
  188.         ENDIF
  189.         DO I=1,N
  190.           XMAX(I)=MLREE1.PROG(I)
  191.         ENDDO
  192.         SEGDES MLREE1
  193. C     Si on a lu un FLOTTANT, on l'utilise pour toutes les inconnues
  194.       ELSEIF (TYPE.EQ.'FLOTTANT') THEN
  195.         DO I=1,N
  196.           XMAX(I)=XVALE
  197.         ENDDO
  198. C     Dans les autres cas, erreur
  199.       ELSE
  200.         MOTERR(1:11)='XMAX'
  201.         MOTERR(12:20)='LISTREEL'
  202.         CALL ERREUR(627)
  203.         RETURN
  204.       ENDIF
  205. C---- Vecteur des inconnues precedentes : XOLD1 (facultatif, defaut = X)
  206.       TYPE='        '
  207.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'XOLD1',BIND,IOIND,
  208.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  209.       IF (IERR.NE.0) GOTO 999
  210.       IF (TYPE.NE.'LISTREEL') THEN
  211.         MLREE1=IXVAL
  212.       ENDIF
  213.       SEGACT MLREE1
  214.       IF (MLREE1.PROG(/1).NE.N) THEN
  215.         write(ioimp,*) 'Mauvaise dimension pour XOLD1'
  216.         INTERR(1)=N
  217.         CALL ERREUR(1158)
  218.         RETURN
  219.       ENDIF
  220.       DO I=1,N
  221.         XOLD1(I)=MLREE1.PROG(I)
  222.       ENDDO
  223.       IXOLD1=MLREE1
  224.       SEGDES MLREE1
  225. C---- Vecteur des inconnues precedentes : XOLD2 (facultatif, defaut = XOLD1)
  226.       TYPE='        '
  227.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'XOLD2',BIND,IOIND,
  228.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  229.       IF (IERR.NE.0) GOTO 999
  230.       IF (TYPE.NE.'LISTREEL') THEN
  231.           MLREE1=IXOLD1
  232.       ENDIF
  233.       SEGACT MLREE1
  234.       IF (MLREE1.PROG(/1).NE.N) THEN
  235.         write(ioimp,*) 'Mauvaise dimension pour XOLD2'
  236.         INTERR(1)=N
  237.         CALL ERREUR(1158)
  238.         RETURN
  239.       ENDIF
  240.       DO I=1,N
  241.         XOLD2(I)=MLREE1.PROG(I)
  242.       ENDDO
  243.       SEGDES MLREE1
  244. C---- Vecteur des asymptotes inferieures : LOW (facultatif, defaut = XMIN)
  245.       TYPE='        '
  246.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'LOW',BIND,IOIND,
  247.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  248.       IF (IERR.NE.0) GOTO 999
  249.       IF (TYPE.EQ.'LISTREEL') THEN
  250.         SEGACT MLREE1
  251.         IF (MLREE1.PROG(/1).NE.N) THEN
  252.           write(ioimp,*) 'Mauvaise dimension pour LOW'
  253.           INTERR(1)=N
  254.           CALL ERREUR(1158)
  255.           RETURN
  256.         ENDIF
  257.         DO I=1,N
  258.           LOW(I)=MLREE1.PROG(I)
  259.         ENDDO
  260.         SEGDES MLREE1
  261.       ELSE
  262.         LOW=XMIN
  263.       ENDIF
  264. C---- Vecteur des asymptotes superieures : UPP (facultatif, defaut = XMAX)
  265.       TYPE='        '
  266.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'UPP',BIND,IOIND,
  267.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  268.       IF (IERR.NE.0) GOTO 999
  269.       IF (TYPE.EQ.'LISTREEL') THEN
  270.         SEGACT MLREE1
  271.         IF (MLREE1.PROG(/1).NE.N) THEN
  272.           write(ioimp,*) 'Mauvaise dimension pour UPP'
  273.           GOTO 999
  274.         ENDIF
  275.         DO I=1,N
  276.           UPP(I)=MLREE1.PROG(I)
  277.         ENDDO
  278.         SEGDES MLREE1
  279.       ELSE
  280.         UPP=XMAX
  281.       ENDIF
  282. C---- Valeur de la fonction objectif F0 : F0VAL
  283.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'F0VAL',BIND,IOIND,
  284.      &            'FLOTTANT',IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  285.       IF (IERR.NE.0) GOTO 999
  286.       F0VAL=XVALE
  287. C---- Vecteur des derivees partielles dF0/dxi : DF0DX
  288.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'DF0DX',BIND,IOIND,
  289.      &            'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  290.       IF (IERR.NE.0) GOTO 999
  291.       SEGACT MLREE1
  292.       IF (MLREE1.PROG(/1).NE.N) THEN
  293.         write(ioimp,*) 'Mauvaise dimension pour DF0DX'
  294.         INTERR(1)=N
  295.         CALL ERREUR(1158)
  296.         RETURN
  297.       ENDIF
  298.       DO I=1,N
  299.         DF0DX(I)=MLREE1.PROG(I)
  300.       ENDDO
  301.       SEGDES MLREE1
  302. C---- Matrice des derivees partielles dFj/dxi : DFDX
  303.       TYPE='        '
  304.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'DFDX',BIND,IOIND,
  305.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  306.       IF (IERR.NE.0) GOTO 999
  307. C     Si on a lu une TABLE, on la parcourt
  308.       IF (TYPE.EQ.'TABLE') THEN
  309.         MTAB1=IOVALE
  310.         SEGACT MTAB1
  311.         DO J=1,M
  312.           CALL ACCTAB(MTAB1,'ENTIER  ',J,XIND,' ',BIND,IOIND,
  313.      &                'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  314.           IF (IERR.NE.0) GOTO 999
  315.           SEGACT MLREE1
  316.           IF (MLREE1.PROG(/1).NE.N) THEN
  317.             write(ioimp,*) 'Mauvaise dimension pour la liste DFDX . ',J
  318.             INTERR(1)=N
  319.             CALL ERREUR(1158)
  320.             RETURN
  321.           ENDIF
  322.           DO I=1,N
  323.             DFDX(J,I)=MLREE1.PROG(I)
  324.           ENDDO
  325.           SEGDES MLREE1
  326.         ENDDO
  327.         SEGDES MTAB1
  328. C     Si on a lu un LISTOBJE, on le parcourt
  329.       ELSEIF (TYPE.EQ.'LISTOBJE') THEN
  330.         MLOBJ1=IOVALE
  331.         SEGACT MLOBJ1
  332.         IF (MLOBJ1.TYPOBJ.NE.'LISTREEL') THEN
  333.           MOTERR(1:8)='LISTREEL'
  334.           CALL ERREUR(1156)
  335.           RETURN
  336.         ENDIF
  337.         IF (MLOBJ1.LISOBJ(/1).NE.M) THEN
  338.           write(ioimp,*) 'Mauvaise dimension pour DFDX'
  339.           INTERR(1)=M
  340.           CALL ERREUR(1157)
  341.           RETURN
  342.         ENDIF
  343.         DO J=1,M
  344.           MLREE1=MLOBJ1.LISOBJ(J)
  345.           SEGACT MLREE1
  346.           IF (MLREE1.PROG(/1).NE.N) THEN
  347.             write(ioimp,*) 'Mauvaise dimension pour la liste ',J,
  348.      &                     ' de DFDX'
  349.             INTERR(1)=N
  350.             CALL ERREUR(1158)
  351.             RETURN
  352.             GOTO 999
  353.           ENDIF
  354.           DO I=1,N
  355.             DFDX(J,I)=MLREE1.PROG(I)
  356.           ENDDO
  357.           SEGDES MLREE1
  358.         ENDDO
  359.         SEGDES MLOBJ1
  360. C     Dans les autres cas, erreur
  361.       ELSE
  362.         MOTERR(1:11)='DFDX'
  363.         MOTERR(12:20)='LISTOBJE'
  364.         CALL ERREUR(627)
  365.         RETURN
  366.       ENDIF
  367. C---- Valeur du coefficient A0 : A0 (facultatif, defaut = voir VAPDEF1)
  368.       TYPE='        '
  369.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'A0',BIND,IOIND,
  370.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  371.       IF (IERR.NE.0) GOTO 999
  372.       IF (TYPE.EQ.'FLOTTANT') THEN
  373.         A0=XVALE
  374.       ELSE
  375.         A0=VAPDEF1(1)
  376.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'A0',BIND,IOIND,
  377.      &              'FLOTTANT',IVALE,A0,MOTVAL,BVALE,IOVALE)
  378.       ENDIF
  379. C---- Vecteur des coefficients A : A (facultatif, defaut = voir VAPDEF1)
  380.       TYPE='        '
  381.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'A',BIND,IOIND,
  382.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  383.       IF (IERR.NE.0) GOTO 999
  384. C     Si on a lu un LISTREEL, on le prend
  385.       IF (TYPE.EQ.'LISTREEL') THEN
  386.         MLREE1=IOVALE
  387.         SEGACT MLREE1
  388.         IF (MLREE1.PROG(/1).NE.M) THEN
  389.           write(ioimp,*) 'Mauvaise dimension pour A'
  390.           INTERR(1)=M
  391.           CALL ERREUR(1158)
  392.           RETURN
  393.         ENDIF
  394.         DO I=1,M
  395.           A(I)=MLREE1.PROG(I)
  396.         ENDDO
  397.         SEGDES MLREE1
  398. C     Si on a lu un FLOTTANT, on l'utilise pour toutes les contraintes
  399.       ELSEIF (TYPE.EQ.'FLOTTANT') THEN
  400.         DO I=1,M
  401.           A(I)=XVALE
  402.         ENDDO
  403. C     Si l'indice n'est pas present, on prend la valeur par defaut
  404.       ELSEIF (TYPE.EQ.'        ') THEN
  405.         JG=M
  406.         SEGINI MLREE1
  407.         DO I=1,M
  408.           MLREE1.PROG(I)=VAPDEF1(2)
  409.           A(I)=VAPDEF1(2)
  410.         ENDDO
  411.         SEGDES MLREE1
  412.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'A',BIND,IOIND,
  413.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  414. C     Dans les autres cas, erreur
  415.       ELSE
  416.         MOTERR(1:11)='A'
  417.         MOTERR(12:20)='LISTREEL'
  418.         CALL ERREUR(627)
  419.         RETURN
  420.       ENDIF
  421. C---- Vecteur des coefficients C : C (facultatif, defaut = voir VAPDEF1)
  422.       TYPE='        '
  423.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'C',BIND,IOIND,
  424.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  425.       IF (IERR.NE.0) GOTO 999
  426. C     Si on a lu un LISTREEL, on le prend
  427.       IF (TYPE.EQ.'LISTREEL') THEN
  428.         MLREE1=IOVALE
  429.         SEGACT MLREE1
  430.         IF (MLREE1.PROG(/1).NE.M) THEN
  431.           write(ioimp,*) 'Mauvaise dimension pour C'
  432.           INTERR(1)=M
  433.           CALL ERREUR(1158)
  434.           RETURN
  435.         ENDIF
  436.         DO I=1,M
  437.           C(I)=MLREE1.PROG(I)
  438.         ENDDO
  439.         SEGDES MLREE1
  440. C     Si on a lu un FLOTTANT, on l'utilise pour toutes les contraintes
  441.       ELSEIF (TYPE.EQ.'FLOTTANT') THEN
  442.         DO I=1,M
  443.           C(I)=XVALE
  444.         ENDDO
  445. C     Si l'indice n'est pas present, on prend la valeur par defaut
  446.       ELSEIF (TYPE.EQ.'        ') THEN
  447.         JG=M
  448.         SEGINI MLREE1
  449.         DO I=1,M
  450.           MLREE1.PROG(I)=VAPDEF1(3)
  451.           C(I)=VAPDEF1(3)
  452.         ENDDO
  453.         SEGDES MLREE1
  454.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'C',BIND,IOIND,
  455.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  456. C     Dans les autres cas, erreur
  457.       ELSE
  458.         MOTERR(1:11)='C'
  459.         MOTERR(12:20)='LISTREEL'
  460.         CALL ERREUR(627)
  461.         RETURN
  462.       ENDIF
  463. C---- Vecteur des coefficients D : D (facultatif, defaut = voir VAPDEF1)
  464.       TYPE='        '
  465.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'D',BIND,IOIND,
  466.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  467.       IF (IERR.NE.0) GOTO 999
  468. C     Si on a lu un LISTREEL, on le prend
  469.       IF (TYPE.EQ.'LISTREEL') THEN
  470.         MLREE1=IOVALE
  471.         SEGACT MLREE1
  472.         IF (MLREE1.PROG(/1).NE.M) THEN
  473.           write(ioimp,*) 'Mauvaise dimension pour D'
  474.           INTERR(1)=M
  475.           CALL ERREUR(1158)
  476.           RETURN
  477.         ENDIF
  478.         DO I=1,M
  479.           D(I)=MLREE1.PROG(I)
  480.         ENDDO
  481.         SEGDES MLREE1
  482. C     Si on a lu un FLOTTANT, on l'utilise pour toutes les contraintes
  483.       ELSEIF (TYPE.EQ.'FLOTTANT') THEN
  484.         DO I=1,M
  485.           D(I)=XVALE
  486.         ENDDO
  487. C     Si l'indice n'est pas present, on prend la valeur par defaut
  488.       ELSEIF (TYPE.EQ.'        ') THEN
  489.         JG=M
  490.         SEGINI MLREE1
  491.         DO I=1,M
  492.           MLREE1.PROG(I)=VAPDEF1(4)
  493.           D(I)=VAPDEF1(4)
  494.         ENDDO
  495.         SEGDES MLREE1
  496.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'D',BIND,IOIND,
  497.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  498. C     Dans les autres cas, erreur
  499.       ELSE
  500.         MOTERR(1:11)='D'
  501.         MOTERR(12:20)='LISTREEL'
  502.         CALL ERREUR(627)
  503.         RETURN
  504.       ENDIF
  505. C---- Parametres de mise a jour des asymptotes (facultatifs)
  506. C     Noms et valeurs par defaut = voir les DATA MOTPAR2 et VAPDEF2
  507.       DO I=1,NPAR2
  508.         TYPE='        '
  509.         MOT1=MOTPAR2(I)
  510.         CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,MOT1,BIND,IOIND,
  511.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  512.         IF (IERR.NE.0) GOTO 999
  513.         IF (TYPE.EQ.'FLOTTANT') THEN
  514.           VALPAR2(I)=XVALE
  515.         ELSE
  516.           VALPAR2(I)=VAPDEF2(I)
  517.           XVALE=VALPAR2(I)
  518.         ENDIF
  519.       ENDDO
  520. C---- Option "Globaly Convergent" : GC (facultatif, defaut = FAUX)
  521.       BGCMMA=.FALSE.
  522.       TYPE='        '
  523.       CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'GC',BIND,IOIND,
  524.      &            TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  525.       IF (IERR.NE.0) GOTO 999
  526.       IF (TYPE.EQ.'LOGIQUE ') THEN
  527.         BGCMMA=BVALE
  528.       ENDIF
  529.       IF (BGCMMA) THEN
  530. C------ Initialisation du segment pour la GCMMA
  531.         SEGINI KGCMMA
  532. C - - - Logique indiquant le conservatisme : CONSERV (facultatif, defaut = VRAI)
  533.         TYPE='        '
  534.         CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'CONSERV',BIND,IOIND,
  535.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  536.         IF (IERR.NE.0) GOTO 999
  537.         IF (TYPE.EQ.'LOGIQUE') THEN
  538.           BCONS=BVALE
  539.         ELSE
  540.           BCONS=.TRUE.
  541.         ENDIF
  542. C - - - Parametres RAA (controle des asymptotes du sous probleme)
  543.         TYPE='        '
  544.         CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  545.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  546.         IF (IERR.NE.0) GOTO 999
  547. C       Si on a lu un LISTREEL, on le prend
  548.         IF (TYPE.EQ.'LISTREEL') THEN
  549.           MLREE1=IOVALE
  550.           SEGACT MLREE1
  551.           IF (MLREE1.PROG(/1).NE.M) THEN
  552.             write(ioimp,*) 'Mauvaise dimension pour RAA'
  553.             INTERR(1)=M
  554.             CALL ERREUR(1158)
  555.             RETURN
  556.           ENDIF
  557.           DO I=1,M
  558.             RAA(I)=MLREE1.PROG(I)
  559.           ENDDO
  560.           SEGDES MLREE1
  561. C       Si on a lu un FLOTTANT, on l'utilise
  562.         ELSEIF (TYPE.EQ.'FLOTTANT') THEN
  563.           DO I=1,M
  564.             RAA(I)=XVALE
  565.           ENDDO
  566. C       Si l'indice n'est pas present, on prend la valeur par defaut
  567.         ELSEIF (TYPE.EQ.'        ') THEN
  568.           JG=M
  569.           SEGINI MLREE1
  570.           DO I=1,M
  571.             MLREE1.PROG(I)=RAADEF
  572.             RAA(I)=RAADEF
  573.           ENDDO
  574.           SEGDES MLREE1
  575.           CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  576.      &                'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  577. C       Dans les autres cas, erreur
  578.         ELSE
  579.           MOTERR(1:11)='RAA'
  580.           MOTERR(12:20)='LISTREEL'
  581.           CALL ERREUR(627)
  582.           RETURN
  583.         ENDIF
  584. C - - - Table de travail : WTABLE
  585.         TYPE='        '
  586.         CALL ACCTAB(ITAB,'MOT     ',IIND,XIND,'WTABLE',BIND,IOIND,
  587.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  588.         IF (IERR.NE.0) GOTO 999
  589. C       Si la table existe, on la prend
  590.         IF (TYPE.EQ.'TABLE') THEN
  591.           IWTAB=IOVALE
  592. C       Sinon, on l'initialise
  593.         ELSE
  594.           RAA0=VALPAR2(3)
  595.           JG=M
  596.           SEGINI MLREE3
  597.           DO I=1,M
  598.             MLREE3.PROG(I)=RAA(I)
  599.           ENDDO
  600.           SEGDES MLREE3
  601.           MBACKUP=M
  602.           M=0
  603.           SEGINI MTAB1
  604.           M=MBACKUP
  605.           IWTAB=MTAB1
  606.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA0',BIND,IOIND,
  607.      &                'FLOTTANT',IVALE,RAA0,MOTVAL,BVALE,IOIND)
  608.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  609.      &                'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  610.           CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'WTABLE',BIND,IOIND,
  611.      &                'TABLE   ',IVALE,XVALE,MOTVAL,BVALE,IWTAB)
  612.         ENDIF
  613. C - - - Numero de sous iteration : SSITER (dans WTABLE)
  614.         TYPE='        '
  615.         CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'ITER',BIND,IOIND,
  616.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  617.         IF (IERR.NE.0) GOTO 999
  618.         IF (TYPE.EQ.'ENTIER') THEN
  619.           SSITER=IVALE
  620.         ELSE
  621.           SSITER=0
  622.         ENDIF
  623. C - - - Parametre RAA0 (dans WTABLE)
  624.         TYPE='FLOTTANT'
  625.         CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA0',BIND,IOIND,
  626.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  627.         IF (IERR.NE.0) GOTO 999
  628.         RAA0=XVALE
  629.         VALPAR2(3)=RAA0
  630. C - - - Parametres RAA (dans WTABLE)
  631.         TYPE='LISTREEL'
  632.         CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  633.      &              TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  634.         IF (IERR.NE.0) GOTO 999
  635.         MLREE3=IOVALE
  636.         SEGACT MLREE3
  637.         DO I=1,M
  638.           RAA(I)=MLREE3.PROG(I)
  639.         ENDDO
  640.         SEGDES MLREE3
  641.       ENDIF
  642.  
  643.  
  644.  
  645.  
  646. C----------- O P T I M I S A T I O N   P A R   L A   M M A ------------C
  647.  
  648. C     Recuperation des valeurs des parametres
  649.       MOVE   =VALPAR2(1)
  650.       ALBEFA =VALPAR2(2)
  651.       RAA0   =VALPAR2(3)
  652.       ASYINIT=VALPAR2(4)
  653.       ASYINCR=VALPAR2(5)
  654.       ASYDECR=VALPAR2(6)
  655.       ASYMIN =VALPAR2(7)
  656.       ASYMAX =VALPAR2(8)
  657.       EPSIMIN=VALPAR2(9)
  658.  
  659. C     Cas de la MMA "Globally Convergent"
  660.       IF (BGCMMA) THEN
  661.  
  662. C       Si le precedent probleme conservatif, alors nouvelle iteration
  663.         IF (BCONS) THEN
  664.           ITER=ITER+1
  665. C         Parametres RAA0EPS et RAAEPS
  666.           RAA0EPS=1.0D-6
  667.           DO I=1,M
  668.             RAAEPS(I)=1.0D-6
  669.           ENDDO
  670. C         Mise a jour des asymptotes LOW/UPP et des parametres RAA0 et RAA
  671.           CALL ASYMP(ITER,N,M,XVAL,XOLD1,XOLD2,XMIN,XMAX,
  672.      &               RAA0EPS,RAAEPS,DF0DX,DFDX,
  673.      &               ASYINIT,ASYDECR,ASYINCR,ASYMIN,ASYMAX,
  674.      &               LOW,UPP,RAA0,RAA)
  675. C         Calcul des matrices/vecteurs du sous-probleme convexe
  676.           CALL GCMMASUB(M,N,XVAL,XMIN,XMAX,LOW,UPP,
  677.      &                  F0VAL,DF0DX,FVAL,DFDX,
  678.      &                  RAA0,RAA,ALBEFA,
  679.      &                  ALFA,BETA,P0,Q0,P,Q,B,R0)
  680. C         Resolution du sous-probleme convexe
  681.           NMAT=MIN(M+1,N+1)
  682.           NR=4*M+3*N+2
  683.           SEGINI KSUB
  684.           ISUB=KSUB
  685.           CALL SUBSOLVE(ISUB,BGCMMA,M,N,EPSIMIN,LOW,UPP,ALFA,BETA,
  686.      &                  P0,Q0,P,Q,A0,A,B,C,D,R0,
  687.      &                  XMMA,YMMA,ZMMA,LAM,XSI,ETA,MU,ZET,S,F0APP,FAPP)
  688. C         On part du principe que ce nouveau sous probleme est non conservatif
  689. C         et on initialise le compteur des sous iterations
  690.           BCONS=.FALSE.
  691.           SSITER=0
  692.  
  693. C       Si le precedent probleme n'est pas conservatif, alors on teste
  694. C       si c'est toujours le cas par comparaison entre :
  695. C       - les valeurs approchees des fonctions objectif et contraintes
  696. C       - les nouvelles valeurs  des fonctions objectif et contraintes
  697.         ELSE
  698.           TYPE='FLOTTANT'
  699.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'F0APP',BIND,IOIND,
  700.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  701.           IF (IERR.NE.0) GOTO 999
  702.           F0APP=XVALE
  703.           TYPE='LISTREEL'
  704.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'FAPP',BIND,IOIND,
  705.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  706.           IF (IERR.NE.0) GOTO 999
  707.           MLREE1=IOVALE
  708.           SEGACT MLREE1
  709.           DO I=1,M
  710.             FAPP(I)=MLREE1.PROG(I)
  711.           ENDDO
  712.           SEGDES MLREE1
  713.           TYPE='FLOTTANT'
  714.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'F0VALNEW',BIND,IOIND,
  715.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  716.           IF (IERR.NE.0) GOTO 999
  717.           F0VALNEW=XVALE
  718.           TYPE='LISTREEL'
  719.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'FVALNEW',BIND,IOIND,
  720.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  721.           IF (IERR.NE.0) GOTO 999
  722.           MLREE1=IOVALE
  723.           SEGACT MLREE1
  724.           DO I=1,M
  725.             FVALNEW(I)=MLREE1.PROG(I)
  726.           ENDDO
  727.           SEGDES MLREE1
  728.           CALL CONCHECK(M,EPSIMIN,F0APP,F0VALNEW,FAPP,FVALNEW,BCONS)
  729.  
  730. C         Si probleme non conservatif, alors on fait une sous iteration
  731. C         en resserant les asymptotes
  732.           IF (.NOT.BCONS) THEN
  733.             SSITER=SSITER+1
  734. C           Recuperation de la solution de la precedente sous iteration (WTABLE)
  735.             TYPE='LISTREEL'
  736.             CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'X',BIND,IOIND,
  737.      &                  TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  738.             IF (IERR.NE.0) GOTO 999
  739.             MLREE1=IOVALE
  740.             SEGACT MLREE1
  741.             DO I=1,N
  742.               XMMA(I)=MLREE1.PROG(I)
  743.             ENDDO
  744. C           Mise a jour de RAA0 et RAA pour tenter d'avoir un probleme conservatif
  745.             CALL RAAUPDT(N,M,XMMA,XVAL,XMIN,XMAX,LOW,UPP,
  746.      &                   F0VALNEW,FVALNEW,F0APP,FAPP,EPSIMIN,
  747.      &                   RAA0,RAA)
  748. C           Resolution du nouveau sous probleme
  749.             CALL GCMMASUB(M,N,XVAL,XMIN,XMAX,LOW,UPP,
  750.      &                  F0VAL,DF0DX,FVAL,DFDX,
  751.      &                  RAA0,RAA,ALBEFA,ALFA,BETA,P0,Q0,P,Q,B,R0)
  752. C           Resolution du sous-probleme convexe
  753.             NMAT=MIN(M+1,N+1)
  754.             NR=4*M+3*N+2
  755.             SEGINI KSUB
  756.             ISUB=KSUB
  757.             CALL SUBSOLVE(ISUB,BGCMMA,M,N,EPSIMIN,LOW,UPP,ALFA,BETA,
  758.      &                   P0,Q0,P,Q,A0,A,B,C,D,R0,
  759.      &                   XMMA,YMMA,ZMMA,LAM,XSI,ETA,MU,ZET,S,F0APP,FAPP)
  760. C           On part du principe que ce nouveau sous probleme est non conservatif
  761.             BCONS=.FALSE.
  762.           ENDIF
  763.         ENDIF
  764.  
  765. C     Cas de la MMA "classique"
  766.       ELSE
  767.         ITER=ITER+1
  768. C       Calcul des matrices/vecteurs du sous-probleme convexe
  769.         CALL MMASUB(M,N,ITER,XVAL,XMIN,XMAX,XOLD1,XOLD2,
  770.      &              DF0DX,FVAL,DFDX,MOVE,ALBEFA,RAA0,
  771.      &              ASYINIT,ASYINCR,ASYDECR,ASYMIN,ASYMAX,
  772.      &              LOW,UPP,ALFA,BETA,P0,Q0,P,Q,B)
  773. C       Resolution du sous-probleme convexe
  774.         NMAT=MIN(M+1,N+1)
  775.         NR=4*M+3*N+2
  776.         SEGINI KSUB
  777.         ISUB=KSUB
  778.         CALL SUBSOLVE(ISUB,BGCMMA,M,N,EPSIMIN,LOW,UPP,ALFA,BETA,
  779.      &                P0,Q0,P,Q,A0,A,B,C,D,R0,
  780.      &                XMMA,YMMA,ZMMA,LAM,XSI,ETA,MU,ZET,S,F0APP,FAPP)
  781.       ENDIF
  782.  
  783.  
  784.  
  785.  
  786. C------------ E C R I T U R E   D E S   R E S U L T A T S -------------C
  787.  
  788. C     Dans tous les cas
  789. C---- Numero d'iteration : ITER
  790.       CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'ITER',BIND,IOIND,
  791.      &            'ENTIER  ',ITER,XVALE,MOTVAL,BVALE,IOVALE)
  792. C---- Vecteur des asymptotes inferieures : LOW <-- LOW
  793.       JG=N
  794.       SEGINI MLREE1
  795.       DO I=1,N
  796.         MLREE1.PROG(I)=LOW(I)
  797.       ENDDO
  798.       CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'LOW',BIND,IOIND,
  799.      &            'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  800.       SEGDES MLREE1
  801. C---- Vecteur des asymptotes inferieures : UPP <-- UPP
  802.       JG=N
  803.       SEGINI MLREE1
  804.       DO I=1,N
  805.         MLREE1.PROG(I)=UPP(I)
  806.       ENDDO
  807.       CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'UPP',BIND,IOIND,
  808.      &            'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  809.       SEGDES MLREE1
  810.  
  811. C     Dans le cas de la MMA ou bien la GCMMA conservative
  812.       IF ((.NOT.BGCMMA).OR.(BCONS)) THEN
  813. C------ Vecteur des inconnues : X <-- XMMA
  814.         IF (.NOT.BGCMMA) THEN
  815.           JG=N
  816.           SEGINI MLREE1
  817.           DO I=1,N
  818.             MLREE1.PROG(I)=XMMA(I)
  819.           ENDDO
  820.         ELSEIF (BCONS) THEN
  821.           TYPE='LISTREEL'
  822.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'X',BIND,IOIND,
  823.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  824.           IF (IERR.NE.0) GOTO 999
  825.           MLREE1=IOVALE
  826.         ENDIF
  827.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'X',BIND,IOIND,
  828.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  829.         SEGDES MLREE1
  830. C------ Vecteur des inconnues precedentes : XOLD1 <-- XVAL
  831.         MLREE1=IXVAL
  832.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'XOLD1',BIND,IOIND,
  833.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  834.         SEGDES MLREE1
  835. C------ Vecteur des inconnues precedentes : XOLD2 <-- XOLD1
  836.         MLREE1=IXOLD1
  837.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'XOLD2',BIND,IOIND,
  838.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  839.         SEGDES MLREE1
  840. C------ Vecteurs des multiplicateurs de Lagrange (Y,Z,LAM,XSI,ETA,MU,ZET,S)
  841. C       Pour la MMA classique, ils viennent d'etre calcules
  842. C       Pour la GCMMA, ils sont stockes dans WTABLE
  843. C       Vecteur Y (variables y_j optimales)
  844.         IF (.NOT.BGCMMA) THEN
  845.           JG=M
  846.           SEGINI MLREE1
  847.           DO I=1,M
  848.             MLREE1.PROG(I)=YMMA(I)
  849.           ENDDO
  850.         ELSEIF (BCONS) THEN
  851.           TYPE='LISTREEL'
  852.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'Y',BIND,IOIND,
  853.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  854.           IF (IERR.NE.0) GOTO 999
  855.           MLREE1=IOVALE
  856.         ENDIF
  857.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'Y',BIND,IOIND,
  858.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  859.         SEGDES MLREE1
  860. C       Scalaire ZMMA (variable z optimale)
  861.         IF (.NOT.BGCMMA) THEN
  862.           XVALE=ZMMA
  863.         ELSEIF (BCONS) THEN
  864.           TYPE='FLOTTANT'
  865.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'Z',BIND,IOIND,
  866.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  867.           IF (IERR.NE.0) GOTO 999
  868.         ENDIF
  869.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'Z',BIND,IOIND,
  870.      &              'FLOTTANT',IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  871. C       Vecteur LAM (multiplicateurs de Lagrange pour les contraintes f_i)
  872.         IF (.NOT.BGCMMA) THEN
  873.           JG=M
  874.           SEGINI MLREE1
  875.           DO I=1,M
  876.             MLREE1.PROG(I)=LAM(I)
  877.           ENDDO
  878.         ELSEIF (BCONS) THEN
  879.           TYPE='LISTREEL'
  880.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'LAMBDA',BIND,IOIND,
  881.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  882.           IF (IERR.NE.0) GOTO 999
  883.           MLREE1=IOVALE
  884.         ENDIF
  885.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'LAMBDA',BIND,IOIND,
  886.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  887.         SEGDES MLREE1
  888. C       Vecteur XSI (multiplicateurs de Lagrange pour les bornes inferieures)
  889.         IF (.NOT.BGCMMA) THEN
  890.           JG=N
  891.           SEGINI MLREE1
  892.           DO I=1,N
  893.             MLREE1.PROG(I)=XSI(I)
  894.           ENDDO
  895.         ELSEIF (BCONS) THEN
  896.           TYPE='LISTREEL'
  897.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'XSI',BIND,IOIND,
  898.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  899.           IF (IERR.NE.0) GOTO 999
  900.           MLREE1=IOVALE
  901.         ENDIF
  902.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'XSI',BIND,IOIND,
  903.      &             'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  904.         SEGDES MLREE1
  905. C       Vecteur ETA (multiplicateurs de Lagrange pour les bornes superieures)
  906.         IF (.NOT.BGCMMA) THEN
  907.           JG=N
  908.           SEGINI MLREE1
  909.           DO I=1,N
  910.             MLREE1.PROG(I)=ETA(I)
  911.           ENDDO
  912.         ELSEIF (BCONS) THEN
  913.           TYPE='LISTREEL'
  914.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'ETA',BIND,IOIND,
  915.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  916.           IF (IERR.NE.0) GOTO 999
  917.           MLREE1=IOVALE
  918.         ENDIF
  919.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'ETA',BIND,IOIND,
  920.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  921.         SEGDES MLREE1
  922. C       Vecteur MU (multiplicateurs de Lagrange y_i > 0)
  923.         IF (.NOT.BGCMMA) THEN
  924.           JG=M
  925.           SEGINI MLREE1
  926.           DO I=1,M
  927.             MLREE1.PROG(I)=MU(I)
  928.           ENDDO
  929.         ELSEIF (BCONS) THEN
  930.           TYPE='LISTREEL'
  931.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'MU',BIND,IOIND,
  932.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  933.           IF (IERR.NE.0) GOTO 999
  934.           MLREE1=IOVALE
  935.         ENDIF
  936.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'MU',BIND,IOIND,
  937.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  938.         SEGDES MLREE1
  939. C       Scalaire ZET (multiplicateur de Lagrange pour z > 0)
  940.         IF (.NOT.BGCMMA) THEN
  941.           XVALE=ZET
  942.         ELSEIF (BCONS) THEN
  943.           TYPE='FLOTTANT'
  944.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'ZET',BIND,IOIND,
  945.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  946.           IF (IERR.NE.0) GOTO 999
  947.         ENDIF
  948.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'ZET',BIND,IOIND,
  949.      &              'FLOTTANT',IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  950. C       Vecteur S (variables d'ecart pour les contraintes f_i)
  951.         IF (.NOT.BGCMMA) THEN
  952.           JG=M
  953.           SEGINI MLREE1
  954.           DO I=1,M
  955.             MLREE1.PROG(I)=S(I)
  956.           ENDDO
  957.         ELSEIF (BCONS) THEN
  958.           TYPE='LISTREEL'
  959.           CALL ACCTAB(IWTAB,'MOT     ',IIND,XIND,'S',BIND,IOIND,
  960.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,IOVALE)
  961.           IF (IERR.NE.0) GOTO 999
  962.           MLREE1=IOVALE
  963.         ENDIF
  964.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'S',BIND,IOIND,
  965.      &              'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  966.         SEGDES MLREE1
  967.       ENDIF
  968.  
  969. C     Dans le cas de la GCMMA
  970.       IF (BGCMMA) THEN
  971. C------ Indicateur de conservatisme BCONS
  972.         TYPE='LOGIQUE'
  973.         CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'CONSERV',BIND,IOIND,
  974.      &              TYPE,IVALE,XVALE,MOTVAL,BCONS,IOVALE)
  975.  
  976. C       Dans le cas conservatif
  977.         IF (BCONS) THEN
  978. C-------- On remonte RAA0 dans la table
  979.           TYPE='FLOTTANT'
  980.           CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'RAA0',BIND,IOIND,
  981.      &                TYPE,IVALE,RAA0,MOTVAL,BVALE,IOVALE)
  982. C-------- On remonte le vecteur RAA dans la table
  983.           TYPE='LISTREEL'
  984.           JG=M
  985.           SEGINI MLREE1
  986.           DO I=1,M
  987.             MLREE1.PROG(I)=RAA(I)
  988.           ENDDO
  989.           SEGDES MLREE1
  990.           CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  991.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE1)
  992. C-------- Nettoyage de WTABLE, on ne laisse que RAA0, RAA et aussi ITER mais juste pour info
  993.           JG=M
  994.           SEGINI MLREE3
  995.           DO I=1,M
  996.             MLREE3.PROG(I)=RAA(I)
  997.           ENDDO
  998.           SEGDES MLREE3
  999.           MBACKUP=M
  1000.           M=0
  1001.           SEGINI MTAB1
  1002.           M=MBACKUP
  1003.           IWTAB=MTAB1
  1004.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'ITER',BIND,IOIND,
  1005.      &                'ENTIER',SSITER,XVALE,MOTVAL,BVALE,IOIND)
  1006.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA0',BIND,IOIND,
  1007.      &                'FLOTTANT',IVALE,RAA0,MOTVAL,BVALE,IOIND)
  1008.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  1009.      &                'LISTREEL',IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1010.           CALL ECCTAB(ITAB,'MOT     ',IIND,XIND,'WTABLE',BIND,IOIND,
  1011.      &                'TABLE   ',IVALE,XVALE,MOTVAL,BVALE,IWTAB)
  1012.  
  1013. C       Dans le cas non conservatif
  1014.         ELSE
  1015. C - - - - Entier SSITER (dans WTABLE)
  1016.           TYPE='ENTIER'
  1017.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'ITER',BIND,IOIND,
  1018.      &                TYPE,SSITER,XVALE,MOTVAL,BVALE,IOVALE)
  1019. C - - - - Scalaire RAA0 (dans WTABLE)
  1020.           TYPE='FLOTTANT'
  1021.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA0',BIND,IOIND,
  1022.      &                TYPE,IVALE,RAA0,MOTVAL,BVALE,IOVALE)
  1023. C - - - - Vecteur RAA (dans WTABLE)
  1024.           JG=M
  1025.           SEGINI MLREE3
  1026.           DO I=1,M
  1027.             MLREE3.PROG(I)=RAA(I)
  1028.           ENDDO
  1029.           SEGDES MLREE3
  1030.           TYPE='LISTREEL'
  1031.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'RAA',BIND,IOIND,
  1032.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1033. C - - - - Vecteur X (dans WTABLE)
  1034.           JG=N
  1035.           SEGINI MLREE3
  1036.           DO I=1,N
  1037.             MLREE3.PROG(I)=XMMA(I)
  1038.           ENDDO
  1039.           SEGDES MLREE3
  1040.           TYPE='LISTREEL'
  1041.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'X',BIND,IOIND,
  1042.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1043. C - - - - Vecteur Y (dans WTABLE)
  1044.           JG=M
  1045.           SEGINI MLREE3
  1046.           DO I=1,M
  1047.             MLREE3.PROG(I)=YMMA(I)
  1048.           ENDDO
  1049.           SEGDES MLREE3
  1050.           TYPE='LISTREEL'
  1051.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'Y',BIND,IOIND,
  1052.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1053. C - - - - Scalaire Z (dans WTABLE)
  1054.           TYPE='FLOTTANT'
  1055.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'Z',BIND,IOIND,
  1056.      &                TYPE,IVALE,ZMMA,MOTVAL,BVALE,IOIND)
  1057. C - - - - Vecteur LAMBDA (dans WTABLE)
  1058.           JG=M
  1059.           SEGINI MLREE3
  1060.           DO I=1,M
  1061.             MLREE3.PROG(I)=LAM(I)
  1062.           ENDDO
  1063.           SEGDES MLREE3
  1064.           TYPE='LISTREEL'
  1065.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'LAMBDA',BIND,IOIND,
  1066.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1067. C - - - - Vecteur XSI (dans WTABLE)
  1068.           JG=N
  1069.           SEGINI MLREE3
  1070.           DO I=1,N
  1071.             MLREE3.PROG(I)=XSI(I)
  1072.           ENDDO
  1073.           SEGDES MLREE3
  1074.           TYPE='LISTREEL'
  1075.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'XSI',BIND,IOIND,
  1076.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1077. C - - - - Vecteur ETA (dans WTABLE)
  1078.           JG=N
  1079.           SEGINI MLREE3
  1080.           DO I=1,N
  1081.             MLREE3.PROG(I)=ETA(I)
  1082.           ENDDO
  1083.           SEGDES MLREE3
  1084.           TYPE='LISTREEL'
  1085.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'ETA',BIND,IOIND,
  1086.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1087. C - - - - Vecteur MU (dans WTABLE)
  1088.           JG=M
  1089.           SEGINI MLREE3
  1090.           DO I=1,M
  1091.             MLREE3.PROG(I)=MU(I)
  1092.           ENDDO
  1093.           SEGDES MLREE3
  1094.           TYPE='LISTREEL'
  1095.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'MU',BIND,IOIND,
  1096.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1097. C - - - - Scalaire ZET (dans WTABLE)
  1098.           TYPE='FLOTTANT'
  1099.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'ZET',BIND,IOIND,
  1100.      &                TYPE,IVALE,ZET,MOTVAL,BVALE,IOIND)
  1101. C - - - - Vecteur S (dans WTABLE)
  1102.           JG=M
  1103.           SEGINI MLREE3
  1104.           DO I=1,M
  1105.             MLREE3.PROG(I)=S(I)
  1106.           ENDDO
  1107.           SEGDES MLREE3
  1108.           TYPE='LISTREEL'
  1109.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'S',BIND,IOIND,
  1110.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1111. C - - - - Scalaire F0APP (dans WTABLE)
  1112.           TYPE='FLOTTANT'
  1113.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'F0APP',BIND,IOIND,
  1114.      &                TYPE,IVALE,F0APP,MOTVAL,BVALE,IOIND)
  1115. C - - - - Vecteur FAPP (dans WTABLE)
  1116.           JG=M
  1117.           SEGINI MLREE3
  1118.           DO I=1,M
  1119.             MLREE3.PROG(I)=FAPP(I)
  1120.           ENDDO
  1121.           SEGDES MLREE3
  1122.           TYPE='LISTREEL'
  1123.           CALL ECCTAB(IWTAB,'MOT     ',IIND,XIND,'FAPP',BIND,IOIND,
  1124.      &                TYPE,IVALE,XVALE,MOTVAL,BVALE,MLREE3)
  1125.         ENDIF
  1126.       ENDIF
  1127.  
  1128.  
  1129.  
  1130.  
  1131. C     Suppression des segments de travail
  1132.       SEGSUP KMMA
  1133.       IF (KSUB.GT.0) SEGSUP KSUB
  1134.       IF (BGCMMA) SEGSUP KGCMMA
  1135.  
  1136. C     Fin
  1137.       RETURN
  1138.  
  1139. C     En cas d'erreur
  1140. 999   CONTINUE
  1141.       CALL ERREUR(26)
  1142.       RETURN
  1143.  
  1144.       END
  1145.  
  1146.  

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