Télécharger la plaquette Cast3M


fr en

Télécharger extrai.eso

Retour à la liste

Numérotation des lignes : 

extrai

  1. C EXTRAI    SOURCE    SP204843  24/11/07    21:15:03     12074          
  2.       SUBROUTINE EXTRAI
  3. ************************************************************************
  4. * NOM         : EXTRAI
  5. * DESCRIPTION : OPERATION D'EXTRACTION POUR DIFFERENTS TYPES D'OBJETS
  6. ************************************************************************
  7. * HISTORIQUE :  5/12/1985 : PASCAL MANIGOT : creation de la subroutine
  8. * HISTORIQUE :  MODIFIE EN SEPTEMBRE 1994
  9. * HISTORIQUE :  MODIFIE EN AVRIL 2015 PAR CB215821
  10. *                     ==> Extraire le MAILLAGE d'un MMODEL vide renvoie
  11. *                         un MAILLAGE vide au lieu d'une GEMAT ERROR
  12. *                     ==> Extraire un constituant d'un MMODEL vide
  13. *                         renvoie une erreur au lieu d'une GEMAT ERROR
  14. * HISTORIQUE :  MODIFIE EN JANVIER 2016 PAR JCARDO
  15. *                     ==> ajout de la syntaxe EXTR LCHPO1 "VALE" ...
  16. *                     ==> extention du IF/ELSEIF/ENDIF principal a
  17. *                         tous les objets
  18. *                     ==> amelioration de la lisibilite de la subroutine
  19. ************************************************************************
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC CCGEOME
  26. -INC CCHAMP
  27.  
  28. -INC SMSUPER
  29. -INC SMRIGID
  30. -INC SMELEME
  31. -INC SMCHPOI
  32. -INC SMBASEM
  33. -INC SMTABLE
  34. -INC SMDEFOR
  35. -INC SMMODEL
  36. -INC SMEVOLL
  37. -INC SMLREEL
  38. -INC SMLENTI
  39. -INC SMLMOTS
  40. -INC SMLCHPO
  41. -INC SMNUAGE
  42. -INC SMLOBJE
  43. -INC SMCHAML
  44.  
  45.       SEGMENT LIMODE(0)
  46.  
  47.       PARAMETER (NBFORM=100 , NBCHGT=10)
  48.       PARAMETER (NLOMAX=5, NBCMOC=25)
  49.       CHARACTER*4 MNLOCA(NLOMAX)
  50.       CHARACTER*4 CAMPL(1), MOOPT(7), NOMU(3), LMOSU(5), MOTBAS(5),
  51.      &     NUMO(5), MCHGT(NBCHGT), CMOC(NBCMOC), CFROT(1)
  52.       CHARACTER*16 MOFORM(NBFORM)
  53.       CHARACTER*4 MOT_4
  54.       CHARACTER*(LOCOMP) CMOT,MOT1,MOT2,MOCOMP
  55.       CHARACTER*8 MOT_8,CTYP,CTYP1
  56.       CHARACTER*(LOCHAI) CTEXTL,CTEXT
  57.       CHARACTER*(LCONMO) MOT_CM
  58.       LOGICAL LTELQ, LAG,BORINF,MINI,IMFRO,ZHARM
  59. C
  60.       DATA LMOSU /'RIGI','ELEM','RIGT','MASS','BLOQ'/
  61.       DATA NOMU  /'NOMU','MULT','UNIL'/
  62.       DATA MOOPT /'MAIL','RIGI','SYME','ANTI','CONT','COMP','DIAG'/
  63.       DATA MOTBAS/'RIGI','MASS','MODE','STAT','PSMO'/
  64.       DATA CAMPL /'AMPL'/
  65.       DATA NUMO  /'INFE','SUPE','MINI','MAXI','ENTR'/
  66.       DATA CMOC  /'MAIL','ZONE','FORM','CONS','ELEM','GEOM','CONT',
  67.      $            'DEFO','DEPL','FORC','GRAD','GRAF','MATE','CONP',
  68.      $            'TEMP','VARI','PARA','DEIN','COMP','OBJE','NON_',
  69.      $            'NLOC','PHAS','CENT','HHO_'/
  70.       DATA CFROT /'FROT'/
  71.       DATA MCHGT /'CHAR','CHAM','TRAJ','EVOL','VITE','COMP',
  72.      &            'LIE ','LIBR','LOBJ','LREE'/
  73.  
  74.       XVAL1=0.D0
  75.       MOT_4='    '
  76.       MINI =.FALSE.
  77.       ILO  =0
  78.       IOBIN=0
  79.       IVALRE=0
  80. C
  81.       CALL QUETYP(CTYP,0,IRETOU)
  82.       IF (IRETOU.EQ.0) THEN
  83.          CALL ERREUR(533)
  84.          RETURN
  85.       ENDIF
  86.  
  87. * +-------------------------------------------------------------------+
  88. * |                                                                   |
  89. * |                             M   O   T                             |
  90. * |                                                                   |
  91. * +-------------------------------------------------------------------+
  92.       IF (CTYP.EQ.'MOT     ') THEN
  93.          CALL LIRCHA(CTEXTL,1,LONMOT)
  94.          IF (IERR.NE.0) RETURN
  95.  
  96. *        ============================
  97. *        EXTRACTION D'UNE SOUS-CHAINE
  98. *        ============================
  99.          CALL QUETYP(CTYP1,0,IRETOU)
  100.          IF (IRETOU.NE.0) THEN
  101.             IF (CTYP1.EQ.'ENTIER'.OR.CTYP1.EQ.'LISTENTI') THEN
  102.                CALL SOUCHA(CTEXTL,LONMOT,CTYP1)
  103.                RETURN
  104.             ENDIF
  105.          ENDIF
  106.  
  107. *        ========================================================
  108. *        CREATION D'UNE TABLE CONTENANT LES OBJETS DE TYPE CTEXTL
  109. *        ========================================================
  110.          MOT_8=CTEXTL(1:8)
  111.          CALL REPERT(MOT_8,IA)
  112.          M=IA
  113.          SEGINI MTABLE
  114.          MLOTAB=0
  115.          DO 7765 I=1,IA
  116.             IF(MOT_8.EQ.'FLOTTANT' ) THEN
  117.                CALL LIRREE(XVAL,1,IRETOU)
  118.             ELSEIF(MOT_8.EQ.'LOGIQUE ') THEN
  119.                CALL LIRLOG(LAG,1,IRETOU)
  120.             ELSEIF (MOT_8.EQ.'ENTIER  ') THEN
  121.                CALL LIRENT(IVAL,1,IRETOU)
  122.             ELSEIF(MOT_8.EQ.'MOT     ') THEN
  123.                CALL LIRCHA(CTEXT,1,IRETOU)
  124.             ELSE
  125.                CALL LIROBJ(MOT_8,IVAL,1,IRETOU)
  126.             ENDIF
  127.             CALL ECCTAB(MTABLE,'ENTIER  ',I,XVAL1,MOT_4,MINI,ILO,
  128.      $           MOT_8,IVAL,XVAL,CTEXT(1:IRETOU),LAG,IVAL)
  129.  7765    CONTINUE
  130.          SEGDES MTABLE
  131.          CALL ECROBJ('TABLE   ',MTABLE)
  132.          RETURN
  133.  
  134.  
  135. * +-------------------------------------------------------------------+
  136. * |                                                                   |
  137. * |                   D   E   F   O   R   M   E   E                   |
  138. * |                                                                   |
  139. * +-------------------------------------------------------------------+
  140.       ELSEIF (CTYP.EQ.'DEFORME ') THEN
  141.          CALL LIROBJ('DEFORME ',MDEFOR,1,IRETOU)
  142.          IF(IERR.NE.0) RETURN
  143.          CALL LIRMOT(CAMPL,1,IRET,1)
  144.          IF(IERR.NE.0) RETURN
  145.          SEGACT MDEFOR
  146.          IF (AMPL(/1).NE.1) THEN
  147.             CALL ERREUR(475)
  148.          ELSE
  149.             AMP=AMPL(1)
  150.             CALL ECRREE(AMP)
  151.          ENDIF
  152.          RETURN
  153.  
  154.  
  155. * +-------------------------------------------------------------------+
  156. * |                                                                   |
  157. * |                   B   A   S   E   M   O   D   A                   |
  158. * |                                                                   |
  159. * +-------------------------------------------------------------------+
  160.       ELSEIF (CTYP.EQ.'BASEMODA') THEN
  161.          CALL LIROBJ('BASEMODA',IPBASE,1,IRETOU)
  162.          IF(IERR.NE.0) RETURN
  163.          CALL LIRMOT(MOTBAS,5,IRET,1)
  164.          IF(IERR.NE.0) RETURN
  165.          MOT_4=MOTBAS(IRET)
  166.          CALL EXTRA7(IPBASE,MOT_4,IPTR)
  167.          IF(IERR.NE.0) RETURN
  168.          IF (IRET.LE.2) THEN
  169.             CALL ECROBJ('RIGIDITE',IPTR)
  170.          ELSE
  171.             CALL ECROBJ('SOLUTION',IPTR)
  172.          ENDIF
  173.          RETURN
  174.  
  175.  
  176. * +-------------------------------------------------------------------+
  177. * |                                                                   |
  178. * |                 E   V   O   L   U   T   I   O   N                 |
  179. * |                                                                   |
  180. * +-------------------------------------------------------------------+
  181.       ELSEIF (CTYP.EQ.'EVOLUTIO') THEN
  182.          CALL LIROBJ('EVOLUTIO',IBOLL,1,IRETOU)
  183.          CALL ACTOBJ('EVOLUTIO',IBOLL,1)
  184.          IF(IERR.NE.0) RETURN
  185.          CALL EXTRA6 (IBOLL)
  186.          RETURN
  187.  
  188.  
  189. * +-------------------------------------------------------------------+
  190. * |                                                                   |
  191. * |                   S   U   P   E   R   E   L   E                   |
  192. * |                                                                   |
  193. * +-------------------------------------------------------------------+
  194.       ELSEIF (CTYP.EQ.'SUPERELE') THEN
  195.          CALL LIROBJ ('SUPERELE',MSUPER,1,IRETOU)
  196.          IF (IERR.NE.0) RETURN
  197.          CALL LIRMOT(LMOSU,5,IRET,1)
  198.          IF (IERR.NE.0) RETURN
  199.          SEGACT MSUPER
  200.  
  201. *        ==============
  202. *        MOT-CLE "RIGI"
  203. *        ==============
  204.          IF (IRET.EQ.1) THEN
  205.             IPTR=MSURAI
  206.             CALL ECROBJ('RIGIDITE',IPTR)
  207.  
  208. *        ==============
  209. *        MOT-CLE "ELEM"
  210. *        ==============
  211.          ELSEIF (IRET.EQ.2) THEN
  212.             IPTR=MSUPEL
  213.             CALL ECROBJ('MAILLAGE',IPTR)
  214.  
  215. *        ==============
  216. *        MOT-CLE "RIGT"
  217. *        ==============
  218.          ELSEIF (IRET.EQ.3) THEN
  219.             IPTR=MRIGTO
  220.             CALL ECROBJ('RIGIDITE',IPTR)
  221.  
  222. *        ==============
  223. *        MOT-CLE "MASS"
  224. *        ==============
  225.          ELSEIF (IRET.EQ.4) THEN
  226.             IPTR=MSUMAS
  227.             CALL ECROBJ('RIGIDITE',IPTR)
  228.  
  229. *        ==============
  230. *        MOT-CLE "BLOQ"
  231. *        ==============
  232.          ELSEIF (IRET.EQ.5) THEN
  233.             NRIGEL=MBLOQU
  234.             RI1=MRIGTO
  235.             SEGACT,RI1
  236.             SEGINI,MRIGID
  237.             MTYMAT=RI1.MTYMAT
  238.             DO 1 IE1=1,NRIGEL
  239.                COERIG(IE1)=RI1.COERIG(IE1)
  240.                DO 11 IE2=1,8
  241.                   IRIGEL(IE2,IE1)=RI1.IRIGEL(IE2,IE1)
  242.  11            CONTINUE
  243.  1          CONTINUE
  244.             SEGACT,MRIGID
  245.             CALL ECROBJ('RIGIDITE',MRIGID)
  246.          ENDIF
  247.          RETURN
  248.  
  249.  
  250. * +-------------------------------------------------------------------+
  251. * |                                                                   |
  252. * |                       M   A   T   R   I   K                       |
  253. * |                                                                   |
  254. * +-------------------------------------------------------------------+
  255.       ELSEIF (CTYP.EQ.'MATRIK') THEN
  256.          CALL LIROBJ ('MATRIK',IBOGID,1,IRETOU)
  257.          IF (IERR.NE.0) RETURN
  258.          CALL LIRMOT(MOOPT,7,IRET,0)
  259.  
  260. *        ====================================================
  261. *        EXTRACTION D'UNE SOUS-MATRICE DE COMPOSANTES DONNEES
  262. *        ====================================================
  263.          IF (IRET.EQ.0) THEN
  264.             CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETLM)
  265.             IF (IRETLM.EQ.1) THEN
  266.                CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET)
  267.                IF (IERR.NE.0) RETURN
  268.             ELSE
  269.                CALL LIRCHA(MOT1,1,IRET)
  270.                IF (IERR.NE.0) RETURN
  271.                CALL LIRCHA(MOT2,1,IRET)
  272.                IF (IERR.NE.0) RETURN
  273.                JGN=4
  274.                JGM=1
  275.                SEGINI MLMOT1,MLMOT2
  276.                MLMOT1.MOTS(1)=MOT1
  277.                MLMOT2.MOTS(1)=MOT2
  278.             ENDIF
  279.             CALL EXINCK(IBOGID,MLMOT1,MLMOT2,IOUT,IMPR,IRET)
  280.             IF (IRETLM.NE.1) SEGSUP MLMOT1,MLMOT2
  281.             IF (IERR.NE.0) RETURN
  282.             CALL ECROBJ('MATRIK',IOUT)
  283.             RETURN
  284.  
  285. *        ============================================
  286. *        MOT-CLE "DIAG" => EXTRACTION DE LA DIAGONALE
  287. *        ============================================
  288.          ELSEIF (IRET.EQ.7) THEN
  289.             CALL ECROBJ('MATRIK',IBOGID)
  290.             CALL EXDIAG(1)
  291.             RETURN
  292.  
  293. *        =======================================================
  294. *        MOT-CLE "COMP => EXTRACTION DE LA LISTE DES COMPOSANTES
  295. *        =======================================================
  296.          ELSEIF(IRET.EQ.6) THEN
  297.             CALL LIRCHA(CMOT,0,ICDUAL)
  298.             IF (ICDUAL.NE.0) THEN
  299.                IF (CMOT.NE.'DUAL') THEN
  300.                   MOTERR=CMOT
  301.                   CALL ERREUR(7)
  302.                   RETURN
  303.                ENDIF
  304.             ENDIF
  305.             CALL EXTR26(IBOGID,ICDUAL,IPLSTM)
  306.             CALL ECROBJ('LISTMOTS',IPLSTM)
  307.             RETURN
  308.          ELSE
  309.             MOTERR=MOOPT(IRET)
  310.             CALL ERREUR(7)
  311.             RETURN
  312.          ENDIF
  313.  
  314.  
  315. * +-------------------------------------------------------------------+
  316. * |                                                                   |
  317. * |                   R   I   G   I   D   I   T   E                   |
  318. * |                                                                   |
  319. * +-------------------------------------------------------------------+
  320.       ELSEIF (CTYP.EQ.'RIGIDITE') THEN
  321.          CALL LIROBJ ('RIGIDITE',IBOGID,1,IRETOU)
  322.          IF (IERR.NE.0) RETURN
  323.          CALL LIRMOT(MOOPT,7,IRET,0)
  324.  
  325. *        ====================================================
  326. *        EXTRACTION D'UNE SOUS-MATRICE DE COMPOSANTES DONNEES
  327. *        ====================================================
  328.          IF (IRET.EQ.0) THEN
  329.             CALL LIROBJ('LISTMOTS',MLMOT1,0,IRETLM)
  330.             IF (IRETLM.EQ.1) THEN
  331.                CALL LIROBJ('LISTMOTS',MLMOT2,1,IRET)
  332.                IF (IERR.NE.0) RETURN
  333.             ELSE
  334.                CALL LIRCHA(MOT1,1,IRET)
  335.                IF (IERR.NE.0) RETURN
  336.                CALL LIRCHA(MOT2,1,IRET)
  337.                IF (IERR.NE.0) RETURN
  338.                JGN=4
  339.                JGM=1
  340.                SEGINI MLMOT1,MLMOT2
  341.                MLMOT1.MOTS(1)=MOT1
  342.                MLMOT2.MOTS(1)=MOT2
  343.             ENDIF
  344.             CALL EXINCR(IBOGID,MLMOT1,MLMOT2,IOUT)
  345.             IF (IRETLM.NE.1) SEGSUP MLMOT1,MLMOT2
  346.             IF (IERR.NE.0) RETURN
  347.             CALL ECROBJ('RIGIDITE',IOUT)
  348.             RETURN
  349.  
  350. *        ============================================
  351. *        MOT-CLE "DIAG" => EXTRACTION DE LA DIAGONALE
  352. *        ============================================
  353.          ELSEIF (IRET.EQ.7) THEN
  354.             CALL EXDIAR(IBOGID,ICHP)
  355.             IF (IERR.NE.0) RETURN
  356.             CALL ACTOBJ('CHPOINT ',ICHP,1)
  357.             CALL ECROBJ('CHPOINT ',ICHP)
  358.             RETURN
  359.  
  360. *        ========================================================
  361. *        MOT-CLE "COMP" => EXTRACTION DE LA LISTE DES COMPOSANTES
  362. *        ========================================================
  363.          ELSEIF(IRET.EQ.6) THEN
  364.             CALL LIRCHA(CMOT,0,ICDUAL)
  365.             IF (ICDUAL.NE.0) THEN
  366.                IF (CMOT.NE.'DUAL') THEN
  367.                   MOTERR=CMOT
  368.                   CALL ERREUR(7)
  369.                   RETURN
  370.                ENDIF
  371.             ENDIF
  372.             CALL EXTR16(IBOGID,ICDUAL,IPLSTM)
  373.             CALL ECROBJ('LISTMOTS',IPLSTM)
  374.             RETURN
  375.  
  376. *        ====================================
  377. *        MOT-CLE "CONT" => APPUIS UNILATERAUX
  378. *        ====================================
  379.          ELSEIF(IRET.EQ.5) THEN
  380.             MRIGID=IBOGID
  381.             SEGACT MRIGID
  382.             ISOPE= ISUPEQ
  383.             IF(ISUPEQ.EQ.0)  CALL CRTABL(ISOPE)
  384.             MTABLE=ISOPE
  385.             SEGDES MTABLE
  386.             CALL ECROBJ('TABLE   ',ISOPE)
  387.             RETURN
  388.  
  389. *        ==============================================================
  390. *        MOTS-CLES "SYME" OU "ANTI" => SOUS-MATRICES (ANTI-)SYMETRIQUES
  391. *        ==============================================================
  392.          ELSEIF (IRET.EQ.3 .OR. IRET.EQ.4) THEN
  393.             CALL EXTR13(IBOGID,IRET)
  394.             RETURN
  395.          ENDIF
  396.  
  397.  
  398. *        =============================================================
  399. *        MOTS-CLES "MAIL" OU "RIGI" => SOUS-MAILLAGES OU SOUS-MATRICES
  400. *        =============================================================
  401.          ICO=0
  402.          IMO=3
  403.          IF(IRET.EQ.2) THEN
  404.             ICO=1
  405.             IMO=2
  406.          ENDIF
  407.          CALL LIRMOT(NOMU,IMO,IMUL,ICO)
  408.          IF(IERR.NE.0) RETURN
  409.  
  410. *        ************************************************
  411. *        MATRICE AVEC SEULEMENT LES MULT. DE LAGRANGE OU
  412. *                AVEC TOUT SAUF LES MULT. DE LAGRANGE
  413. *        ************************************************
  414.          IF (IRET.EQ.2) THEN
  415.             CALL SEPA(IBOGID,IMUL)
  416.             CALL ECROBJ('RIGIDITE',IBOGID)
  417.             RETURN
  418.          ENDIF
  419.  
  420. *        ********************************************************
  421. *        MAILLAGE PARTIEL
  422. *          "NOMU" => TOUT SAUF LES MULT. DE LAGRANGE
  423. *          "MULT" => TOUS LES MULT. DE LAGRANGE
  424. *          "UNIL" => SEULEMENT LES MULT. ASSOCIES AUX COND. UNIL.
  425. *        ********************************************************
  426.          IF (IMUL.NE.0) THEN
  427.             CALL POIRIG(IBOGID,IMUL)
  428.             RETURN
  429.          ENDIF
  430.  
  431. *        ****************
  432. *        MAILLAGE COMPLET
  433. *        ****************
  434.          IF (IERR.NE.0) RETURN
  435.          MRIGID=IBOGID
  436.          SEGACT MRIGID
  437.          NBSOUS=IRIGEL(/2)
  438.          IF (NBSOUS.EQ.0) THEN
  439.             NBNN=0
  440.             NBELEM=0
  441.             NBREF=0
  442.             SEGINI MELEME
  443.             SEGACT,MELEME
  444.             CALL ECROBJ ('MAILLAGE',MELEME)
  445.             RETURN
  446.          ENDIF
  447.          IPP1 = IRIGEL(1,1)
  448.          IF(NBSOUS.GT.1) THEN
  449.             NBREF=0
  450.             NBNN=0
  451.             NBELEM=0
  452.             SEGINI IPT4
  453.             KT4 = 1
  454.             IPT4.LISOUS(KT4) = IPP1
  455.             DO 1130 I=1,NBSOUS
  456.                DO 1129 JJ = 1,KT4
  457.                   IF (IRIGEL(1,I).EQ.IPT4.LISOUS(JJ)) GOTO 1130
  458.  1129          CONTINUE
  459.                KT4 = KT4 + 1
  460.                IPT4.LISOUS(KT4)=IRIGEL(1,I)
  461.  1130       CONTINUE
  462.             NBSOUS = KT4
  463.             SEGADJ IPT4
  464.             CALL FUSEBO (IPT4,IPP1)
  465.          ENDIF
  466.          CALL ACTOBJ('MAILLAGE',IPP1,1)
  467.          CALL ECROBJ('MAILLAGE',IPP1)
  468.          RETURN
  469.  
  470.  
  471. * +-------------------------------------------------------------------+
  472. * |                                                                   |
  473. * |                     C   H   P   O   I   N   T                     |
  474. * |                                                                   |
  475. * +-------------------------------------------------------------------+
  476.       ELSEIF (CTYP.EQ.'CHPOINT') THEN
  477.          CALL LIROBJ('CHPOINT ',IBOPOI,1,IRETOU)
  478.          IF (IERR.NE.0) RETURN
  479.          CALL ACTOBJ('CHPOINT ',IBOPOI,1)
  480.          IF (IERR.NE.0) RETURN
  481.          CALL LIRCHA(CMOT,1,IRETOU)
  482.          IF (IERR.NE.0) RETURN
  483.          MOT_4=CMOT
  484.  
  485. *        =====================================
  486. *        MOT-CLE "TITR" => EXTRACTION DU TITRE
  487. *        =====================================
  488.          IF (MOT_4.EQ.'TITR') THEN
  489.             MCHPOI = IBOPOI
  490.             CTEXT = MOCHDE
  491.             ILON = LEN(CTEXT)
  492.             DO 100 I = ILON,1,-1
  493.                IF (CTEXT(I:I).NE.' ') THEN
  494.                   NLON = I
  495.                   GOTO 102
  496.                ENDIF
  497.  100        CONTINUE
  498.             NLON = 1
  499.  102        CONTINUE
  500.             CALL ECRCHA(CTEXT(1:NLON))
  501.             RETURN
  502.  
  503. *        =========================================
  504. *        MOT-CLE "NATU" => EXTRACTION DE LA NATURE
  505. *        =========================================
  506.          ELSEIF (MOT_4.EQ.'NATU') THEN
  507.             MCHPOI = IBOPOI
  508.             INAT = JATTRI(1)
  509.             IF (INAT.EQ.0) CTEXT(1:11) = 'INDETERMINE'
  510.             IF (INAT.EQ.1) CTEXT(1:11) = 'DIFFUS     '
  511.             IF (INAT.EQ.2) CTEXT(1:11) = 'DISCRET    '
  512.             CALL ECRCHA(CTEXT(1:11))
  513.             RETURN
  514.  
  515. *        ===================================================
  516. *        MOT-CLE "MAIL" => EXTRACTION DU SUPPORT GEOMETRIQUE
  517. *        ===================================================
  518.          ELSEIF (MOT_4 .EQ.'MAIL') THEN
  519.             IMUL=0
  520.             CALL LIRMOT(NOMU,1,IMUL,0)
  521.             IF (IERR.NE.0) RETURN
  522.             CALL EXTR21(IBOPOI,IMUL,IPP1)
  523.             IF (IERR.NE.0) RETURN
  524.             CALL ACTOBJ('MAILLAGE',IPP1,1)
  525.             CALL ECROBJ('MAILLAGE',IPP1)
  526.             RETURN
  527.  
  528. *        ========================================================
  529. *        MOT-CLE "COMP" => EXTRACTION DE LA LISTE DES COMPOSANTES
  530. *        ========================================================
  531.          ELSEIF (MOT_4 .EQ.'COMP') THEN
  532.             CALL EXTR11(IBOPOI,KLISTM)
  533.             CALL ECROBJ('LISTMOTS',KLISTM)
  534.             RETURN
  535.  
  536. *        ====================================
  537. *        MOT-CLE "TYPE" => EXTRACTION DU TYPE
  538. *        ====================================
  539.          ELSEIF (MOT_4.EQ.'TYPE') THEN
  540.             MCHPOI = IBOPOI
  541.             MOT_8 = MTYPOI
  542.             CALL ECRCHA(MOT_8(1:8))
  543.             RETURN
  544.  
  545. *        ============================================================
  546. *        MOT-CLE "VALE" => EXTRACTION DES VALEURS EN PLUSIEURS POINTS
  547. *                          ET POUR PLUSIEURS COMPOSANTES
  548. *        ============================================================
  549.          ELSEIF (MOT_4.EQ.'VALE') THEN
  550. *
  551. *           LISTE DES COMPOSANTES (OBJET MOT OU LISTMOTS)
  552.             CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
  553.             IF (IRETOU.EQ.1) THEN
  554.               SEGACT,MLMOTS
  555.  
  556.             ELSE
  557.                CALL LIRCHA(MOCOMP,0,IRETOU)
  558.                IF (IRETOU.GT.0) THEN
  559.                   JGN=LOCOMP
  560.                   JGM=1
  561.                   SEGINI,MLMOTS
  562.                   MOTS(1)=MOCOMP
  563.                   SEGACT,MLMOTS
  564.                ENDIF
  565.             ENDIF
  566. *
  567. *           LISTE DES NOEUDS (OBJET POINT OU MAILLAGE DE POI1)
  568.             CALL LIROBJ('MAILLAGE',MELEME,0,IRETOU)
  569.             IF (IRETOU.EQ.1) THEN
  570.               CALL ACTOBJ('MAILLAGE',MELEME,1)
  571.             ELSE
  572.                CALL LIROBJ('POINT',IPOINT,0,IRETOU)
  573.                IF (IRETOU.NE.0) THEN
  574.                   CALL CRELEM(IPOINT)
  575.                   MELEME=IPOINT
  576.                ENDIF
  577.             ENDIF
  578. *
  579. *           MOT-CLE 'NOID'
  580.             IVID=0
  581.             CALL LIRCHA(MOT_4,0,IRETOU)
  582.             IF (IRETOU.NE.0) THEN
  583.                IF (MOT_4.EQ.'NOID') THEN
  584.                   IVID=1
  585.                ELSE
  586.                   MOTERR(1:4)=MOT_4
  587.                   MOTERR(5:40)='NOID'
  588.                   CALL ERREUR(1052)
  589.                   RETURN
  590.                ENDIF
  591.             ENDIF
  592. *
  593. *           APPEL A EXTR23
  594.             CALL EXTR23(IBOPOI,MLMOTS,MELEME,MLREEL,IVID)
  595.             IF (IERR.NE.0) RETURN
  596.             SEGACT,MLREEL
  597.             CALL ECROBJ('LISTREEL',MLREEL)
  598.             RETURN
  599.  
  600. *        ===========================================================
  601. *        PAS DE MOT CLE : CMOT = NOM DE COMPOSANTE
  602. *        EXTRACTION DE LA VALEUR EN UN POINT D'UNE COMPOSANTE DONNEE
  603. *        ===========================================================
  604.          ELSE
  605.              CALL LIROBJ('POINT   ',MPOINT,1,IRETOU)
  606.              IF (IRETOU.EQ.0) THEN
  607.                  MOTERR(1:8)='POINT'
  608.                  CALL ERREUR(37)
  609.                  RETURN
  610.              ENDIF
  611. c            lecture facultative de l'harmonique de Fourier
  612.              CALL LIRENT(NHARM,0,IRET)
  613.              ZHARM=IRET.EQ.1
  614.              CALL EXTRA9(IBOPOI,MPOINT,CMOT,NHARM,ZHARM,XFLOT,IRET)
  615.              CALL ECRREE(XFLOT)
  616.              RETURN
  617.          ENDIF
  618.  
  619.  
  620.  
  621. * +-------------------------------------------------------------------+
  622. * |                                                                   |
  623. * |                       M   C   H   A   M   L                       |
  624. * |                                                                   |
  625. * +-------------------------------------------------------------------+
  626.       ELSEIF (CTYP.EQ.'MCHAML') THEN
  627.          CALL LIROBJ('MCHAML  ',IPCHE1,1,IRET)
  628.          CALL ACTOBJ('MCHAML  ',IPCHE1,1)
  629.          IF (IERR.NE.0) RETURN
  630. C
  631.          CALL LIRCHA(CMOT,1,IRET0)
  632.          IF (IERR.NE.0) RETURN
  633.          MOT_4=CMOT
  634.  
  635.  
  636. *        ================================================
  637. *        MOTS-CLES "DEVA" OU "COVA" => NOMS DES VARIABLES
  638. *        ================================================
  639.          IF (MOT_4.EQ.'DEVA' .OR. MOT_4.EQ.'COVA') THEN
  640.             CALL EXCHA1(IPCHE1,ILISR,MOT_4)
  641.             IF (ILISR.NE.0) THEN
  642.               CALL ACTOBJ('LISTMOTS',ILISR,1)
  643.               CALL ECROBJ('LISTMOTS',ILISR)
  644.             ENDIF
  645.             RETURN
  646.  
  647. *        =================================
  648. *        MOT-CLE "NBZO" => NOMBRE DE ZONES
  649. *        =================================
  650.          ELSEIF (MOT_4.EQ.'NBZO') THEN
  651.             CALL EXTR18(IPCHE1,NBZONE)
  652.             if (ierr.ne.0) return
  653.             CALL ECRENT(NBZONE)
  654.             RETURN
  655.  
  656. *        =====================================================
  657. *        MOT-CLE "COMP" => EXTRACTION DES NOMS DES COMPOSANTES
  658. *        =====================================================
  659.          ELSEIF (MOT_4.EQ.'COMP' ) THEN
  660.             CALL LIROBJ('MMODEL',IPMODL,0,IRETM)
  661. C
  662. C           RECHERCHE DES NOMS DES COMPOSANTES APPARTENANT
  663. C           A LA ZONE DU MODELE
  664.             IF (IRETM.NE.0) THEN
  665.                CALL ACTOBJ('MMODEL',IPMODL,1)
  666.                CALL EXTR15(IPMODL,IPCHE1,IPLSTM)
  667.                IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM)
  668.                RETURN
  669. C
  670. C           RECHERCHE DES NOMS DE TOUTES LES COMPOSANTES
  671.             ELSE
  672.                CALL EXTR17(IPCHE1,IPLSTM)
  673.                CALL ECROBJ('LISTMOTS',IPLSTM)
  674.                RETURN
  675.             ENDIF
  676.  
  677. *        ======================================================
  678. *        MOT-CLE "CONS" => EXTRACTION DES NOMS DES CONSTITUANTS
  679. *        ======================================================
  680.          ELSEIF(MOT_4.EQ.'CONS' ) THEN
  681.             CALL LIROBJ('MMODEL',IPMODL,0,IRETM)
  682. C
  683. C           RECHERCHE DES NOMS DES CONSTITUANTS APPARTENANT
  684. C           A LA ZONE DU MODELE
  685.             IF (IRETM.NE.0) THEN
  686.                CALL ACTOBJ('MMODEL',IPMODL,1)
  687.                CALL EXTR35(IPMODL,IPCHE1,IPLSTM)
  688.                IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM)
  689.                RETURN
  690. C
  691. C           RECHERCHE DES NOMS DE TOUs LES constituants
  692.             ELSE
  693.                CALL EXTR37(IPCHE1,IPLSTM)
  694.                CALL ECROBJ('LISTMOTS',IPLSTM)
  695.                RETURN
  696.             ENDIF
  697.  
  698. *        =========================================================
  699. *        EXTRACTION DE LA VALEUR, DU TITRE, DU TYPE OU DU MAILLAGE
  700. *        =========================================================
  701.          ELSE
  702.             IF (MOT_4.NE.'TITR'.AND.MOT_4.NE.'TYPE'.AND.
  703.      &          MOT_4.NE.'MAIL') THEN
  704.                IENT1 = 0
  705.                IENT2 = 0
  706.                IENT3 = 0
  707.                IPMAIL = 0
  708.                CALL LIROBJ('MAILLAGE',IPMAIL,0,IRET0)
  709.                IF (IRET0.NE.0) THEN
  710.                  CALL ACTOBJ('MAILLAGE',IPMAIL,1)
  711.                  IF (IERR.NE.0) RETURN
  712.                  MELEME = IPMAIL
  713.                  NBEL1 = NUM(/2)
  714.                  IF (NBEL1.NE.1) THEN
  715.                    CALL ERREUR(426)
  716.                    RETURN
  717.                  ENDIF
  718.                  IENT3 = 1
  719.                  CALL LIRENT(IENT3,0,IRET3)
  720.                  IF (IRET3.NE.0.AND.IENT3.LE.0) THEN
  721.                    INTERR(1) = IENT3
  722.                    CALL ERREUR(36)
  723.                    RETURN
  724.                  ENDIF
  725.                ELSE
  726.                  IPMAIL = 0
  727.                  CALL LIRENT(IENT1,1,IRET1)
  728.                  IF(IRET1.EQ.0) RETURN
  729.                  IF (IENT1.LE.0) THEN
  730.                    INTERR(1) = IENT1
  731.                    CALL ERREUR(36)
  732.                    RETURN
  733.                  ENDIF
  734.                  CALL LIRENT(IENT2,1,IRET2)
  735.                  IF(IRET2.EQ.0) RETURN
  736.                  IF (IENT2.LE.0) THEN
  737.                    INTERR(1) = IENT2
  738.                    CALL ERREUR(36)
  739.                    RETURN
  740.                  ENDIF
  741.                  CALL LIRENT(IENT3,1,IRET3)
  742.                  IF(IRET3.EQ.0) RETURN
  743.                  IF (IENT3.LE.0) THEN
  744.                    INTERR(1) = IENT3
  745.                    CALL ERREUR(36)
  746.                    RETURN
  747.                  ENDIF
  748.                ENDIF
  749.             ENDIF
  750.             CALL EXTR14(IPCHE1,IENT1,IENT2,IENT3,CMOT,IPMAIL)
  751.             RETURN
  752.          ENDIF
  753.  
  754.  
  755. * +-------------------------------------------------------------------+
  756. * |                                                                   |
  757. * |                       M   M   O   D   E   L                       |
  758. * |                                                                   |
  759. * +-------------------------------------------------------------------+
  760.       ELSEIF (CTYP.EQ.'MMODEL') THEN
  761.          CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  762.          CALL ACTOBJ('MMODEL',IPMODL,1)
  763.          IF (IERR.NE.0) RETURN
  764.          CALL LIRMOT(CMOC,NBCMOC,IRET,1)
  765.          IF(IERR.NE.0) RETURN
  766.          CMOT  =CMOC(IRET)
  767.          MOT_4 =CMOT
  768.  
  769. C        Extension du MMODEL en cas de modele de MELANGE
  770.          CALL MODETE(IPMODL,MMODEL,IMELAN)
  771.          NSOUS=MMODEL.KMODEL(/1)
  772.  
  773. C=DEB==== FORMULATION HHO ==== Cas particulier =========================
  774.          IF (MOT_4.EQ.'HHO_') THEN
  775.            CALL REFUS
  776.            CALL LIRCHA(CTEXT,1,iret)
  777.            IF (IERR.NE.0) RETURN
  778.            CALL HHOEXT(IPMODL,CTEXT, IPP1,CTYP,iret)
  779.            IF (iret.NE.0) THEN
  780.              CALL ERREUR(iret)
  781.              RETURN
  782.            END IF
  783.            IF (IPP1.LE.0) THEN
  784.              CALL ERREUR(21)
  785.              RETURN
  786.            END IF
  787.            CALL ACTOBJ(CTYP,IPP1,1)
  788.            CALL ECROBJ(CTYP,IPP1)
  789.            RETURN
  790.          END IF
  791. C=FIN==== FORMULATION HHO ==============================================
  792.  
  793.          IF (MOT_4.EQ.'MAIL') THEN
  794.             IMFRO=.FALSE.
  795.             CALL LIRMOT(CFROT,1,IRET,0)
  796.             IF (IRET.EQ.1) THEN
  797.               IMFRO=.TRUE.
  798.             ENDIF
  799.               IPP1=0
  800.                   ltelq=.false.
  801.                 DO 1116 I=1,NSOUS
  802.                   IMODEL= KMODEL(I)
  803.                  IF (IMFRO) THEN
  804.                   NMATT=MATMOD(/2)
  805.                   CALL PLACE(MATMOD,NMATT,IPLAC,'FROTTANT')
  806.                   if(iplac.eq.0) goto 1116
  807.                  ENDIF
  808.                   IPP2  = IMAMOD
  809.                   IF (ipp1.eq.0) then
  810.                     ipp1=ipp2
  811.                   ELSE
  812.                     CALL FUSE (IPP1,IPP2,IRET,ltelq)
  813.                     IPP1=IRET
  814.                   ENDIF
  815.  1116           CONTINUE
  816.  
  817.             IF(IPP1.EQ.0) THEN
  818. C             Cas du resultat vide ==> MAILLAGE VIDE
  819.               NBELEM = 0
  820.               NBNN   = NBNNE(ILCOUR)
  821.               NBREF  = 0
  822.               NBSOUS = 0
  823.               SEGINI,MELEME
  824.               ITYPEL = ILCOUR
  825.               IPP1   = MELEME
  826.             ENDIF
  827.             CALL ACTOBJ('MAILLAGE',IPP1,1)
  828.             CALL ECROBJ('MAILLAGE',IPP1)
  829.             RETURN
  830.  
  831.          ELSEIF (MOT_4.eq.'COMP') THEN
  832.             CALL LIRCHA(MOFORM(1),1,iretou)
  833.             if(ierr.ne.0) return
  834.             N1=0
  835.             SEGINI,MMODE1
  836.             DO 5497 I=1,NSOUS
  837.               IMODEL=KMODEL(I)
  838.               DO IB=1,MATMOD(/2)
  839.                 IF( MATMOD(IB) .EQ. MOFORM(1) ) GOTO 5498
  840.               ENDDO
  841.               GOTO 5497
  842.  5498         CONTINUE
  843.               N1=N1+1
  844.               MMODE1.KMODEL(**)=KMODEL(I)
  845.  5497       CONTINUE
  846.  
  847.             IF(N1.GE.0.AND.N1.LT.NSOUS) THEN
  848.               SEGADJ,MMODE1
  849.  
  850.             ELSEIF(N1.EQ.NSOUS)THEN
  851. C             Pas la peine de creer un autre MMODEL
  852.               SEGSUP,MMODE1
  853.               MMODE1=MMODEL
  854.  
  855.             ELSE
  856.               CALL ERREUR(5)
  857.             ENDIF
  858.  
  859.             CALL ACTOBJ('MMODEL  ',MMODE1,1)
  860.             CALL ECROBJ('MMODEL  ',MMODE1)
  861.             RETURN
  862.  
  863.          ELSEIF(MOT_4.EQ.'OBJE') THEN
  864.             if(NSOUS.ne.1) then
  865.                WRITE(IOIMP,*) ' Dans extrai.eso : '
  866.                WRITE(IOIMP,*) ' ce n est pas un modele elementaire'
  867.                WRITE(IOIMP,*) ' it is not an elementary model'
  868.                call erreur(19)
  869.                return
  870.             endif
  871.             imodel=kmodel(1)
  872.             iob=ivamod(/1)
  873.             do io=iob,1,-1
  874.                ctyp=tymode(io)
  875.                if( ctyp.eq.'ENTIER') then
  876.                   call ecrent(ivamod(io))
  877.                else
  878.                   ipoin1=ivamod(io)
  879.                   call ecrobj(ctyp,ipoin1)
  880.                endif
  881.             enddo
  882.             return
  883.  
  884.          ELSEIF (MOT_4.EQ.'ZONE') THEN
  885. C- Option 'ZONE' 'CONS' => IZOCO=1
  886.             IZOCO = 0
  887.             CALL LIRMOT(CMOC(4),1,IZOCO,0)
  888.             IF (IERR.NE.0) RETURN
  889.  
  890.             INCTS = 2
  891.             IF (IZOCO.EQ.1) INCTS = 3
  892.             M = INCTS * NSOUS
  893.             N1 = 1
  894.             SEGINI MTABLE
  895.  
  896.             DO IOK=1,NSOUS
  897.               IMODEL=KMODEL(IOK)
  898.               NFOR=FORMOD(/2)
  899. C      CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  900.               CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  901.               CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  902.               CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  903.               IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN
  904.                 SEGINI,IMODE1=IMODEL
  905.                 IMODE1.INFMOD(2)=0
  906.                 IMODEL=IMODE1
  907.               ENDIF
  908.               SEGINI MMODE1
  909.               MMODE1.KMODEL(1) = IMODEL
  910.               IVALI1 = (IOK-1)*INCTS + 1
  911.               IPP1   = MMODE1
  912.               CALL ECCTAB(MTABLE,'ENTIER  ',IVALI1,XFLOT,MOT_8,LAG,
  913.      $                 IOBIN,'MMODEL  ',IVALRE,XFLOT,MOT_8,LAG,IPP1)
  914.               IVALI1 = IVALI1 + 1
  915.               IPP1   = IMAMOD
  916.               CALL ECCTAB(MTABLE,'ENTIER  ',IVALI1,XFLOT,MOT_8,LAG,
  917.      $                 IOBIN,'MAILLAGE',IVALRE,XFLOT,MOT_8,LAG,IPP1)
  918.               IF (IZOCO.EQ.1) THEN
  919.                 IVALI1 = IVALI1 + 1
  920.                 MOT_CM = CONMOD
  921.                 CALL ECCTAB(MTABLE,'ENTIER  ',IVALI1,XFLOT,MOT_8,LAG,
  922.      $                   IOBIN,'MOT     ',IVALRE,XFLOT,MOT_CM,LAG,IPP1)
  923.               ENDIF
  924. C              SEGDES IMODEL
  925.             ENDDO
  926.  
  927.             CALL ECROBJ('TABLE   ',MTABLE)
  928.             RETURN
  929.  
  930.          ELSEIF (MOT_4.EQ.'FORM'.OR.MOT_4.EQ.'CONS'.OR.MOT_4.EQ.'ELEM'
  931.      &    .OR. MOT_4.EQ.'MATE'.OR.MOT_4.EQ.'NON_'
  932.      &    .OR.MOT_4.EQ.'PHAS') THEN
  933.             INFOR=1
  934.             IF (MOT_4.EQ.'MATE'.OR.MOT_4.EQ.'PHAS') THEN
  935.                IPASS=0
  936.                ICOND=0
  937.  1191          CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO)
  938.                IF (IERR.NE.0) RETURN
  939.                IPASS=IPASS+1
  940.                IF (IRETO.EQ.0.AND.IPASS.EQ.1) THEN
  941.                   CALL NOVARD(MMODEL,MOT_4)
  942.                   RETURN
  943.                ENDIF
  944.                IF (IRETO.NE.0) THEN
  945.                   INFOR=INFOR+1
  946.                   IF (INFOR.GT.NBFORM) THEN
  947.                      CALL ERREUR(5)
  948.                      RETURN
  949.                   ENDIF
  950.                   GOTO 1191
  951.                ENDIF
  952.             ELSE
  953.                ICOND=1
  954.  1192          CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO)
  955.                IF (IERR.NE.0) RETURN
  956.                ICOND=0
  957.                IF (IRETO.NE.0) THEN
  958.                   INFOR=INFOR+1
  959.                   IF (INFOR.GT.NBFORM) THEN
  960.                      CALL ERREUR(5)
  961.                      RETURN
  962.                   ENDIF
  963.                   GOTO 1192
  964.                ENDIF
  965.             ENDIF
  966.             INFOR=INFOR-1
  967. C
  968.             JGN=4
  969.             JGM=0
  970.             SEGINI MLMOTS
  971.             MLNONL=MLMOTS
  972. C
  973.             MMODE1=MMODEL
  974.  
  975.             IF (NSOUS .EQ. 0) THEN
  976. C             TRAITEMENT DES SOUS-MODELES VIDES dont on veut extraire une sous
  977. C             partie
  978.               CALL ECROBJ('MMODEL  ',IPMODL)
  979.               RETURN
  980.  
  981.             ELSE
  982.               N1=NSOUS
  983.               SEGINI,MMODEL
  984.               IPP1=MMODEL
  985.               NZON=0
  986.               IMECAF=0
  987.               DO 1119 I=1,NSOUS
  988.                  IMODEL=MMODE1.KMODEL(I)
  989.                  IF(MOT_4.EQ.'FORM') THEN
  990.                     NFOR=FORMOD(/2)
  991.  
  992.                     IF(NFOR.NE.INFOR) GOTO 1119
  993.                     IF(NFOR.EQ.1) THEN
  994.                        IF(MOFORM(1).NE.FORMOD(1)) GOTO 1119
  995.                     ELSEIF(NFOR.EQ.2) THEN
  996.                        IF(((MOFORM(1).NE.FORMOD(1)).AND.(MOFORM(2).NE.
  997.      $                    FORMOD(2))).AND.((MOFORM(1).NE.FORMOD(2)).AND.
  998.      $                    (MOFORM(2).NE.FORMOD(1))))GOTO 1119
  999.                     ELSE
  1000.                        GOTO 1118
  1001.                     ENDIF
  1002.                  ELSEIF (MOT_4.EQ.'CONS') THEN
  1003.                      DO 425 IJ=1,INFOR
  1004. C                    on enleve les espaces au debut et a la fin
  1005.                        idim0=LEN(MOFORM(IJ))
  1006.                        idim1=CONMOD(/1)
  1007.                        ideb0=0
  1008.                        ifin0=0
  1009.                        ideb1=0
  1010.                        ifin1=0
  1011.                        DO ii=1,idim0
  1012.                          IF(ideb0.EQ.0.AND.MOFORM(IJ)(ii:ii).NE.' ')
  1013.      $                         ideb0=ii
  1014.                           IF(ifin0.EQ.0.AND.
  1015.      &                        MOFORM(IJ)(idim0-ii+1:idim0-ii+1).NE.' ')
  1016.      &                        ifin0=idim0-ii+1
  1017.                       ENDDO
  1018.                       DO ii=1,idim1
  1019.                         IF(ideb1.EQ.0.AND.CONMOD(ii:ii).NE.' ') ideb1=ii
  1020.                         IF(ifin1.EQ.0.AND.
  1021.      &                         CONMOD(idim1-ii+1:idim1-ii+1).NE.' ')
  1022.      &                         ifin1=idim1-ii+1
  1023.                        ENDDO
  1024. C                    print *,'Limites : ',ideb0,ifin0,' / ',ideb1,ifin1
  1025.                       IF(MOFORM(IJ)(ideb0:ifin0).EQ.CONMOD(ideb1:ifin1))
  1026.      &                     GOTO 429
  1027.  425                 CONTINUE
  1028.                    GOTO 1119
  1029.                  ELSEIF (MOT_4.EQ.'ELEM') THEN
  1030.                     DO 426 IJ=1,INFOR
  1031.                        IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GOTO 429
  1032.  426                CONTINUE
  1033.                     GOTO 1119
  1034.                  ELSEIF(MOT_4.EQ.'MATE') THEN
  1035.                     NMAT=MATMOD(/2)
  1036.                     DO 427 IJ=1,INFOR
  1037.                        DO 4275 JJ=1,NMAT
  1038.                          IF(MATMOD(JJ).EQ.MOFORM(IJ)) GOTO 429
  1039.  4275                  CONTINUE
  1040.  427                CONTINUE
  1041.                    GOTO 1119
  1042.                  ELSEIF(MOT_4.EQ.'NON_') THEN
  1043.                     MN3=INFMOD(/1)
  1044.                     IF(MN3.LE.12) GOTO 1119
  1045.                     INLOC=-1*INFMOD(13)
  1046.                     IF(INLOC.EQ.0) GOTO 1119
  1047.                     CALL MODNLO(MNLOCA,NLODIM)
  1048.                     DO 428 IJ=1,INFOR
  1049.                       IF(MNLOCA(INLOC).EQ.MOFORM(IJ)(1:4)) GOTO 429
  1050.  428                CONTINUE
  1051.                    GOTO 1119
  1052.                  ELSEIF(MOT_4.EQ.'PHAS'
  1053.      &                  .AND.CONMOD.NE.'                ') THEN
  1054.                         DO 430 IJ=1,INFOR
  1055.                         IF(CONMOD(17:24).EQ.MOFORM(IJ)(1:8)) GOTO 429
  1056. 430             CONTINUE
  1057.                     GOTO 1119
  1058.                  ENDIF
  1059. C     on vient ici pour prendre les sous modeles
  1060.  429             CONTINUE
  1061.                  NZON=NZON+1
  1062.                  NFOR=FORMOD(/2)
  1063.  
  1064. C                CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  1065.                  CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  1066.                  CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  1067.                  CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  1068.                  IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN
  1069.                     IMECAF=1
  1070.                     SEGINI,IMODE1=IMODEL
  1071.                     IMODE1.INFMOD(2)=0
  1072.                     IMODEL=IMODE1
  1073.                  ENDIF
  1074.  
  1075.                  KMODEL(NZON)=IMODEL
  1076.  1119        CONTINUE
  1077.             ENDIF
  1078. C
  1079.             IF(NZON.EQ.0) GOTO 1118
  1080.  
  1081.             IF(NZON.EQ.NSOUS .AND. IMECAF.EQ.0) THEN
  1082. C             Le SOUS-MODELE demande est le MODELE d'origine
  1083.               CALL ECROBJ('MMODEL  ',IPMODL)
  1084.  
  1085.             ELSE
  1086.               IF(NZON.NE.NSOUS)THEN
  1087.                 N1=NZON
  1088.                 SEGADJ,MMODEL
  1089.               ENDIF
  1090.               CALL ACTOBJ('MMODEL  ',IPP1,1)
  1091.               CALL ECROBJ('MMODEL  ',IPP1)
  1092.             ENDIF
  1093.             RETURN
  1094.  
  1095.  1118       CONTINUE
  1096.             CALL ERREUR(610)
  1097.             RETURN
  1098.  
  1099.          ELSEIF (IRET.GE.6.AND.IRET.LE.18.AND.IRET.NE.13) THEN
  1100.             CALL NOVARD(MMODEL,MOT_4)
  1101.             RETURN
  1102.  
  1103.          ELSEIF (IRET.EQ.22) THEN
  1104.            JGN=4
  1105.            JGM=0
  1106.            SEGINI MLMOTS
  1107.            MLNONL=MLMOTS
  1108. C
  1109.            MMODE1=MMODEL
  1110.            NSOUS=MMODE1.KMODEL(/1)
  1111. C
  1112. C           TRAITEMENT DES SOUS-MODELES VIDES dont on veut extraire une sous
  1113. C           partie
  1114.             IF (NSOUS .EQ. 0) THEN
  1115.               SEGACT,MLMOTS
  1116.               CALL ECROBJ('LISTMOTS',MLMOTS)
  1117.               RETURN
  1118.             ELSE
  1119.               DO 1122 I=1,NSOUS
  1120.                  IMODEL=MMODE1.KMODEL(I)
  1121.                  NFOR=FORMOD(/2)
  1122.                  IF(NFOR.GE.1) THEN
  1123.                     IF (FORMOD(1).NE.'MECANIQUE'.AND.
  1124.      &                  FORMOD(1).NE.'POREUX') GOTO 1123
  1125.                     MN3=INFMOD(/1)
  1126.                     IF(MN3.LE.12) GOTO 1123
  1127.                     INONL=INFMOD(14)
  1128.                     IF(INONL.EQ.0) GOTO 1123
  1129.                     MLMOT1=INONL
  1130.                     SEGACT MLMOT1
  1131.                     NMONL=MLMOT1.MOTS(/2)
  1132.                     IF(NMONL.EQ.0)GOTO 1123
  1133.                     IF(JGM.EQ.0) THEN
  1134.                       JGM=NMONL
  1135.                       SEGADJ,MLMOTS
  1136.                       DO IJ=1,NMONL
  1137.                         MOTS(IJ)=MLMOT1.MOTS(IJ)
  1138.                       ENDDO
  1139.                     ELSE
  1140.                       DO IJ=1,NMONL
  1141.                         CALL PLACE(MOTS,JGM,IPLA,MLMOT1.MOTS(IJ))
  1142.                         IF(IPLA.EQ.0) THEN
  1143.                           JGM=JGM+1
  1144.                           SEGADJ,MLMOTS
  1145.                           MOTS(JGM)=MLMOT1.MOTS(IPLA)
  1146.                         ENDIF
  1147.                       ENDDO
  1148.                     ENDIF
  1149. 1123                CONTINUE
  1150.                  ENDIF
  1151. 1122          CONTINUE
  1152.               SEGACT,MLMOTS
  1153.               CALL ECROBJ('LISTMOTS',MLMOTS)
  1154.               RETURN
  1155.             ENDIF
  1156. *
  1157.          ELSE IF (MOT_4.eq.'CENT') THEN
  1158. * pour NAVIER-STOKE NLIN, extrai les POINTS CENTRES
  1159.            ipma = 0
  1160. c
  1161.            L1 = 8
  1162.            n1 = 1
  1163.            segini mmode1
  1164.            n3 = 6
  1165.            segini mchel1
  1166.            n2 = 1
  1167.            segini mcham1
  1168.            mchel1.ichaml(1) = mcham1
  1169.            ipmons = mmode1
  1170.            ipchns = mchel1
  1171.            do is = 1,nsous
  1172.              imodel = kmodel(is)
  1173.              if (formod(1).eq.'NAVIER_STOKES'.and.matmod(1).eq.'NLIN')
  1174.      & then
  1175.                mmode1.kmodel(1) = imodel
  1176.                call go2nli(ipmons,ipchns,ipres,5)
  1177.                if (ierr.ne.0 ) return
  1178.              endif
  1179.              if (ipma.eq.0) then
  1180.                ipma = ipres
  1181.              else
  1182.                call fuse(ipma,ipres,ip3,.true.)
  1183.                if (ierr.ne.0) return
  1184.                ipma = ip3
  1185.              endif
  1186.            enddo
  1187.            segsup mchel1, mcham1, mmode1
  1188.            if (IPMA.GT.0) then
  1189.              call ecrobj('MAILLAGE',ipma)
  1190.              return
  1191.            else
  1192.              call erreur(21)
  1193.              return
  1194.            endif
  1195.          ELSE
  1196.             MOTERR=MOT_4
  1197.             CALL ERREUR(7)
  1198.             RETURN
  1199.          ENDIF
  1200.  
  1201.  
  1202. * +-------------------------------------------------------------------+
  1203. * |                                                                   |
  1204. * |               C   H   A   R   G   E   M   E   N   T               |
  1205. * |                                                                   |
  1206. * +-------------------------------------------------------------------+
  1207.       ELSEIF (CTYP.EQ.'CHARGEME') THEN
  1208.          CALL LIROBJ('CHARGEME',ICHAR,1,IRET)
  1209.          IF (IERR.NE.0) RETURN
  1210. C
  1211.          CMOT  = '    '
  1212.          ICHGT = 0
  1213.          LCHGT = 0
  1214.          IEC   = 1
  1215.          CALL LIROBJ('LISTMOTS',LCHGT,0,IRET)
  1216.          IF (IERR.NE.0) RETURN
  1217.          IF (IRET.EQ.0) THEN
  1218.             CALL LIRCHA(CMOT,1,IRETOU)
  1219.             IF (IERR.NE.0) RETURN
  1220.             CALL PLACE(MCHGT,NBCHGT,ICHGT,CMOT)
  1221.             IF ((ICHGT.GE.1 .AND. ICHGT.LE.5) .OR. ICHGT.GE.9) THEN
  1222.                CALL LIRENT(IEC,0,IRETOU)
  1223.                IF (IERR.NE.0) RETURN
  1224.                IF (IRETOU.EQ.0) IEC = 1
  1225.             ELSEIF (ICHGT.EQ.0) THEN
  1226.                CALL LIRCHA(MOT_4,0,IRETOU)
  1227.                IF (IRETOU.NE.0) THEN
  1228.                   IF (MOT_4.EQ.'TABL') THEN
  1229.                      ICHGT=-1
  1230.                   ELSE
  1231.                      CALL REFUS
  1232.                   ENDIF
  1233.                ENDIF
  1234.             ENDIF
  1235.          ENDIF
  1236. C
  1237.          CALL EXTR20(ICHAR,CMOT,ICHGT,LCHGT,IEC,IOBJ1,CTYP1,IOBJ2,MOT_8)
  1238. C
  1239.          IF (IOBJ1.NE.0) CALL ECROBJ(CTYP1,IOBJ1)
  1240.          IF (IOBJ2.NE.0) CALL ECROBJ(MOT_8,IOBJ2)
  1241.          RETURN
  1242.  
  1243.  
  1244. * +-------------------------------------------------------------------+
  1245. * |                                                                   |
  1246. * |                   L   I   S   T   C   H   P   O                   |
  1247. * |                                                                   |
  1248. * +-------------------------------------------------------------------+
  1249.       ELSEIF (CTYP.EQ.'LISTCHPO') THEN
  1250.          CALL LIROBJ('LISTCHPO',ILCHP1,1,IRET)
  1251.          IF (IERR.NE.0) RETURN
  1252.          CALL QUETYP(CTYP1,0,IRETOU)
  1253.          IF (IRETOU.EQ.0) THEN
  1254.             CALL ERREUR(533)
  1255.             RETURN
  1256.          ENDIF
  1257.  
  1258.          MLCHP1 = ILCHP1
  1259.          SEGACT , MLCHP1
  1260.          LONCHP = MLCHP1.ICHPOI(/1)
  1261.  
  1262. *        ===============================
  1263. *        EXTRACTION DE PLUSIEURS INDICES
  1264. *        ===============================
  1265.          IF (CTYP1.EQ.'LISTENTI') THEN
  1266.             CALL LIROBJ('LISTENTI',ILENT,1,IRET)
  1267.             IF (IERR.NE.0) RETURN
  1268.             MLENTI = ILENT
  1269.             SEGACT,MLENTI
  1270.             JG = LECT(/1)
  1271.             N1=JG
  1272.             SEGINI,MLCHP2
  1273.             ILCHP2= MLCHP2
  1274.             DO 1211 I=1 , JG
  1275.                IF (( LECT(I) .GT. LONCHP ) .OR. ( LECT(I) .LT. 1 )) THEN
  1276.                   INTERR(1) = LECT(I)
  1277.                   CALL ERREUR(620)
  1278.                ENDIF
  1279.                MLCHP2.ICHPOI(I) = MLCHP1.ICHPOI(LECT(I))
  1280.  1211       CONTINUE
  1281.             CALL ACTOBJ ('LISTCHPO',ILCHP2,0)
  1282.             CALL ECROBJ ('LISTCHPO',ILCHP2)
  1283.             RETURN
  1284.  
  1285. *        ===========================
  1286. *        EXTRACTION D'UN SEUL INDICE
  1287. *        ===========================
  1288.          ELSEIF (CTYP1.EQ.'ENTIER') THEN
  1289.             CALL LIRENT(ILENT,1,IRETOU)
  1290.             IF (IERR.NE.0) RETURN
  1291.             IF (ILENT.GT.LONCHP .OR. ILENT.LT.1 ) THEN
  1292.                INTERR(1)=ILENT
  1293.                CALL ERREUR(620)
  1294.             ENDIF
  1295.             ILCHPO = MLCHP1.ICHPOI(ILENT)
  1296.             CALL ACTOBJ('CHPOINT ',ILCHPO,1)
  1297.             CALL ECROBJ('CHPOINT ',ILCHPO)
  1298.             RETURN
  1299.  
  1300. *        ====================================================
  1301. *        MOT-CLE "VALE" => EXTRACTION DES VALEURS EN UN POINT
  1302. *        ====================================================
  1303.          ELSEIF (CTYP1.EQ.'MOT') THEN
  1304.             CALL LIRCHA(CMOT,1,IRETOU)
  1305.             IF (IERR.NE.0) RETURN
  1306.             IF (CMOT.NE.'VALE') THEN
  1307.                 MOTERR = 'VALE'
  1308.                 CALL ERREUR(396)
  1309.                 RETURN
  1310.             ENDIF
  1311.             CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
  1312.             IF (IRETOU.EQ.0) THEN
  1313.                 CALL LIRCHA(MOCOMP,0,IRETOU)
  1314.                 IF (IRETOU.GT.0) THEN
  1315.                     JGN=LOCOMP
  1316.                     JGM=1
  1317.                     SEGINI,MLMOTS
  1318.                     MOTS(1)=MOCOMP
  1319.                 ENDIF
  1320.             ENDIF
  1321.             CALL LIROBJ('POINT',MPOINT,1,IRETOU)
  1322.             IF (IERR.NE.0) RETURN
  1323.             CALL EXTR24(MLCHP1,MLMOTS,MPOINT,MLREEL)
  1324.             IF (IERR.NE.0) RETURN
  1325.             SEGACT,MLREEL
  1326.             CALL ECROBJ('LISTREEL',MLREEL)
  1327.             RETURN
  1328.  
  1329. *        SYNTAXE INCORRECTE
  1330.          ELSE
  1331.             MOTERR(1:40) = 'ENTIER  LISTENTI"VALE"'
  1332.             CALL ERREUR(471)
  1333.             RETURN
  1334.          ENDIF
  1335.  
  1336.  
  1337. * +-------------------------------------------------------------------+
  1338. * |                                                                   |
  1339. * |                         N   U   A   G   E                         |
  1340. * |                                                                   |
  1341. * +-------------------------------------------------------------------+
  1342.       ELSEIF (CTYP.EQ.'NUAGE') THEN
  1343.          CALL LIROBJ('NUAGE   ',IPOINT,1,IRET)
  1344.          CALL ACTOBJ('NUAGE   ',IPOINT,1)
  1345.          IF (IERR.NE.0) RETURN
  1346.  
  1347.          MNUAGE=IPOINT
  1348.          CALL LIRMOT(NUMO,5,INU1,0)
  1349.          IF (INU1.EQ.0) THEN
  1350.             CALL LIRCHA(CTYP1,1,IRETOU)
  1351.             IF (IERR.NE.0) THEN
  1352.                RETURN
  1353.             ENDIF
  1354.             CALL LIRMOT(NUMO,5,INU1,0)
  1355.             IF (INU1.EQ.0) THEN
  1356.                IF (CTYP1.EQ.'COMP    ') THEN
  1357.                   IPROG = 1
  1358.                ELSE
  1359.                   IPOSI = 0
  1360.                   DO 1250 I=1,NUANOM(/2)
  1361.                      IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1362.  1250             CONTINUE
  1363.                   IF (IPOSI.EQ.0) THEN
  1364.                      MOTERR(1:8) = CTYP1
  1365. C                    TYP1 n'est pas un nom de variable du NUAGE
  1366.                      CALL ERREUR(672)
  1367.                      RETURN
  1368.                   ENDIF
  1369.                   IPROG = 2
  1370.                ENDIF
  1371.             ELSE
  1372.                IPOSI = 0
  1373.                DO 1251 I=1,NUANOM(/2)
  1374.                   IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1375.  1251          CONTINUE
  1376.                IF (IPOSI.EQ.0) THEN
  1377.                   MOTERR(1:8) = CTYP1
  1378. C                 TYP1 n'est pas un nom de variable du NUAGE
  1379.                   CALL ERREUR(672)
  1380.                   RETURN
  1381.                ENDIF
  1382.                IPROG = 3
  1383.             ENDIF
  1384.          ELSE
  1385.             CALL LIRCHA(CTYP1,1,IRETOU)
  1386.             IF (IERR.NE.0) RETURN
  1387.             IPOSI = 0
  1388.             DO 1252 I=1,NUANOM(/2)
  1389.                IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1390.  1252       CONTINUE
  1391.             IF (IPOSI.EQ.0) THEN
  1392.                MOTERR= CTYP1
  1393. C              TYP1 n'est pas un nom de variable du NUAGE
  1394.                CALL ERREUR(672)
  1395.                RETURN
  1396.             ELSE
  1397.                IPROG = 3
  1398.             ENDIF
  1399.          ENDIF
  1400.  
  1401. C-------------- Lecture eventuelle des FLOTTANTS -------------
  1402.          IF ((IPROG.EQ.3).AND.(INU1.NE.3).AND.(INU1.NE.4)) THEN
  1403.             IF ((INU1.EQ.1).OR.(INU1.EQ.2)) THEN
  1404.                CALL LIRREE(XVAL1,0,IRETOU)
  1405.                IF (IRETOU.EQ.0) THEN
  1406. C                 Il manque la valeur de la composante reelle
  1407.                   CALL ERREUR(668)
  1408.                   RETURN
  1409.                ENDIF
  1410.             ELSE
  1411.                CALL LIRREE(XVAL1,0,IRETO1)
  1412.                CALL LIRREE(XVAL2,0,IRETO2)
  1413.                IF ((IRETO1.EQ.0).OR.(IRETO2.EQ.0)) THEN
  1414. C                 Il faut specifier deux valeurs reelles
  1415.                   CALL ERREUR(673)
  1416.                   RETURN
  1417.                ENDIF
  1418.             ENDIF
  1419.          ENDIF
  1420.  
  1421. C--------- Cas de l'extraction des noms des composantes du NUAGE -------
  1422.          IF (IPROG.EQ.1) THEN
  1423.             CALL EXTR19(IPOINT,IPLSTM)
  1424.             IF (IPLSTM.NE.0) THEN
  1425.                CALL ECROBJ('LISTMOTS',IPLSTM)
  1426.             ENDIF
  1427.  
  1428. C----Cas de l'extraction de l'objet correspondant a une composante ---
  1429. C----------------- donnee d'un NUAGE "colonne" -----------------------
  1430.  
  1431.          ELSEIF (IPROG.EQ.2) THEN
  1432.             CALL EXTR51(IPOINT,IPOSI)
  1433.  
  1434. C---------------------------- Autres cas ------------------------------
  1435.          ELSEIF (IPROG.EQ.3) THEN
  1436.             IF (INU1.EQ.1) THEN
  1437.                BORINF=.TRUE.
  1438.                CALL EXTR50(IPOINT,BORINF,XVAL1,IPOSI)
  1439.             ELSEIF (INU1.EQ.2) THEN
  1440.                BORINF=.FALSE.
  1441.                CALL EXTR50(IPOINT,BORINF,XVAL1,IPOSI)
  1442.             ELSEIF (INU1.EQ.3) THEN
  1443.                MINI =.TRUE.
  1444.                CALL EXTR52(IPOINT,MINI,IPOSI)
  1445.             ELSEIF (INU1.EQ.4) THEN
  1446.                MINI =.FALSE.
  1447.                CALL EXTR52(IPOINT,MINI,IPOSI)
  1448.             ELSEIF (INU1.EQ.5) THEN
  1449.                CALL EXTR53(IPOINT,XVAL1,XVAL2,IPOSI)
  1450.             ELSE
  1451.                 CALL ERREUR(21)
  1452.                 RETURN
  1453.             ENDIF
  1454.  
  1455. C---------------------------- Cas non prevus ---------------------------
  1456.          ELSE
  1457.             CALL ERREUR(21)
  1458.             RETURN
  1459.          ENDIF
  1460.          RETURN
  1461.  
  1462.  
  1463. * +-------------------------------------------------------------------+
  1464. * |                                                                   |
  1465. * |                          L I S T O B J E                          |
  1466. * |                                                                   |
  1467. * +-------------------------------------------------------------------+
  1468.       ELSEIF (CTYP.EQ.'LISTOBJE') THEN
  1469.         CALL LIROBJ('LISTOBJE',ILOBJ,1,IRET)
  1470.         IF (IERR.NE.0) RETURN
  1471.  
  1472. C EXTRACTION DU TYPE DES OBJETS DE LA LISTE
  1473.         CALL LIRCHA(CTEXT,0,IRET)
  1474.         IF (IRET.NE.0) THEN
  1475.           IF (CTEXT(1:4).EQ.'TYPE') THEN
  1476.             MLOBJE = ILOBJ
  1477.             SEGACT,MLOBJE
  1478.             CTYP = TYPOBJ
  1479.             CALL ECRCHA(CTYP)
  1480.             RETURN
  1481.           ENDIF
  1482.         ENDIF
  1483.  
  1484. C EXTRACTION D'UN OBJET DE LA LISTE
  1485.         CALL LIRENT(I1,1,IRET)
  1486.         IF (IERR.NE.0) RETURN
  1487.         IF (I1.LE.0) THEN
  1488.           CALL ERREUR(21)
  1489.           RETURN
  1490.         ENDIF
  1491.         MLOBJE = ILOBJ
  1492.         SEGACT,MLOBJE
  1493.         NOBJ = LISOBJ(/1)
  1494.         IF (I1.GT.NOBJ) THEN
  1495.           INTERR(1) = I1
  1496.           CALL ERREUR(620)
  1497.           RETURN
  1498.         ENDIF
  1499.         IP1  = LISOBJ(I1)
  1500.         CTYP = TYPOBJ
  1501.         CALL ECROBJ(CTYP,IP1)
  1502.         RETURN
  1503.  
  1504.  
  1505. C     FIN IF(CTYP...
  1506.       ENDIF
  1507.  
  1508.  
  1509. ***********************************************************************
  1510. * ON TRAITE LES LISTENTI, LISTREEL ET LISTMOTS SEPAREMENT POUR        *
  1511. * POUVOIR TOLERER L'INVERSION DES DEUX ARGUMENTS (LA LISTE PRINCIPALE *
  1512. * ET L'INDICE/LA LISTE D'INDICES)                                     *
  1513. ***********************************************************************
  1514.  
  1515.  
  1516. * +-------------------------------------------------------------------+
  1517. * |                                                                   |
  1518. * |                   L   I   S   T   M   O   T   S                   |
  1519. * |                                                                   |
  1520. * +-------------------------------------------------------------------+
  1521.    10 CONTINUE
  1522.       CALL LIROBJ('LISTMOTS',ILMOT1,0,IRET)
  1523.       IF (IRET.EQ.0) GOTO 20
  1524.  
  1525.       MLMOT1 = ILMOT1
  1526.       SEGACT , MLMOT1
  1527.       LONMOT = MLMOT1.MOTS(/2)
  1528.       JGN = MLMOT1.MOTS(/1)
  1529.  
  1530. *     ===============================
  1531. *     EXTRACTION DE PLUSIEURS INDICES
  1532. *     ===============================
  1533.       CALL LIROBJ('LISTENTI',ILENT,0,IRET)
  1534.       IF ( IRET .EQ. 1 ) THEN
  1535.          MLENTI = ILENT
  1536.          SEGACT , MLENTI
  1537.          JGM = LECT(/1)
  1538.          SEGINI , MLMOT2
  1539.          ILMOT2= MLMOT2
  1540.          DO 1221 I=1 , JGM
  1541.            I_EXTR =LECT(I)
  1542.             IF (( I_EXTR .GT. LONMOT ) .OR. ( I_EXTR .LT. 1 )) THEN
  1543.                INTERR(1) = I_EXTR
  1544.                CALL ERREUR(620)
  1545.             ENDIF
  1546.             MLMOT2.MOTS(I) = MLMOT1.MOTS(I_EXTR)
  1547.  1221    CONTINUE
  1548.          SEGACT , MLMOT2
  1549.          CALL ECROBJ ('LISTMOTS',ILMOT2)
  1550.          RETURN
  1551.  
  1552. *     ===========================
  1553. *     EXTRACTION D'UN SEUL INDICE
  1554. *     ===========================
  1555.       ELSE
  1556.          CALL LIRENT (ILENT,1,IRETOU)
  1557.          IF (IERR .NE. 0) RETURN
  1558.          IF (ILENT.GT.LONMOT .OR. ILENT.LT.1 ) THEN
  1559.             INTERR(1)=ILENT
  1560.             CALL ERREUR(620)
  1561.          ELSE
  1562.             CTEXT = MLMOT1.MOTS(ILENT)
  1563.          ENDIF
  1564.          CALL ECRCHA(CTEXT(1:JGN))
  1565.          RETURN
  1566.       ENDIF
  1567.  
  1568.  
  1569. * +-------------------------------------------------------------------+
  1570. * |                                                                   |
  1571. * |                   L   I   S   T   R   E   E   L                   |
  1572. * |                                                                   |
  1573. * +-------------------------------------------------------------------+
  1574.    20 CONTINUE
  1575.       CALL LIROBJ('LISTREEL',ILREE1,0,IRET)
  1576.       IF (IRET.EQ.0) GOTO 30
  1577.  
  1578.       MLREE1 = ILREE1
  1579.       SEGACT , MLREE1
  1580.       LONREE = MLREE1.PROG(/1)
  1581.  
  1582. *     ===============================
  1583. *     EXTRACTION DE PLUSIEURS INDICES
  1584. *     ===============================
  1585.       CALL LIROBJ('LISTENTI',ILENT,0,IRET)
  1586.       IF ( IRET .EQ. 1 ) THEN
  1587.          MLENTI = ILENT
  1588.          SEGACT , MLENTI
  1589.          JG = LECT(/1)
  1590.          SEGINI , MLREE2
  1591.          ILREE2= MLREE2
  1592.          DO 1231 I=1 , JG
  1593.            I_EXTR =LECT(I)
  1594.             IF (( I_EXTR .GT. LONREE ) .OR. ( I_EXTR .LT. 1 )) THEN
  1595.                INTERR(1) = I_EXTR
  1596.                CALL ERREUR(620)
  1597.                RETURN
  1598.             ENDIF
  1599.             MLREE2.PROG(I) = MLREE1.PROG(I_EXTR)
  1600.  1231    CONTINUE
  1601.          SEGACT , MLREE2
  1602.          CALL ECROBJ ('LISTREEL',ILREE2)
  1603.          RETURN
  1604.  
  1605. *     ===========================
  1606. *     EXTRACTION D'UN SEUL INDICE
  1607. *     ===========================
  1608.       ELSE
  1609.          CALL LIRENT (ILENT,1,IRETOU)
  1610.          IF (IERR .NE. 0) RETURN
  1611.          IF (ILENT.GT.LONREE .OR. ILENT.LT.1 ) THEN
  1612.             INTERR(1)=ILENT
  1613.             CALL ERREUR(620)
  1614.          ELSE
  1615.             REELDP = MLREE1.PROG(ILENT)
  1616.          ENDIF
  1617.          CALL ECRREE(REELDP)
  1618.          RETURN
  1619.       ENDIF
  1620.  124  CONTINUE
  1621.  
  1622.  
  1623. * +-------------------------------------------------------------------+
  1624. * |                                                                   |
  1625. * |                   L   I   S   T   E   N   T   I                   |
  1626. * |                                                                   |
  1627. * +-------------------------------------------------------------------+
  1628.    30 CONTINUE
  1629.       CALL LIROBJ('LISTENTI',ILENT1,0,IRET)
  1630.       IF (IRET.EQ.0) GOTO 999
  1631.  
  1632.       MLENT1 = ILENT1
  1633.       SEGACT , MLENT1
  1634.       LONENT = MLENT1.LECT(/1)
  1635.  
  1636. *     ===============================
  1637. *     EXTRACTION DE PLUSIEURS INDICES
  1638. *     ===============================
  1639.       CALL LIROBJ('LISTENTI',ILENT2,0,IRET)
  1640.       IF ( IRET .EQ. 1 ) THEN
  1641.          MLENT2 = ILENT2
  1642.          SEGACT , MLENT2
  1643.          JG = MLENT2.LECT(/1)
  1644.          SEGINI , MLENT3
  1645.          ILENT3= MLENT3
  1646.          DO I=1 , JG
  1647.             I_EXTR =MLENT2.LECT(I)
  1648.             IF (I_EXTR.GT.LONENT .OR. I_EXTR.LT.1) THEN
  1649.                INTERR(1) = I_EXTR
  1650.                CALL ERREUR(620)
  1651.             ENDIF
  1652.             MLENT3.LECT(I) = MLENT1.LECT(I_EXTR)
  1653.          ENDDO
  1654.          SEGACT , MLENT3
  1655.          CALL ECROBJ ('LISTENTI',ILENT3)
  1656.          RETURN
  1657.  
  1658. *     ===========================
  1659. *     EXTRACTION D'UN SEUL INDICE
  1660. *     ===========================
  1661.       ELSE
  1662.          CALL LIRENT (ILENT,1,IRETOU)
  1663.          IF (IERR .NE. 0) RETURN
  1664.          IF (ILENT.GT.LONENT .OR. ILENT.LT.1 ) THEN
  1665.             INTERR(1)=ILENT
  1666.             CALL ERREUR(620)
  1667.          ELSE
  1668.             INTEGR = MLENT1.LECT(ILENT)
  1669.          ENDIF
  1670.          CALL ECRENT(INTEGR)
  1671.          RETURN
  1672.       ENDIF
  1673.  
  1674.  
  1675. * +-------------------------------------------------------------------+
  1676. * |   E R R E U R   :   P A S   D ' O B J E T   C O M P A T I B L E   |
  1677. * +-------------------------------------------------------------------+
  1678.   999 CONTINUE
  1679.       CALL ERREUR(676)
  1680.  
  1681.       END
  1682.  
  1683.  
  1684.  
  1685.  

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