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    OF166741  24/05/06    21:15:06     11082          
  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.             MCHPOI=IBOPOI
  522.             NBSOUS=IPCHP(/1)
  523.             IPP1=0
  524.             DO 1140 I=1,NBSOUS
  525.                MSOUPO=IPCHP(I)
  526.                IF(NOCOMP(1).EQ.'LX  '.AND.IMUL.EQ.1) GOTO  1140
  527.                IF (IPP1.EQ.0) THEN
  528.                   IPP1= IGEOC
  529.                ELSE
  530.                   IPP2=IGEOC
  531.                   ltelq=.false.
  532.                   CALL FUSE (IPP1,IPP2,IRET,ltelq)
  533.                   IPP1=IRET
  534.                ENDIF
  535.  1140       CONTINUE
  536.             IF(IPP1.EQ.0) THEN
  537. C             Creation Maillage vide
  538.                NBELEM=0
  539.                NBNN=0
  540.                NBREF=0
  541.                NBSOUS=0
  542.                SEGINI MELEME
  543.                ITYPEL = 1
  544.                IPP1 = MELEME
  545.             ENDIF
  546.             CALL ACTOBJ('MAILLAGE',IPP1,1)
  547.             CALL ECROBJ('MAILLAGE',IPP1)
  548.             RETURN
  549.  
  550. *        ========================================================
  551. *        MOT-CLE "COMP" => EXTRACTION DE LA LISTE DES COMPOSANTES
  552. *        ========================================================
  553.          ELSEIF (MOT_4 .EQ.'COMP') THEN
  554.             CALL EXTR11(IBOPOI,KLISTM)
  555.             CALL ECROBJ('LISTMOTS',KLISTM)
  556.             RETURN
  557.  
  558. *        ====================================
  559. *        MOT-CLE "TYPE" => EXTRACTION DU TYPE
  560. *        ====================================
  561.          ELSEIF (MOT_4.EQ.'TYPE') THEN
  562.             MCHPOI = IBOPOI
  563.             MOT_8 = MTYPOI
  564.             CALL ECRCHA(MOT_8(1:8))
  565.             RETURN
  566.  
  567. *        ============================================================
  568. *        MOT-CLE "VALE" => EXTRACTION DES VALEURS EN PLUSIEURS POINTS
  569. *                          ET POUR PLUSIEURS COMPOSANTES
  570. *        ============================================================
  571.          ELSEIF (MOT_4.EQ.'VALE') THEN
  572. *
  573. *           LISTE DES COMPOSANTES (OBJET MOT OU LISTMOTS)
  574.             CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
  575.             IF (IRETOU.EQ.1) THEN
  576.               SEGACT,MLMOTS
  577.  
  578.             ELSE
  579.                CALL LIRCHA(MOCOMP,0,IRETOU)
  580.                IF (IRETOU.GT.0) THEN
  581.                   JGN=LOCOMP
  582.                   JGM=1
  583.                   SEGINI,MLMOTS
  584.                   MOTS(1)=MOCOMP
  585.                   SEGACT,MLMOTS
  586.                ENDIF
  587.             ENDIF
  588. *
  589. *           LISTE DES NOEUDS (OBJET POINT OU MAILLAGE DE POI1)
  590.             CALL LIROBJ('MAILLAGE',MELEME,0,IRETOU)
  591.             IF (IRETOU.EQ.1) THEN
  592.               CALL ACTOBJ('MAILLAGE',MELEME,1)
  593.             ELSE
  594.                CALL LIROBJ('POINT',IPOINT,0,IRETOU)
  595.                IF (IRETOU.NE.0) THEN
  596.                   CALL CRELEM(IPOINT)
  597.                   MELEME=IPOINT
  598.                ENDIF
  599.             ENDIF
  600. *
  601. *           MOT-CLE 'NOID'
  602.             IVID=0
  603.             CALL LIRCHA(MOT_4,0,IRETOU)
  604.             IF (IRETOU.NE.0) THEN
  605.                IF (MOT_4.EQ.'NOID') THEN
  606.                   IVID=1
  607.                ELSE
  608.                   MOTERR(1:4)=MOT_4
  609.                   MOTERR(5:40)='NOID'
  610.                   CALL ERREUR(1052)
  611.                   RETURN
  612.                ENDIF
  613.             ENDIF
  614. *
  615. *           APPEL A EXTR23
  616.             CALL EXTR23(IBOPOI,MLMOTS,MELEME,MLREEL,IVID)
  617.             IF (IERR.NE.0) RETURN
  618.             SEGACT,MLREEL
  619.             CALL ECROBJ('LISTREEL',MLREEL)
  620.             RETURN
  621.  
  622. *        ===========================================================
  623. *        PAS DE MOT CLE : CMOT = NOM DE COMPOSANTE
  624. *        EXTRACTION DE LA VALEUR EN UN POINT D'UNE COMPOSANTE DONNEE
  625. *        ===========================================================
  626.          ELSE
  627.              CALL LIROBJ('POINT   ',MPOINT,1,IRETOU)
  628.              IF (IRETOU.EQ.0) THEN
  629.                  MOTERR(1:8)='POINT'
  630.                  CALL ERREUR(37)
  631.                  RETURN
  632.              ENDIF
  633. c            lecture facultative de l'harmonique de Fourier
  634.              CALL LIRENT(NHARM,0,IRET)
  635.              ZHARM=IRET.EQ.1
  636.              CALL EXTRA9(IBOPOI,MPOINT,CMOT,NHARM,ZHARM,XFLOT,IRET)
  637.              CALL ECRREE(XFLOT)
  638.              RETURN
  639.          ENDIF
  640.  
  641.  
  642.  
  643. * +-------------------------------------------------------------------+
  644. * |                                                                   |
  645. * |                       M   C   H   A   M   L                       |
  646. * |                                                                   |
  647. * +-------------------------------------------------------------------+
  648.       ELSEIF (CTYP.EQ.'MCHAML') THEN
  649.          CALL LIROBJ('MCHAML  ',IPCHE1,1,IRET)
  650.          CALL ACTOBJ('MCHAML  ',IPCHE1,1)
  651.          IF (IERR.NE.0) RETURN
  652. C
  653.          CALL LIRCHA(CMOT,1,IRET0)
  654.          IF (IERR.NE.0) RETURN
  655.          MOT_4=CMOT
  656.  
  657.  
  658. *        ================================================
  659. *        MOTS-CLES "DEVA" OU "COVA" => NOMS DES VARIABLES
  660. *        ================================================
  661.          IF (MOT_4.EQ.'DEVA' .OR. MOT_4.EQ.'COVA') THEN
  662.             CALL EXCHA1(IPCHE1,ILISR,MOT_4)
  663.             IF (ILISR.NE.0) THEN
  664.               CALL ACTOBJ('LISTMOTS',ILISR,1)
  665.               CALL ECROBJ('LISTMOTS',ILISR)
  666.             ENDIF
  667.             RETURN
  668.  
  669. *        =================================
  670. *        MOT-CLE "NBZO" => NOMBRE DE ZONES
  671. *        =================================
  672.          ELSEIF (MOT_4.EQ.'NBZO') THEN
  673.             CALL EXTR18(IPCHE1,NBZONE)
  674.             if (ierr.ne.0) return
  675.             CALL ECRENT(NBZONE)
  676.             RETURN
  677.  
  678. *        =====================================================
  679. *        MOT-CLE "COMP" => EXTRACTION DES NOMS DES COMPOSANTES
  680. *        =====================================================
  681.          ELSEIF (MOT_4.EQ.'COMP' ) THEN
  682.             CALL LIROBJ('MMODEL',IPMODL,0,IRETM)
  683. C
  684. C           RECHERCHE DES NOMS DES COMPOSANTES APPARTENANT
  685. C           A LA ZONE DU MODELE
  686.             IF (IRETM.NE.0) THEN
  687.                CALL ACTOBJ('MMODEL',IPMODL,1)
  688.                CALL EXTR15(IPMODL,IPCHE1,IPLSTM)
  689.                IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM)
  690.                RETURN
  691. C
  692. C           RECHERCHE DES NOMS DE TOUTES LES COMPOSANTES
  693.             ELSE
  694.                CALL EXTR17(IPCHE1,IPLSTM)
  695.                CALL ECROBJ('LISTMOTS',IPLSTM)
  696.                RETURN
  697.             ENDIF
  698.  
  699. *        ======================================================
  700. *        MOT-CLE "CONS" => EXTRACTION DES NOMS DES CONSTITUANTS
  701. *        ======================================================
  702.          ELSEIF(MOT_4.EQ.'CONS' ) THEN
  703.             CALL LIROBJ('MMODEL',IPMODL,0,IRETM)
  704. C
  705. C           RECHERCHE DES NOMS DES CONSTITUANTS APPARTENANT
  706. C           A LA ZONE DU MODELE
  707.             IF (IRETM.NE.0) THEN
  708.                CALL ACTOBJ('MMODEL',IPMODL,1)
  709.                CALL EXTR35(IPMODL,IPCHE1,IPLSTM)
  710.                IF (IPLSTM.NE.0) CALL ECROBJ('LISTMOTS',IPLSTM)
  711.                RETURN
  712. C
  713. C           RECHERCHE DES NOMS DE TOUs LES constituants
  714.             ELSE
  715.                CALL EXTR37(IPCHE1,IPLSTM)
  716.                CALL ECROBJ('LISTMOTS',IPLSTM)
  717.                RETURN
  718.             ENDIF
  719.  
  720. *        =========================================================
  721. *        EXTRACTION DE LA VALEUR, DU TITRE, DU TYPE OU DU MAILLAGE
  722. *        =========================================================
  723.          ELSE
  724.             IF (MOT_4.NE.'TITR'.AND.MOT_4.NE.'TYPE'.AND.
  725.      &          MOT_4.NE.'MAIL') THEN
  726.                CALL LIRENT(IENT1,1,IRET1)
  727.                IF(IRET1.EQ.0) RETURN
  728.                CALL LIRENT(IENT2,1,IRET2)
  729.                IF(IRET2.EQ.0) RETURN
  730.                CALL LIRENT(IENT3,1,IRET3)
  731.                IF(IRET3.EQ.0) RETURN
  732.             ENDIF
  733.             CALL EXTR14(IPCHE1,IENT1,IENT2,IENT3,CMOT)
  734.             RETURN
  735.          ENDIF
  736.  
  737.  
  738. * +-------------------------------------------------------------------+
  739. * |                                                                   |
  740. * |                       M   M   O   D   E   L                       |
  741. * |                                                                   |
  742. * +-------------------------------------------------------------------+
  743.       ELSEIF (CTYP.EQ.'MMODEL') THEN
  744.          CALL LIROBJ('MMODEL',IPMODL,1,IRET)
  745.          CALL ACTOBJ('MMODEL',IPMODL,1)
  746.          IF (IERR.NE.0) RETURN
  747.          CALL LIRMOT(CMOC,NBCMOC,IRET,1)
  748.          IF(IERR.NE.0) RETURN
  749.          CMOT  =CMOC(IRET)
  750.          MOT_4 =CMOT
  751.  
  752. C        Extension du MMODEL en cas de modele de MELANGE
  753.          CALL MODETE(IPMODL,MMODEL,IMELAN)
  754.          NSOUS=MMODEL.KMODEL(/1)   
  755.  
  756. C=DEB==== FORMULATION HHO ==== Cas particulier =========================
  757.          IF (MOT_4.EQ.'HHO_') THEN
  758.            CALL REFUS
  759.            CALL LIRCHA(CTEXT,1,iret)
  760.            IF (IERR.NE.0) RETURN
  761.            CALL HHOEXT(IPMODL,CTEXT, IPP1,CTYP,iret)
  762.            IF (iret.NE.0) THEN
  763.              CALL ERREUR(iret)
  764.              RETURN
  765.            END IF
  766.            IF (IPP1.LE.0) THEN
  767.              CALL ERREUR(21)
  768.              RETURN
  769.            END IF
  770.            CALL ACTOBJ(CTYP,IPP1,1)
  771.            CALL ECROBJ(CTYP,IPP1)
  772.            RETURN
  773.          END IF
  774. C=FIN==== FORMULATION HHO ==============================================
  775.  
  776.          IF (MOT_4.EQ.'MAIL') THEN
  777.             IMFRO=.FALSE.
  778.             CALL LIRMOT(CFROT,1,IRET,0)
  779.             IF (IRET.EQ.1) THEN
  780.               IMFRO=.TRUE.
  781.             ENDIF
  782.               IPP1=0
  783.                   ltelq=.false.
  784.                 DO 1116 I=1,NSOUS
  785.                   IMODEL= KMODEL(I)
  786.                  IF (IMFRO) THEN
  787.                   NMATT=MATMOD(/2)
  788.                   CALL PLACE(MATMOD,NMATT,IPLAC,'FROTTANT')
  789.                   if(iplac.eq.0) goto 1116
  790.                  ENDIF
  791.                   IPP2  = IMAMOD
  792.                   IF (ipp1.eq.0) then
  793.                     ipp1=ipp2
  794.                   ELSE
  795.                     CALL FUSE (IPP1,IPP2,IRET,ltelq)
  796.                     IPP1=IRET
  797.                   ENDIF
  798.  1116           CONTINUE
  799.  
  800.             IF(IPP1.EQ.0) THEN
  801. C             Cas du resultat vide ==> MAILLAGE VIDE
  802.               NBELEM = 0
  803.               NBNN   = NBNNE(ILCOUR)
  804.               NBREF  = 0
  805.               NBSOUS = 0
  806.               SEGINI,MELEME
  807.               ITYPEL = ILCOUR
  808.               IPP1   = MELEME
  809.             ENDIF
  810.             CALL ACTOBJ('MAILLAGE',IPP1,1)
  811.             CALL ECROBJ('MAILLAGE',IPP1)
  812.             RETURN
  813.  
  814.          ELSEIF (MOT_4.eq.'COMP') THEN
  815.             CALL LIRCHA(MOFORM(1),1,iretou)
  816.             if(ierr.ne.0) return
  817.             N1=0
  818.             SEGINI,MMODE1
  819.             DO 5497 I=1,NSOUS
  820.               IMODEL=KMODEL(I)
  821.               DO IB=1,MATMOD(/2)
  822.                 IF( MATMOD(IB) .EQ. MOFORM(1) ) GOTO 5498
  823.               ENDDO
  824.               GOTO 5497
  825.  5498         CONTINUE
  826.               N1=N1+1
  827.               MMODE1.KMODEL(**)=KMODEL(I)
  828.  5497       CONTINUE
  829.  
  830.             IF(N1.GE.0.AND.N1.LT.NSOUS) THEN
  831.               SEGADJ,MMODE1
  832.  
  833.             ELSEIF(N1.EQ.NSOUS)THEN
  834. C             Pas la peine de creer un autre MMODEL
  835.               SEGSUP,MMODE1
  836.               MMODE1=MMODEL
  837.  
  838.             ELSE
  839.               CALL ERREUR(5)
  840.             ENDIF
  841.  
  842.             CALL ACTOBJ('MMODEL  ',MMODE1,1)
  843.             CALL ECROBJ('MMODEL  ',MMODE1)
  844.             RETURN
  845.  
  846.          ELSEIF(MOT_4.EQ.'OBJE') THEN
  847.             if(NSOUS.ne.1) then
  848.                WRITE(IOIMP,*) ' Dans extrai.eso : '
  849.                WRITE(IOIMP,*) ' ce n est pas un modele elementaire'
  850.                WRITE(IOIMP,*) ' it is not an elementary model'
  851.                call erreur(19)
  852.                return
  853.             endif
  854.             imodel=kmodel(1)
  855.             iob=ivamod(/1)
  856.             do io=iob,1,-1
  857.                ctyp=tymode(io)
  858.                if( ctyp.eq.'ENTIER') then
  859.                   call ecrent(ivamod(io))
  860.                else
  861.                   ipoin1=ivamod(io)
  862.                   call ecrobj(ctyp,ipoin1)
  863.                endif
  864.             enddo
  865.             return
  866.  
  867.          ELSEIF (MOT_4.EQ.'ZONE') THEN
  868. C- Option 'ZONE' 'CONS' => IZOCO=1
  869.             IZOCO = 0
  870.             CALL LIRMOT(CMOC(4),1,IZOCO,0)
  871.             IF (IERR.NE.0) RETURN
  872.  
  873.             INCTS = 2
  874.             IF (IZOCO.EQ.1) INCTS = 3
  875.             M = INCTS * NSOUS
  876.             N1 = 1
  877.             SEGINI MTABLE
  878.  
  879.             DO IOK=1,NSOUS
  880.               IMODEL=KMODEL(IOK)
  881.               NFOR=FORMOD(/2)
  882. C      CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  883.               CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  884.               CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  885.               CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  886.               IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN
  887.                 SEGINI,IMODE1=IMODEL
  888.                 IMODE1.INFMOD(2)=0
  889.                 IMODEL=IMODE1
  890.               ENDIF
  891.               SEGINI MMODE1
  892.               MMODE1.KMODEL(1) = IMODEL
  893.               IVALI1 = (IOK-1)*INCTS + 1
  894.               IPP1   = MMODE1
  895.               CALL ECCTAB(MTABLE,'ENTIER  ',IVALI1,XFLOT,MOT_8,LAG,
  896.      $                 IOBIN,'MMODEL  ',IVALRE,XFLOT,MOT_8,LAG,IPP1)
  897.               IVALI1 = IVALI1 + 1
  898.               IPP1   = IMAMOD
  899.               CALL ECCTAB(MTABLE,'ENTIER  ',IVALI1,XFLOT,MOT_8,LAG,
  900.      $                 IOBIN,'MAILLAGE',IVALRE,XFLOT,MOT_8,LAG,IPP1)
  901.               IF (IZOCO.EQ.1) THEN
  902.                 IVALI1 = IVALI1 + 1
  903.                 MOT_CM = CONMOD
  904.                 CALL ECCTAB(MTABLE,'ENTIER  ',IVALI1,XFLOT,MOT_8,LAG,
  905.      $                   IOBIN,'MOT     ',IVALRE,XFLOT,MOT_CM,LAG,IPP1)
  906.               ENDIF
  907. C              SEGDES IMODEL
  908.             ENDDO
  909.  
  910.             CALL ECROBJ('TABLE   ',MTABLE)
  911.             RETURN
  912.  
  913.          ELSEIF (MOT_4.EQ.'FORM'.OR.MOT_4.EQ.'CONS'.OR.MOT_4.EQ.'ELEM'
  914.      &    .OR. MOT_4.EQ.'MATE'.OR.MOT_4.EQ.'NON_'
  915.      &    .OR.MOT_4.EQ.'PHAS') THEN
  916.             INFOR=1
  917.             IF (MOT_4.EQ.'MATE'.OR.MOT_4.EQ.'PHAS') THEN
  918.                IPASS=0
  919.                ICOND=0
  920.  1191          CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO)
  921.                IF (IERR.NE.0) RETURN
  922.                IPASS=IPASS+1
  923.                IF (IRETO.EQ.0.AND.IPASS.EQ.1) THEN
  924.                   CALL NOVARD(MMODEL,MOT_4)
  925.                   RETURN
  926.                ENDIF
  927.                IF (IRETO.NE.0) THEN
  928.                   INFOR=INFOR+1
  929.                   IF (INFOR.GT.NBFORM) THEN
  930.                      CALL ERREUR(5)
  931.                      RETURN
  932.                   ENDIF
  933.                   GOTO 1191
  934.                ENDIF
  935.             ELSE
  936.                ICOND=1
  937.  1192          CALL LIRCHA(MOFORM(INFOR),ICOND,IRETO)
  938.                IF (IERR.NE.0) RETURN
  939.                ICOND=0
  940.                IF (IRETO.NE.0) THEN
  941.                   INFOR=INFOR+1
  942.                   IF (INFOR.GT.NBFORM) THEN
  943.                      CALL ERREUR(5)
  944.                      RETURN
  945.                   ENDIF
  946.                   GOTO 1192
  947.                ENDIF
  948.             ENDIF
  949.             INFOR=INFOR-1
  950. C
  951.             JGN=4
  952.             JGM=0
  953.             SEGINI MLMOTS
  954.             MLNONL=MLMOTS
  955. C
  956.             MMODE1=MMODEL
  957.  
  958.             IF (NSOUS .EQ. 0) THEN
  959. C             TRAITEMENT DES SOUS-MODELES VIDES dont on veut extraire une sous
  960. C             partie
  961.               CALL ECROBJ('MMODEL  ',IPMODL)
  962.               RETURN
  963.  
  964.             ELSE
  965.               N1=NSOUS
  966.               SEGINI,MMODEL
  967.               IPP1=MMODEL
  968.               NZON=0
  969.               IMECAF=0
  970.               DO 1119 I=1,NSOUS
  971.                  IMODEL=MMODE1.KMODEL(I)
  972.                  IF(MOT_4.EQ.'FORM') THEN
  973.                     NFOR=FORMOD(/2)
  974.  
  975.                     IF(NFOR.NE.INFOR) GOTO 1119
  976.                     IF(NFOR.EQ.1) THEN
  977.                        IF(MOFORM(1).NE.FORMOD(1)) GOTO 1119
  978.                     ELSEIF(NFOR.EQ.2) THEN
  979.                        IF(((MOFORM(1).NE.FORMOD(1)).AND.(MOFORM(2).NE.
  980.      $                    FORMOD(2))).AND.((MOFORM(1).NE.FORMOD(2)).AND.
  981.      $                    (MOFORM(2).NE.FORMOD(1))))GOTO 1119
  982.                     ELSE
  983.                        GOTO 1118
  984.                     ENDIF
  985.                  ELSEIF (MOT_4.EQ.'CONS') THEN
  986.                      DO 425 IJ=1,INFOR
  987. C                    on enleve les espaces au debut et a la fin
  988.                        idim0=LEN(MOFORM(IJ))
  989.                        idim1=CONMOD(/1)
  990.                        ideb0=0
  991.                        ifin0=0
  992.                        ideb1=0
  993.                        ifin1=0
  994.                        DO ii=1,idim0
  995.                          IF(ideb0.EQ.0.AND.MOFORM(IJ)(ii:ii).NE.' ')
  996.      $                         ideb0=ii
  997.                           IF(ifin0.EQ.0.AND.
  998.      &                        MOFORM(IJ)(idim0-ii+1:idim0-ii+1).NE.' ')
  999.      &                        ifin0=idim0-ii+1
  1000.                       ENDDO
  1001.                       DO ii=1,idim1
  1002.                         IF(ideb1.EQ.0.AND.CONMOD(ii:ii).NE.' ') ideb1=ii
  1003.                         IF(ifin1.EQ.0.AND.
  1004.      &                         CONMOD(idim1-ii+1:idim1-ii+1).NE.' ')
  1005.      &                         ifin1=idim1-ii+1
  1006.                        ENDDO
  1007. C                    print *,'Limites : ',ideb0,ifin0,' / ',ideb1,ifin1
  1008.                       IF(MOFORM(IJ)(ideb0:ifin0).EQ.CONMOD(ideb1:ifin1))
  1009.      &                     GOTO 429
  1010.  425                 CONTINUE
  1011.                    GOTO 1119
  1012.                  ELSEIF (MOT_4.EQ.'ELEM') THEN
  1013.                     DO 426 IJ=1,INFOR
  1014.                        IF(MOFORM(IJ)(1:4).EQ.NOMTP(NEFMOD)) GOTO 429
  1015.  426                CONTINUE
  1016.                     GOTO 1119
  1017.                  ELSEIF(MOT_4.EQ.'MATE') THEN
  1018.                     NMAT=MATMOD(/2)
  1019.                     DO 427 IJ=1,INFOR
  1020.                        DO 4275 JJ=1,NMAT
  1021.                          IF(MATMOD(JJ).EQ.MOFORM(IJ)) GOTO 429
  1022.  4275                  CONTINUE
  1023.  427                CONTINUE
  1024.                    GOTO 1119
  1025.                  ELSEIF(MOT_4.EQ.'NON_') THEN
  1026.                     MN3=INFMOD(/1)
  1027.                     IF(MN3.LE.12) GOTO 1119
  1028.                     INLOC=-1*INFMOD(13)
  1029.                     IF(INLOC.EQ.0) GOTO 1119
  1030.                     CALL MODNLO(MNLOCA,NLODIM)
  1031.                     DO 428 IJ=1,INFOR
  1032.                       IF(MNLOCA(INLOC).EQ.MOFORM(IJ)(1:4)) GOTO 429
  1033.  428                CONTINUE
  1034.                    GOTO 1119
  1035.                  ELSEIF(MOT_4.EQ.'PHAS'
  1036.      &                  .AND.CONMOD.NE.'                ') THEN
  1037.                         DO 430 IJ=1,INFOR
  1038.                         IF(CONMOD(17:24).EQ.MOFORM(IJ)(1:8)) GOTO 429
  1039. 430             CONTINUE
  1040.                     GOTO 1119
  1041.                  ENDIF
  1042. C     on vient ici pour prendre les sous modeles
  1043.  429             CONTINUE
  1044.                  NZON=NZON+1
  1045.                  NFOR=FORMOD(/2)
  1046.  
  1047. C                CAS DARCY OU NAVIER ON OUBLIE LA TABLE DE PRECONDITIONNEMENT
  1048.                  CALL PLACE (FORMOD,NFOR,IDARC,'DARCY')
  1049.                  CALL PLACE (FORMOD,NFOR,IEULE,'EULER')
  1050.                  CALL PLACE (FORMOD,NFOR,INAVI,'NAVIER_STOKES')
  1051.                  IF((IDARC.NE.0).OR.(INAVI.NE.0).OR.(IEULE.NE.0))THEN
  1052.                     IMECAF=1
  1053.                     SEGINI,IMODE1=IMODEL
  1054.                     IMODE1.INFMOD(2)=0
  1055.                     IMODEL=IMODE1
  1056.                  ENDIF
  1057.  
  1058.                  KMODEL(NZON)=IMODEL
  1059.  1119        CONTINUE
  1060.             ENDIF
  1061. C
  1062.             IF(NZON.EQ.0) GOTO 1118
  1063.  
  1064.             IF(NZON.EQ.NSOUS .AND. IMECAF.EQ.0) THEN
  1065. C             Le SOUS-MODELE demande est le MODELE d'origine
  1066.               CALL ECROBJ('MMODEL  ',IPMODL)
  1067.  
  1068.             ELSE
  1069.               IF(NZON.NE.NSOUS)THEN
  1070.                 N1=NZON
  1071.                 SEGADJ,MMODEL
  1072.               ENDIF
  1073.               CALL ACTOBJ('MMODEL  ',IPP1,1)
  1074.               CALL ECROBJ('MMODEL  ',IPP1)
  1075.             ENDIF
  1076.             RETURN
  1077.  
  1078.  1118       CONTINUE
  1079.             CALL ERREUR(610)
  1080.             RETURN
  1081.  
  1082.          ELSEIF (IRET.GE.6.AND.IRET.LE.18.AND.IRET.NE.13) THEN
  1083.             CALL NOVARD(MMODEL,MOT_4)
  1084.             RETURN
  1085.  
  1086.          ELSEIF (IRET.EQ.22) THEN
  1087.            JGN=4
  1088.            JGM=0
  1089.            SEGINI MLMOTS
  1090.            MLNONL=MLMOTS
  1091. C
  1092.            MMODE1=MMODEL
  1093.            NSOUS=MMODE1.KMODEL(/1)
  1094. C
  1095. C           TRAITEMENT DES SOUS-MODELES VIDES dont on veut extraire une sous
  1096. C           partie
  1097.             IF (NSOUS .EQ. 0) THEN
  1098.               SEGACT,MLMOTS
  1099.               CALL ECROBJ('LISTMOTS',MLMOTS)
  1100.               RETURN
  1101.             ELSE
  1102.               DO 1122 I=1,NSOUS
  1103.                  IMODEL=MMODE1.KMODEL(I)
  1104.                  NFOR=FORMOD(/2)
  1105.                  IF(NFOR.GE.1) THEN
  1106.                     IF (FORMOD(1).NE.'MECANIQUE'.AND.
  1107.      &                  FORMOD(1).NE.'POREUX') GOTO 1123
  1108.                     MN3=INFMOD(/1)
  1109.                     IF(MN3.LE.12) GOTO 1123
  1110.                     INONL=INFMOD(14)
  1111.                     IF(INONL.EQ.0) GOTO 1123
  1112.                     MLMOT1=INONL
  1113.                     SEGACT MLMOT1
  1114.                     NMONL=MLMOT1.MOTS(/2)
  1115.                     IF(NMONL.EQ.0)GOTO 1123
  1116.                     IF(JGM.EQ.0) THEN
  1117.                       JGM=NMONL
  1118.                       SEGADJ,MLMOTS
  1119.                       DO IJ=1,NMONL
  1120.                         MOTS(IJ)=MLMOT1.MOTS(IJ)
  1121.                       ENDDO
  1122.                     ELSE
  1123.                       DO IJ=1,NMONL
  1124.                         CALL PLACE(MOTS,JGM,IPLA,MLMOT1.MOTS(IJ))
  1125.                         IF(IPLA.EQ.0) THEN
  1126.                           JGM=JGM+1
  1127.                           SEGADJ,MLMOTS
  1128.                           MOTS(JGM)=MLMOT1.MOTS(IPLA)
  1129.                         ENDIF
  1130.                       ENDDO
  1131.                     ENDIF
  1132. 1123                CONTINUE
  1133.                  ENDIF
  1134. 1122          CONTINUE
  1135.               SEGACT,MLMOTS
  1136.               CALL ECROBJ('LISTMOTS',MLMOTS)
  1137.               RETURN
  1138.             ENDIF
  1139. *            
  1140.          ELSE IF (MOT_4.eq.'CENT') THEN
  1141. * pour NAVIER-STOKE NLIN, extrai les POINTS CENTRES
  1142.            ipma = 0
  1143. c 
  1144.            L1 = 8
  1145.            n1 = 1
  1146.            segini mmode1
  1147.            n3 = 6
  1148.            segini mchel1
  1149.            n2 = 1
  1150.            segini mcham1
  1151.            mchel1.ichaml(1) = mcham1
  1152.            ipmons = mmode1
  1153.            ipchns = mchel1
  1154.            do is = 1,nsous
  1155.              imodel = kmodel(is)
  1156.              if (formod(1).eq.'NAVIER_STOKES'.and.matmod(1).eq.'NLIN')
  1157.      & then
  1158.                mmode1.kmodel(1) = imodel
  1159.                call go2nli(ipmons,ipchns,ipres,5)
  1160.                if (ierr.ne.0 ) return
  1161.              endif
  1162.              if (ipma.eq.0) then
  1163.                ipma = ipres 
  1164.              else
  1165.                call fuse(ipma,ipres,ip3,.true.)
  1166.                if (ierr.ne.0) return
  1167.                ipma = ip3
  1168.              endif
  1169.            enddo
  1170.            segsup mchel1, mcham1, mmode1
  1171.            if (IPMA.GT.0) then
  1172.              call ecrobj('MAILLAGE',ipma) 
  1173.              return
  1174.            else
  1175.              call erreur(21)
  1176.              return
  1177.            endif
  1178.          ELSE
  1179.             MOTERR=MOT_4
  1180.             CALL ERREUR(7)
  1181.             RETURN
  1182.          ENDIF
  1183.  
  1184.  
  1185. * +-------------------------------------------------------------------+
  1186. * |                                                                   |
  1187. * |               C   H   A   R   G   E   M   E   N   T               |
  1188. * |                                                                   |
  1189. * +-------------------------------------------------------------------+
  1190.       ELSEIF (CTYP.EQ.'CHARGEME') THEN
  1191.          CALL LIROBJ('CHARGEME',ICHAR,1,IRET)
  1192.          IF (IERR.NE.0) RETURN
  1193. C
  1194.          CMOT  = '    '
  1195.          ICHGT = 0
  1196.          LCHGT = 0
  1197.          IEC   = 1
  1198.          CALL LIROBJ('LISTMOTS',LCHGT,0,IRET)
  1199.          IF (IERR.NE.0) RETURN
  1200.          IF (IRET.EQ.0) THEN
  1201.             CALL LIRCHA(CMOT,1,IRETOU)
  1202.             IF (IERR.NE.0) RETURN
  1203.             CALL PLACE(MCHGT,NBCHGT,ICHGT,CMOT)
  1204.             IF ((ICHGT.GE.1 .AND. ICHGT.LE.5) .OR. ICHGT.GE.9) THEN
  1205.                CALL LIRENT(IEC,0,IRETOU)
  1206.                IF (IERR.NE.0) RETURN
  1207.                IF (IRETOU.EQ.0) IEC = 1
  1208.             ELSEIF (ICHGT.EQ.0) THEN
  1209.                CALL LIRCHA(MOT_4,0,IRETOU)
  1210.                IF (IRETOU.NE.0) THEN
  1211.                   IF (MOT_4.EQ.'TABL') THEN
  1212.                      ICHGT=-1
  1213.                   ELSE
  1214.                      CALL REFUS
  1215.                   ENDIF
  1216.                ENDIF
  1217.             ENDIF
  1218.          ENDIF
  1219. C
  1220.          CALL EXTR20(ICHAR,CMOT,ICHGT,LCHGT,IEC,IOBJ1,CTYP1,IOBJ2,MOT_8)
  1221. C
  1222.          IF (IOBJ1.NE.0) CALL ECROBJ(CTYP1,IOBJ1)
  1223.          IF (IOBJ2.NE.0) CALL ECROBJ(MOT_8,IOBJ2)
  1224.          RETURN
  1225.  
  1226.  
  1227. * +-------------------------------------------------------------------+
  1228. * |                                                                   |
  1229. * |                   L   I   S   T   C   H   P   O                   |
  1230. * |                                                                   |
  1231. * +-------------------------------------------------------------------+
  1232.       ELSEIF (CTYP.EQ.'LISTCHPO') THEN
  1233.          CALL LIROBJ('LISTCHPO',ILCHP1,1,IRET)
  1234.          IF (IERR.NE.0) RETURN
  1235.          CALL QUETYP(CTYP1,0,IRETOU)
  1236.          IF (IRETOU.EQ.0) THEN
  1237.             CALL ERREUR(533)
  1238.             RETURN
  1239.          ENDIF
  1240.  
  1241.          MLCHP1 = ILCHP1
  1242.          SEGACT , MLCHP1
  1243.          LONCHP = MLCHP1.ICHPOI(/1)
  1244.  
  1245. *        ===============================
  1246. *        EXTRACTION DE PLUSIEURS INDICES
  1247. *        ===============================
  1248.          IF (CTYP1.EQ.'LISTENTI') THEN
  1249.             CALL LIROBJ('LISTENTI',ILENT,1,IRET)
  1250.             IF (IERR.NE.0) RETURN
  1251.             MLENTI = ILENT
  1252.             SEGACT,MLENTI
  1253.             JG = LECT(/1)
  1254.             N1=JG
  1255.             SEGINI,MLCHP2
  1256.             ILCHP2= MLCHP2
  1257.             DO 1211 I=1 , JG
  1258.                IF (( LECT(I) .GT. LONCHP ) .OR. ( LECT(I) .LT. 1 )) THEN
  1259.                   INTERR(1) = LECT(I)
  1260.                   CALL ERREUR(620)
  1261.                ENDIF
  1262.                MLCHP2.ICHPOI(I) = MLCHP1.ICHPOI(LECT(I))
  1263.  1211       CONTINUE
  1264.             CALL ACTOBJ ('LISTCHPO',ILCHP2,0)
  1265.             CALL ECROBJ ('LISTCHPO',ILCHP2)
  1266.             RETURN
  1267.  
  1268. *        ===========================
  1269. *        EXTRACTION D'UN SEUL INDICE
  1270. *        ===========================
  1271.          ELSEIF (CTYP1.EQ.'ENTIER') THEN
  1272.             CALL LIRENT(ILENT,1,IRETOU)
  1273.             IF (IERR.NE.0) RETURN
  1274.             IF (ILENT.GT.LONCHP .OR. ILENT.LT.1 ) THEN
  1275.                INTERR(1)=ILENT
  1276.                CALL ERREUR(620)
  1277.             ENDIF
  1278.             ILCHPO = MLCHP1.ICHPOI(ILENT)
  1279.             CALL ACTOBJ('CHPOINT ',ILCHPO,1)
  1280.             CALL ECROBJ('CHPOINT ',ILCHPO)
  1281.             RETURN
  1282.  
  1283. *        ====================================================
  1284. *        MOT-CLE "VALE" => EXTRACTION DES VALEURS EN UN POINT
  1285. *        ====================================================
  1286.          ELSEIF (CTYP1.EQ.'MOT') THEN
  1287.             CALL LIRCHA(CMOT,1,IRETOU)
  1288.             IF (IERR.NE.0) RETURN
  1289.             IF (CMOT.NE.'VALE') THEN
  1290.                 MOTERR = 'VALE'
  1291.                 CALL ERREUR(396)
  1292.                 RETURN
  1293.             ENDIF
  1294.             CALL LIROBJ('LISTMOTS',MLMOTS,0,IRETOU)
  1295.             IF (IRETOU.EQ.0) THEN
  1296.                 CALL LIRCHA(MOCOMP,0,IRETOU)
  1297.                 IF (IRETOU.GT.0) THEN
  1298.                     JGN=LOCOMP
  1299.                     JGM=1
  1300.                     SEGINI,MLMOTS
  1301.                     MOTS(1)=MOCOMP
  1302.                 ENDIF
  1303.             ENDIF
  1304.             CALL LIROBJ('POINT',MPOINT,1,IRETOU)
  1305.             IF (IERR.NE.0) RETURN
  1306.             CALL EXTR24(MLCHP1,MLMOTS,MPOINT,MLREEL)
  1307.             IF (IERR.NE.0) RETURN
  1308.             SEGACT,MLREEL
  1309.             CALL ECROBJ('LISTREEL',MLREEL)
  1310.             RETURN
  1311.  
  1312. *        SYNTAXE INCORRECTE
  1313.          ELSE
  1314.             MOTERR(1:40) = 'ENTIER  LISTENTI"VALE"'
  1315.             CALL ERREUR(471)
  1316.             RETURN
  1317.          ENDIF
  1318.  
  1319.  
  1320. * +-------------------------------------------------------------------+
  1321. * |                                                                   |
  1322. * |                         N   U   A   G   E                         |
  1323. * |                                                                   |
  1324. * +-------------------------------------------------------------------+
  1325.       ELSEIF (CTYP.EQ.'NUAGE') THEN
  1326.          CALL LIROBJ('NUAGE   ',IPOINT,1,IRET)
  1327.          CALL ACTOBJ('NUAGE   ',IPOINT,1)
  1328.          IF (IERR.NE.0) RETURN
  1329.  
  1330.          MNUAGE=IPOINT
  1331.          CALL LIRMOT(NUMO,5,INU1,0)
  1332.          IF (INU1.EQ.0) THEN
  1333.             CALL LIRCHA(CTYP1,1,IRETOU)
  1334.             IF (IERR.NE.0) THEN
  1335.                RETURN
  1336.             ENDIF
  1337.             CALL LIRMOT(NUMO,5,INU1,0)
  1338.             IF (INU1.EQ.0) THEN
  1339.                IF (CTYP1.EQ.'COMP    ') THEN
  1340.                   IPROG = 1
  1341.                ELSE
  1342.                   IPOSI = 0
  1343.                   DO 1250 I=1,NUANOM(/2)
  1344.                      IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1345.  1250             CONTINUE
  1346.                   IF (IPOSI.EQ.0) THEN
  1347.                      MOTERR(1:8) = CTYP1
  1348. C                    TYP1 n'est pas un nom de variable du NUAGE
  1349.                      CALL ERREUR(672)
  1350.                      RETURN
  1351.                   ENDIF
  1352.                   IPROG = 2
  1353.                ENDIF
  1354.             ELSE
  1355.                IPOSI = 0
  1356.                DO 1251 I=1,NUANOM(/2)
  1357.                   IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1358.  1251          CONTINUE
  1359.                IF (IPOSI.EQ.0) THEN
  1360.                   MOTERR(1:8) = CTYP1
  1361. C                 TYP1 n'est pas un nom de variable du NUAGE
  1362.                   CALL ERREUR(672)
  1363.                   RETURN
  1364.                ENDIF
  1365.                IPROG = 3
  1366.             ENDIF
  1367.          ELSE
  1368.             CALL LIRCHA(CTYP1,1,IRETOU)
  1369.             IF (IERR.NE.0) RETURN
  1370.             IPOSI = 0
  1371.             DO 1252 I=1,NUANOM(/2)
  1372.                IF (NUANOM(I).EQ.CTYP1) IPOSI=I
  1373.  1252       CONTINUE
  1374.             IF (IPOSI.EQ.0) THEN
  1375.                MOTERR= CTYP1
  1376. C              TYP1 n'est pas un nom de variable du NUAGE
  1377.                CALL ERREUR(672)
  1378.                RETURN
  1379.             ELSE
  1380.                IPROG = 3
  1381.             ENDIF
  1382.          ENDIF
  1383.  
  1384. C-------------- Lecture eventuelle des FLOTTANTS -------------
  1385.          IF ((IPROG.EQ.3).AND.(INU1.NE.3).AND.(INU1.NE.4)) THEN
  1386.             IF ((INU1.EQ.1).OR.(INU1.EQ.2)) THEN
  1387.                CALL LIRREE(XVAL1,0,IRETOU)
  1388.                IF (IRETOU.EQ.0) THEN
  1389. C                 Il manque la valeur de la composante reelle
  1390.                   CALL ERREUR(668)
  1391.                   RETURN
  1392.                ENDIF
  1393.             ELSE
  1394.                CALL LIRREE(XVAL1,0,IRETO1)
  1395.                CALL LIRREE(XVAL2,0,IRETO2)
  1396.                IF ((IRETO1.EQ.0).OR.(IRETO2.EQ.0)) THEN
  1397. C                 Il faut specifier deux valeurs reelles
  1398.                   CALL ERREUR(673)
  1399.                   RETURN
  1400.                ENDIF
  1401.             ENDIF
  1402.          ENDIF
  1403.  
  1404. C--------- Cas de l'extraction des noms des composantes du NUAGE -------
  1405.          IF (IPROG.EQ.1) THEN
  1406.             CALL EXTR19(IPOINT,IPLSTM)
  1407.             IF (IPLSTM.NE.0) THEN
  1408.                CALL ECROBJ('LISTMOTS',IPLSTM)
  1409.             ENDIF
  1410.  
  1411. C----Cas de l'extraction de l'objet correspondant a une composante ---
  1412. C----------------- donnee d'un NUAGE "colonne" -----------------------
  1413.  
  1414.          ELSEIF (IPROG.EQ.2) THEN
  1415.             CALL EXTR51(IPOINT,IPOSI)
  1416.  
  1417. C---------------------------- Autres cas ------------------------------
  1418.          ELSEIF (IPROG.EQ.3) THEN
  1419.             IF (INU1.EQ.1) THEN
  1420.                BORINF=.TRUE.
  1421.                CALL EXTR50(IPOINT,BORINF,XVAL1,IPOSI)
  1422.             ELSEIF (INU1.EQ.2) THEN
  1423.                BORINF=.FALSE.
  1424.                CALL EXTR50(IPOINT,BORINF,XVAL1,IPOSI)
  1425.             ELSEIF (INU1.EQ.3) THEN
  1426.                MINI =.TRUE.
  1427.                CALL EXTR52(IPOINT,MINI,IPOSI)
  1428.             ELSEIF (INU1.EQ.4) THEN
  1429.                MINI =.FALSE.
  1430.                CALL EXTR52(IPOINT,MINI,IPOSI)
  1431.             ELSEIF (INU1.EQ.5) THEN
  1432.                CALL EXTR53(IPOINT,XVAL1,XVAL2,IPOSI)
  1433.             ELSE
  1434.                 CALL ERREUR(21)
  1435.                 RETURN
  1436.             ENDIF
  1437.  
  1438. C---------------------------- Cas non prevus ---------------------------
  1439.          ELSE
  1440.             CALL ERREUR(21)
  1441.             RETURN
  1442.          ENDIF
  1443.          RETURN
  1444.  
  1445.  
  1446. * +-------------------------------------------------------------------+
  1447. * |                                                                   |
  1448. * |                          L I S T O B J E                          |
  1449. * |                                                                   |
  1450. * +-------------------------------------------------------------------+
  1451.       ELSEIF (CTYP.EQ.'LISTOBJE') THEN
  1452.         CALL LIROBJ('LISTOBJE',ILOBJ,1,IRET)
  1453.         IF (IERR.NE.0) RETURN
  1454.  
  1455. C EXTRACTION DU TYPE DES OBJETS DE LA LISTE
  1456.         CALL LIRCHA(CTEXT,0,IRET)
  1457.         IF (IRET.NE.0) THEN
  1458.           IF (CTEXT(1:4).EQ.'TYPE') THEN
  1459.             MLOBJE = ILOBJ
  1460.             SEGACT,MLOBJE
  1461.             CTYP = TYPOBJ
  1462.             CALL ECRCHA(CTYP)
  1463.             RETURN
  1464.           ENDIF
  1465.         ENDIF
  1466.  
  1467. C EXTRACTION D'UN OBJET DE LA LISTE
  1468.         CALL LIRENT(I1,1,IRET)
  1469.         IF (IERR.NE.0) RETURN
  1470.         IF (I1.LE.0) THEN
  1471.           CALL ERREUR(21)
  1472.           RETURN
  1473.         ENDIF
  1474.         MLOBJE = ILOBJ
  1475.         SEGACT,MLOBJE
  1476.         NOBJ = LISOBJ(/1)
  1477.         IF (I1.GT.NOBJ) THEN
  1478.           INTERR = I1
  1479.           CALL ERREUR(620)
  1480.           RETURN
  1481.         ENDIF
  1482.         IP1  = LISOBJ(I1)
  1483.         CTYP = TYPOBJ
  1484.         CALL ECROBJ(CTYP,IP1)
  1485.         RETURN
  1486.  
  1487.  
  1488. C     FIN IF(CTYP...
  1489.       ENDIF
  1490.  
  1491.  
  1492. ***********************************************************************
  1493. * ON TRAITE LES LISTENTI, LISTREEL ET LISTMOTS SEPAREMENT POUR        *
  1494. * POUVOIR TOLERER L'INVERSION DES DEUX ARGUMENTS (LA LISTE PRINCIPALE *
  1495. * ET L'INDICE/LA LISTE D'INDICES)                                     *
  1496. ***********************************************************************
  1497.  
  1498.  
  1499. * +-------------------------------------------------------------------+
  1500. * |                                                                   |
  1501. * |                   L   I   S   T   M   O   T   S                   |
  1502. * |                                                                   |
  1503. * +-------------------------------------------------------------------+
  1504.    10 CONTINUE
  1505.       CALL LIROBJ('LISTMOTS',ILMOT1,0,IRET)
  1506.       IF (IRET.EQ.0) GOTO 20
  1507.  
  1508.       MLMOT1 = ILMOT1
  1509.       SEGACT , MLMOT1
  1510.       LONMOT = MLMOT1.MOTS(/2)
  1511.       JGN = MLMOT1.MOTS(/1)
  1512.  
  1513. *     ===============================
  1514. *     EXTRACTION DE PLUSIEURS INDICES
  1515. *     ===============================
  1516.       CALL LIROBJ('LISTENTI',ILENT,0,IRET)
  1517.       IF ( IRET .EQ. 1 ) THEN
  1518.          MLENTI = ILENT
  1519.          SEGACT , MLENTI
  1520.          JGM = LECT(/1)
  1521.          SEGINI , MLMOT2
  1522.          ILMOT2= MLMOT2
  1523.          DO 1221 I=1 , JGM
  1524.            I_EXTR =LECT(I)
  1525.             IF (( I_EXTR .GT. LONMOT ) .OR. ( I_EXTR .LT. 1 )) THEN
  1526.                INTERR(1) = I_EXTR
  1527.                CALL ERREUR(620)
  1528.             ENDIF
  1529.             MLMOT2.MOTS(I) = MLMOT1.MOTS(I_EXTR)
  1530.  1221    CONTINUE
  1531.          SEGACT , MLMOT2
  1532.          CALL ECROBJ ('LISTMOTS',ILMOT2)
  1533.          RETURN
  1534.  
  1535. *     ===========================
  1536. *     EXTRACTION D'UN SEUL INDICE
  1537. *     ===========================
  1538.       ELSE
  1539.          CALL LIRENT (ILENT,1,IRETOU)
  1540.          IF (IERR .NE. 0) RETURN
  1541.          IF (ILENT.GT.LONMOT .OR. ILENT.LT.1 ) THEN
  1542.             INTERR(1)=ILENT
  1543.             CALL ERREUR(620)
  1544.          ELSE
  1545.             CTEXT = MLMOT1.MOTS(ILENT)
  1546.          ENDIF
  1547.          CALL ECRCHA(CTEXT(1:JGN))
  1548.          RETURN
  1549.       ENDIF
  1550.  
  1551.  
  1552. * +-------------------------------------------------------------------+
  1553. * |                                                                   |
  1554. * |                   L   I   S   T   R   E   E   L                   |
  1555. * |                                                                   |
  1556. * +-------------------------------------------------------------------+
  1557.    20 CONTINUE
  1558.       CALL LIROBJ('LISTREEL',ILREE1,0,IRET)
  1559.       IF (IRET.EQ.0) GOTO 30
  1560.  
  1561.       MLREE1 = ILREE1
  1562.       SEGACT , MLREE1
  1563.       LONREE = MLREE1.PROG(/1)
  1564.  
  1565. *     ===============================
  1566. *     EXTRACTION DE PLUSIEURS INDICES
  1567. *     ===============================
  1568.       CALL LIROBJ('LISTENTI',ILENT,0,IRET)
  1569.       IF ( IRET .EQ. 1 ) THEN
  1570.          MLENTI = ILENT
  1571.          SEGACT , MLENTI
  1572.          JG = LECT(/1)
  1573.          SEGINI , MLREE2
  1574.          ILREE2= MLREE2
  1575.          DO 1231 I=1 , JG
  1576.            I_EXTR =LECT(I)
  1577.             IF (( I_EXTR .GT. LONREE ) .OR. ( I_EXTR .LT. 1 )) THEN
  1578.                INTERR(1) = I_EXTR
  1579.                CALL ERREUR(620)
  1580.                RETURN
  1581.             ENDIF
  1582.             MLREE2.PROG(I) = MLREE1.PROG(I_EXTR)
  1583.  1231    CONTINUE
  1584.          SEGACT , MLREE2
  1585.          CALL ECROBJ ('LISTREEL',ILREE2)
  1586.          RETURN
  1587.  
  1588. *     ===========================
  1589. *     EXTRACTION D'UN SEUL INDICE
  1590. *     ===========================
  1591.       ELSE
  1592.          CALL LIRENT (ILENT,1,IRETOU)
  1593.          IF (IERR .NE. 0) RETURN
  1594.          IF (ILENT.GT.LONREE .OR. ILENT.LT.1 ) THEN
  1595.             INTERR(1)=ILENT
  1596.             CALL ERREUR(620)
  1597.          ELSE
  1598.             REELDP = MLREE1.PROG(ILENT)
  1599.          ENDIF
  1600.          CALL ECRREE(REELDP)
  1601.          RETURN
  1602.       ENDIF
  1603.  124  CONTINUE
  1604.  
  1605.  
  1606. * +-------------------------------------------------------------------+
  1607. * |                                                                   |
  1608. * |                   L   I   S   T   E   N   T   I                   |
  1609. * |                                                                   |
  1610. * +-------------------------------------------------------------------+
  1611.    30 CONTINUE
  1612.       CALL LIROBJ('LISTENTI',ILENT1,0,IRET)
  1613.       IF (IRET.EQ.0) GOTO 999
  1614.  
  1615.       MLENT1 = ILENT1
  1616.       SEGACT , MLENT1
  1617.       LONENT = MLENT1.LECT(/1)
  1618.  
  1619. *     ===============================
  1620. *     EXTRACTION DE PLUSIEURS INDICES
  1621. *     ===============================
  1622.       CALL LIROBJ('LISTENTI',ILENT2,0,IRET)
  1623.       IF ( IRET .EQ. 1 ) THEN
  1624.          MLENT2 = ILENT2
  1625.          SEGACT , MLENT2
  1626.          JG = MLENT2.LECT(/1)
  1627.          SEGINI , MLENT3
  1628.          ILENT3= MLENT3
  1629.          DO I=1 , JG
  1630.             I_EXTR =MLENT2.LECT(I)
  1631.             IF (I_EXTR.GT.LONENT .OR. I_EXTR.LT.1) THEN
  1632.                INTERR(1) = I_EXTR
  1633.                CALL ERREUR(620)
  1634.             ENDIF
  1635.             MLENT3.LECT(I) = MLENT1.LECT(I_EXTR)
  1636.          ENDDO
  1637.          SEGACT , MLENT3
  1638.          CALL ECROBJ ('LISTENTI',ILENT3)
  1639.          RETURN
  1640.  
  1641. *     ===========================
  1642. *     EXTRACTION D'UN SEUL INDICE
  1643. *     ===========================
  1644.       ELSE
  1645.          CALL LIRENT (ILENT,1,IRETOU)
  1646.          IF (IERR .NE. 0) RETURN
  1647.          IF (ILENT.GT.LONENT .OR. ILENT.LT.1 ) THEN
  1648.             INTERR(1)=ILENT
  1649.             CALL ERREUR(620)
  1650.          ELSE
  1651.             INTEGR = MLENT1.LECT(ILENT)
  1652.          ENDIF
  1653.          CALL ECRENT(INTEGR)
  1654.          RETURN
  1655.       ENDIF
  1656.  
  1657.  
  1658. * +-------------------------------------------------------------------+
  1659. * |   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   |
  1660. * +-------------------------------------------------------------------+
  1661.   999 CONTINUE
  1662.       CALL ERREUR(676)
  1663.  
  1664.       END
  1665.  
  1666.  
  1667.  

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