Télécharger la plaquette Cast3M


fr en

Télécharger posi.eso

Retour à la liste

Numérotation des lignes : 

posi

  1. C POSI      SOURCE    SP204843  26/02/18    21:15:05     12478          
  2. ************************************************************************
  3. * NOM         : POSI
  4. * DESCRIPTION : Renvoie la position d'éléments dans une liste d'éléments
  5. ************************************************************************
  6. * HISTORIQUE :  26/07/2012 : JCARDO : création de l'opérateur
  7. * HISTORIQUE :  14/12/2012 : JCARDO : ajout de l'option 'TOUS'
  8. * HISTORIQUE :  14/01/2014 : SG     : trouver une sous-chaine dans une
  9. *                                     chaine
  10. * HISTORIQUE :  03/03/2022 : CB     : Passage des chaines a LOCHAI
  11. * HISTORIQUE :
  12. ************************************************************************
  13. * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  14. * en cas de modification de ce sous-programme afin de faciliter
  15. * la maintenance !
  16. ************************************************************************
  17. * APPELÉ PAR : pilot.eso
  18. ************************************************************************
  19. * ENTRÉES :: aucune
  20. * SORTIES :: aucune
  21. ************************************************************************
  22. * SYNTAXES (GIBIANE) : voir la notice
  23. *
  24. * 1) CHERCHE LA PREMIÈRE OCCURRENCE D'UN ITEM DANS UNE LISTE :
  25. *              ENTI1 = POSI ENTI2 'DANS' LENT1 ;
  26. *              ENTI1 = POSI FLOT1 'DANS' LREE1 (DTOL1) ;
  27. *              ENTI1 = POSI MOT1  'DANS' LMOT1 ('NOCA') ;
  28. *
  29. * 2) CHERCHE TOUTES LES OCCURRENCES D'UN ITEM DANS UNE LISTE :
  30. *              LENT1 = POSI ENTI1 'DANS' LENT2          'TOUS' ;
  31. *              LENT1 = POSI FLOT1 'DANS' LREE1 (DTOL1)  'TOUS' ;
  32. *              LENT1 = POSI MOT1  'DANS' LMOT1 ('NOCA') 'TOUS' ;
  33. *
  34. * 3) CHERCHE LA PREMIÈRE OCCURRENCE DE PLUSIEURS ITEMS DANS UNE LISTE :
  35. *              LENT1 = POSI LENT2 'DANS' LENT3 ;
  36. *              LENT1 = POSI LREE1 'DANS' LREE2 (DTOL1) ;
  37. *              LENT1 = POSI LMOT1 'DANS' LMOT2 ('NOCA') ;
  38. *
  39. *
  40.  
  41. *
  42. ************************************************************************
  43.       SUBROUTINE POSI
  44.  
  45.       IMPLICIT INTEGER(I-N)
  46.       IMPLICIT REAL*8(A-H,O-Z)
  47.  
  48.  
  49. -INC PPARAM
  50. -INC CCOPTIO
  51. -INC CCNOYAU
  52. -INC CCREEL
  53.  
  54. -INC SMLENTI
  55. -INC SMLREEL
  56. -INC SMLMOTS
  57. -INC SMELEME
  58.  
  59.       EXTERNAL LONG
  60.       PARAMETER (NCLE=2)
  61.       CHARACTER*4 MCLE,LCLE(NCLE)
  62.  
  63.       CHARACTER*8 MTYP2,MTYP3,MTYP4
  64.       CHARACTER*(LONOM) CNOM
  65.  
  66.       CHARACTER*(LOCHAI) MVAL2,MVAL3
  67.       CHARACTER*(LOCHAI) MVAL2L,MVAL3L
  68. *
  69.       LOGICAL ZLISTE,ZNOCA,ZTOUS
  70.  
  71.       DATA LCLE/'NOCA','TOUS'/
  72. *
  73. *     +---------------------------------------------------------------+
  74. *     |                                                               |
  75. *     |           L E C T U R E   D E S   A R G U M E N T S           |
  76. *     |                                                               |
  77. *     +---------------------------------------------------------------+
  78. *
  79. *     NOTATIONS :
  80. *
  81. *        +--------------------------------------------------------+
  82. *        |  OBJET1 = POSI OBJET2 'DANS' OBJET3 (OBJET4) ('TOUS')  |
  83. *        +--------------------------------------------------------+
  84. *
  85. *     =====================================================
  86. *     LECTURE DE L'ITEM OU DE LA LISTE D'ITEMS A RECHERCHER => OBJET2
  87. *     =====================================================
  88.  
  89.       CALL QUETYP(MTYP2,1,IRETOU)
  90.       IF (IERR.NE.0) RETURN
  91.  
  92.       ZLISTE=.FALSE.
  93.       IF (MTYP2.EQ.'ENTIER') THEN
  94.          MTYP3='LISTENTI'
  95.          CALL LIRENT(IVAL2,1,IRETOU)
  96.       ELSEIF (MTYP2.EQ.'FLOTTANT') THEN
  97.          MTYP3='LISTREEL'
  98.          CALL LIRREE(XVAL2,1,IRETOU)
  99.       ELSEIF (MTYP2.EQ.'MOT') THEN
  100.          MTYP3='LISTMOTS'
  101.          CALL LIRCHA(MVAL2L,1,IRETOU)
  102.       ELSEIF (MTYP2.EQ.'POINT') THEN
  103.          MTYP3='MAILLAGE'
  104.          CALL LIROBJ(MTYP2,IVAL2,1,IRETOU)
  105.       ELSEIF (MTYP2.EQ.'LISTENTI'.OR.
  106.      &        MTYP2.EQ.'LISTREEL'.OR.
  107.      &        MTYP2.EQ.'LISTMOTS'.OR.
  108.      &        MTYP2.EQ.'MAILLAGE') THEN
  109.          MTYP3=MTYP2
  110.          ZLISTE=.TRUE.
  111.          CALL LIROBJ(MTYP2,IOBJ2,1,IRETOU)
  112.       ELSE
  113. *         ERREUR 39 (On ne veut pas d'objet de type %m1:8)
  114.          MOTERR=MTYP2
  115.          CALL ERREUR(39)
  116.          RETURN
  117.       ENDIF
  118.  
  119. *     =====================
  120. *     LECTURE DU MOT 'DANS'
  121. *     =====================
  122.  
  123.       CALL LIRCHA(MCLE,0,IRETOU)
  124.       ITROUV=0
  125.       IF (IRETOU.GT.0) THEN
  126.          IF (MCLE(1:4).EQ.'DANS') ITROUV=1
  127.       ENDIF
  128.  
  129.  
  130.       IF (ITROUV.EQ.0) THEN
  131. *         ERREUR 396 (Il manque le mot-clé %m1:4)
  132.          MOTERR='DANS'
  133.          CALL ERREUR(396)
  134.          RETURN
  135.       ENDIF
  136.  
  137. *     ======================================================
  138. *     LECTURE DE LA LISTE DANS LAQUELLE ON FAIT LA RECHERCHE => OBJET3
  139. *     ======================================================
  140.  
  141.       CALL LIROBJ(MTYP3,IOBJ3,0,IRETOU)
  142.       IF (IRETOU.EQ.0) THEN
  143. *sg Dans le cas où MTYP2 est MOT, on peut aussi vouloir lire un deuxième
  144. *sg  MOT
  145.          IF (MTYP2.EQ.'MOT') THEN
  146.             CALL LIRCHA(MVAL3L,1,IRETOU)
  147.             IF (IERR.NE.0) RETURN
  148.             MTYP3='MOT     '
  149.          ELSE
  150. *         ERREUR 166 (Le mot-clé %m1:4 n'est pas suivi de la donnée
  151. *                     correspondante)
  152.             MOTERR='DANS'
  153.             CALL ERREUR(166)
  154.             RETURN
  155.          ENDIF
  156.       ENDIF
  157.       MVAL2=MVAL2L
  158. *
  159. *     =================================
  160. *     LECTURE DES PARAMETRES OPTIONNELS => OBJET4
  161. *     =================================
  162. *     On fait en sorte de pouvoir lire ces arguments dans n'importe
  163. *     quel ordre, ce qui n'est pas trivial étant donné leurs types et
  164. *     les combinaisons possibles
  165.  
  166.       ZNOCA=.FALSE.
  167.       ZTOUS=.FALSE.
  168. *     ICRIT=0 :: CRIT = Precision machine RELATIVE pour les REAL*8
  169. *     ICRIT=1 :: CRIT = Precision ABSOLUE choisie par l'utilisateur
  170.       ICRIT=0
  171.       CRIT=10.D0*XZPREC
  172.  
  173. *     (Label 5 = boucle sur les arguments optionnels)
  174.  5    CALL QUETYP(MTYP4,0,IRETOU)
  175.       IF (IRETOU.EQ.0) GOTO 6
  176.  
  177. *     LECTURE D'UN CRITERE DE PRECISION
  178. *     ---------------------------------
  179.       IF (MTYP4.EQ.'FLOTTANT') THEN
  180.          IF (MTYP3.NE.'LISTREEL') THEN
  181. *             ERREUR 39 (On ne veut pas d'objet de type %m1:8)
  182.             MOTERR='FLOTTANT'
  183.             CALL ERREUR(39)
  184.             RETURN
  185.          ENDIF
  186.          CALL LIRREE(CRIT,1,IRETOU)
  187.          ICRIT=1
  188.  
  189. *     LECTURE D'UN MOT-CLE
  190. *     --------------------
  191.       ELSEIF (MTYP4.EQ.'MOT') THEN
  192.  
  193.          CALL LIRMOT(LCLE,NCLE,ICLE,0)
  194.  
  195. *      => MOT-CLE 'NOCA'
  196.          IF (ICLE.EQ.1) THEN
  197.             IF (MTYP3.NE.'LISTMOTS'.AND.MTYP3.NE.'MOT') THEN
  198. *                 ERREUR 7 (On ne comprend pas le mot %m)
  199.                MOTERR='NOCA'
  200.                CALL ERREUR(7)
  201.                RETURN
  202.             ENDIF
  203.             ZNOCA=.TRUE.
  204.  
  205. *      => MOT-CLE 'TOUS'
  206.          ELSEIF (ICLE.EQ.2) THEN
  207.             ZTOUS=.TRUE.
  208.  
  209. *      => MOT-CLE INVALIDE...
  210.          ELSE
  211. *             ERREUR 7 (On ne comprend pas le mot %m1:4)
  212.             CALL LIRCHA(MCLE,1,IRETOU)
  213.             MOTERR=MCLE
  214.             CALL ERREUR(7)
  215.             RETURN
  216.          ENDIF
  217.  
  218.  
  219. *     LECTURE D'UN ARGUMENT INVALIDE...
  220. *     ---------------------------------
  221.       ELSE
  222. *         ERREUR 11 (Il y a un résultat de type %m1:8 et de nom %m9:16
  223. *                    en trop par rapport aux noms à affecter)
  224.          CALL LIROBJ(MTYP4,IOBJ4,1,IRETOU)
  225.          CALL QUENOM(CNOM)
  226.          MOTERR      =MTYP4
  227.          MOTERR(9:16)=CNOM
  228.          CALL ERREUR(11)
  229.          RETURN
  230.       ENDIF
  231.  
  232.       GOTO 5
  233.  6    CONTINUE
  234.  
  235.  
  236.  
  237.  
  238. *     +---------------------------------------------------------------+
  239. *     |                                                               |
  240. *     | R E C H E R C H E   D E   O B J E T 2   D A N S   O B J E T 3 |
  241. *     |                                                               |
  242. *     +---------------------------------------------------------------+
  243.  
  244.  
  245. *     ================================================
  246. *     CAS OU OBJET3 EST UNE LISTE D'ENTIERS (LISTENTI)
  247. *     ================================================
  248.  
  249.       IF (MTYP3.EQ.'LISTENTI') THEN
  250.          MLENT3=IOBJ3
  251.          SEGACT,MLENT3
  252.          NN3=MLENT3.LECT(/1)
  253.  
  254. *         SYNTAXE 3
  255. *         ------------------------------------
  256.          IF (ZLISTE) THEN
  257.             MLENT2=IOBJ2
  258.             SEGACT,MLENT2
  259.             NN2=MLENT2.LECT(/1)
  260.  
  261.             JG=NN2
  262.             SEGINI,MLENT1
  263. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  264.  
  265.             DO 10 J=1,NN2
  266.                IVAL2=MLENT2.LECT(J)
  267.                DO I=1,NN3
  268.                   IVAL3=MLENT3.LECT(I)
  269.                   IF (IVAL2.EQ.IVAL3) THEN
  270.                      MLENT1.LECT(J)=I
  271.                      GOTO 10
  272.                   ENDIF
  273.                ENDDO
  274.  10         CONTINUE
  275.  
  276.             CALL ECROBJ('LISTENTI',MLENT1)
  277.             SEGDES,MLENT1,MLENT2
  278.  
  279. *         SYNTAXE 2
  280. *         ------------------------------------
  281.          ELSEIF (ZTOUS) THEN
  282.             JG=NN3
  283.             SEGINI,MLENT1
  284. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  285.  
  286.             JG=0
  287.             DO I=1,NN3
  288.                IVAL3=MLENT3.LECT(I)
  289.                IF (IVAL2.EQ.IVAL3) THEN
  290.                   JG=JG+1
  291.                   MLENT1.LECT(JG)=I
  292.                ENDIF
  293.             ENDDO
  294.             SEGADJ,MLENT1
  295.  
  296.             CALL ECROBJ('LISTENTI',MLENT1)
  297.             SEGDES,MLENT1
  298.  
  299. *         SYNTAXE 1
  300. *         ------------------------------------
  301.          ELSE
  302.             IVAL1=0
  303. c               IVAL1=-1
  304.             DO I=1,NN3
  305.                IVAL3=MLENT3.LECT(I)
  306.                IF (IVAL2.EQ.IVAL3) THEN
  307.                   IVAL1=I
  308.                   GOTO 11
  309.                ENDIF
  310.             ENDDO
  311.  11         CALL ECRENT(IVAL1)
  312.          ENDIF
  313.  
  314.          SEGDES,MLENT3
  315.  
  316.  
  317. *     ===============================================
  318. *     CAS OU OBJET3 EST UNE LISTE DE REELS (LISTREEL)
  319. *     ===============================================
  320.  
  321.       ELSEIF (MTYP3.EQ.'LISTREEL') THEN
  322.          MLREE3=IOBJ3
  323.          SEGACT,MLREE3
  324.          NN3=MLREE3.PROG(/1)
  325.  
  326. *         SYNTAXE 3
  327. *         ------------------------------------
  328.          IF (ZLISTE) THEN
  329.             MLREE2=IOBJ2
  330.             SEGACT,MLREE2
  331.             NN2=MLREE2.PROG(/1)
  332.  
  333.             JG=NN2
  334.             SEGINI,MLENT1
  335. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  336.  
  337.             XCRIT=CRIT
  338.             DO 20 J=1,NN2
  339.                XVAL2=MLREE2.PROG(J)
  340.                DO I=1,NN3
  341.                   XVAL3=MLREE3.PROG(I)
  342.  
  343.                   IF (ICRIT.EQ.1) THEN
  344.                     IF (ABS(XVAL2-XVAL3).LT.ABS(XCRIT)) THEN
  345.                        MLENT1.LECT(J)=I
  346.                        GOTO 20
  347.                     ENDIF
  348.                   ELSE
  349.                     IF (A_EGALE_B(XVAL2,XVAL3)) THEN
  350.                        MLENT1.LECT(J)=I
  351.                        GOTO 20
  352.                     ENDIF
  353.                   ENDIF
  354.  
  355.                ENDDO
  356.  20         CONTINUE
  357.  
  358.             CALL ECROBJ('LISTENTI',MLENT1)
  359.             SEGDES,MLENT1,MLREE2
  360.  
  361. *         SYNTAXE 2
  362. *         ------------------------------------
  363.          ELSEIF (ZTOUS) THEN
  364.             JG=NN3
  365.             SEGINI,MLENT1
  366. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  367.  
  368.             JG=0
  369.             XCRIT=CRIT
  370.             DO I=1,NN3
  371.                XVAL3=MLREE3.PROG(I)
  372.  
  373.                IF (ICRIT.EQ.1) THEN
  374.                  IF (ABS(XVAL2-XVAL3).LT.ABS(XCRIT)) THEN
  375.                     JG=JG+1
  376.                     MLENT1.LECT(JG)=I
  377.                  ENDIF
  378.                ELSE
  379.                  IF (A_EGALE_B(XVAL2,XVAL3)) THEN
  380.                     JG=JG+1
  381.                     MLENT1.LECT(JG)=I
  382.                  ENDIF
  383.                ENDIF
  384.  
  385.             ENDDO
  386.             SEGADJ,MLENT1
  387.  
  388.             CALL ECROBJ('LISTENTI',MLENT1)
  389.             SEGDES,MLENT1
  390.  
  391. *         SYNTAXE 1
  392. *         ------------------------------------
  393.          ELSE
  394.             IVAL1=0
  395. c               IVAL1=-1
  396.             XCRIT=CRIT
  397.             DO I=1,NN3
  398.                XVAL3=MLREE3.PROG(I)
  399.  
  400.                IF (ICRIT.EQ.1) THEN
  401.                  IF (ABS(XVAL2-XVAL3).LT.ABS(XCRIT)) THEN
  402.                     IVAL1=I
  403.                     GOTO 21
  404.                  ENDIF
  405.                ELSE
  406.                  IF (A_EGALE_B(XVAL2,XVAL3)) THEN
  407.                     IVAL1=I
  408.                     GOTO 21
  409.                  ENDIF
  410.                ENDIF
  411.  
  412.             ENDDO
  413.  21         CALL ECRENT(IVAL1)
  414.          ENDIF
  415.  
  416.          SEGDES,MLREE3
  417.  
  418.  
  419. *     ==============================================
  420. *     CAS OU OBJET3 EST UNE LISTE DE MOTS (LISTMOTS)
  421. *     ==============================================
  422.  
  423.       ELSEIF (MTYP3.EQ.'LISTMOTS') THEN
  424.          MLMOT3=IOBJ3
  425.          SEGACT,MLMOT3
  426.          NN3=MLMOT3.MOTS(/2)
  427.  
  428. *         SYNTAXE 3
  429. *         ------------------------------------
  430.          IF (ZLISTE) THEN
  431.             MLMOT2=IOBJ2
  432.             SEGACT,MLMOT2
  433.             NN2=MLMOT2.MOTS(/2)
  434.  
  435.             JG=NN2
  436.             SEGINI,MLENT1
  437. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  438.  
  439.             DO 30 J=1,NN2
  440.                MVAL2=MLMOT2.MOTS(J)
  441.                DO I=1,NN3
  442.                   MVAL3=MLMOT3.MOTS(I)
  443.  
  444. *                     Si la recherche est insensible a la casse, on
  445. *                     passe tout en majuscules avant d'effectuer la
  446. *                     comparaison
  447.                   IF (ZNOCA) THEN
  448.                      CALL MINMAJ(MVAL2)
  449.                      CALL MINMAJ(MVAL3)
  450.                   ENDIF
  451.  
  452.                   IF (MVAL2.EQ.MVAL3) THEN
  453.                      MLENT1.LECT(J)=I
  454.                      GOTO 30
  455.                   ENDIF
  456.                ENDDO
  457.  30         CONTINUE
  458.  
  459.             CALL ECROBJ('LISTENTI',MLENT1)
  460.             SEGDES,MLENT1,MLMOT2
  461.  
  462. *         SYNTAXE 2
  463. *         ------------------------------------
  464.          ELSEIF (ZTOUS) THEN
  465.             JG=NN3
  466.             SEGINI,MLENT1
  467. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  468.  
  469.             JG=0
  470.             DO I=1,NN3
  471.                MVAL3=MLMOT3.MOTS(I)
  472.  
  473. *                 Si la recherche est insensible a la casse, on
  474. *                 passe tout en majuscules avant d'effectuer la
  475. *                 comparaison
  476.                IF (ZNOCA) THEN
  477.                   CALL MINMAJ(MVAL2)
  478.                   CALL MINMAJ(MVAL3)
  479.                ENDIF
  480.  
  481.                IF (MVAL2.EQ.MVAL3) THEN
  482.                   JG=JG+1
  483.                   MLENT1.LECT(JG)=I
  484.                ENDIF
  485.             ENDDO
  486.             SEGADJ,MLENT1
  487.  
  488.             CALL ECROBJ('LISTENTI',MLENT1)
  489.             SEGDES,MLENT1
  490.  
  491. *         SYNTAXE 1
  492. *         ------------------------------------
  493.          ELSE
  494.             IVAL1=0
  495. c               IVAL1=-1
  496.             DO I=1,NN3
  497.                MVAL3=MLMOT3.MOTS(I)
  498.  
  499. *                 Si la recherche est insensible a la casse, on
  500. *                 passe tout en majuscules avant d'effectuer la
  501. *                 comparaison
  502.                IF (ZNOCA) THEN
  503.                   CALL MINMAJ(MVAL2)
  504.                   CALL MINMAJ(MVAL3)
  505.                ENDIF
  506.  
  507.                IF (MVAL2.EQ.MVAL3) THEN
  508.                   IVAL1=I
  509.                   GOTO 31
  510.                ENDIF
  511.             ENDDO
  512.  31         CALL ECRENT(IVAL1)
  513.          ENDIF
  514.  
  515.          SEGDES,MLMOT3
  516.  
  517.  
  518. *     ==============================================
  519. *     CAS OU OBJET3 EST UN MOT
  520. *     ==============================================
  521.  
  522.       ELSEIF (MTYP3.EQ.'MOT') THEN
  523.          LONG3 = LONG(MVAL3L)
  524.          LONG2 = LONG(MVAL2L)
  525. *         WRITE(IOIMP,*) MVAL2L
  526. *         WRITE(IOIMP,*) MVAL3L
  527. *                 Si la recherche est insensible a la casse, on
  528. *                 passe tout en majuscules avant d'effectuer la
  529. *                 comparaison
  530.          IF (ZNOCA) THEN
  531.             CALL MINMAJ(MVAL2L(1:LONG2))
  532.             CALL MINMAJ(MVAL3L(1:LONG3))
  533.          ENDIF
  534. *         WRITE(IOIMP,*) MVAL2L
  535. *         WRITE(IOIMP,*) MVAL3L
  536. *      PAS DE   SYNTAXE 3
  537. *         SYNTAXE 2
  538. *         ------------------------------------
  539.          IF (ZTOUS) THEN
  540.             NREC=LONG3-LONG2+1
  541.             JG=NREC
  542.             SEGINI,MLENT1
  543.             JG=0
  544.             ICOLD=1
  545. *            WRITE(IOIMP,*) 'NREC=',NREC
  546.             DO I=1,NREC
  547.                IC=INDEX(MVAL3L(ICOLD:LONG3),MVAL2L(1:LONG2))
  548. *               WRITE(IOIMP,*) 'IC=',IC
  549.                IF (IC.EQ.0) GOTO 8
  550.                JG=JG+1
  551.                MLENT1.LECT(JG)=ICOLD+IC-1
  552.                ICOLD=ICOLD+IC
  553.             ENDDO
  554.  8          CONTINUE
  555.             SEGADJ,MLENT1
  556.             SEGDES,MLENT1
  557.             CALL ECROBJ('LISTENTI',MLENT1)
  558. *         SYNTAXE 1
  559. *         ------------------------------------
  560.          ELSE
  561.             IC=INDEX(MVAL3L(1:LONG3),MVAL2L(1:LONG2))
  562.             CALL ECRENT(IC)
  563.          ENDIF
  564.  
  565.  
  566.  
  567. *     ================================================
  568. *     CAS OU OBJET3 EST UN MAILLAGE
  569. *     ================================================
  570.  
  571.       ELSEIF (MTYP3.EQ.'MAILLAGE') THEN
  572.          IPT3=IOBJ3
  573.          SEGACT,IPT3
  574.  
  575. c        verification qu'il s'agit d'un maillage avec 1 zone de POI1
  576.          NBREF3=IPT3.LISREF(/1)
  577.          IF(NBREF3.NE.0) THEN
  578.            MOTERR='MAILLAGE'
  579.            CALL ERREUR(132)
  580.            RETURN
  581.          ENDIF
  582.          ITYPEL3=IPT3.ITYPEL
  583.          IF(ITYPEL3.NE.1) THEN
  584.            WRITE(IOIMP,*) 'Maillage de POI1 attendu en entree !'
  585.            CALL ERREUR(16)
  586.            RETURN
  587.          ENDIF
  588.  
  589.          NN3=IPT3.NUM(/2)
  590.  
  591. *         SYNTAXE 3
  592. *         ------------------------------------
  593.          IF (ZLISTE) THEN
  594.             IPT2=IOBJ2
  595.             SEGACT,IPT2
  596.             NN2=IPT2.NUM(/2)
  597.  
  598.             JG=NN2
  599.             SEGINI,MLENT1
  600. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  601.  
  602.             DO 40 J=1,NN2
  603.                IVAL2=IPT2.NUM(1,J)
  604.                DO I=1,NN3
  605.                   IVAL3=IPT3.NUM(1,I)
  606.                   IF (IVAL2.EQ.IVAL3) THEN
  607.                      MLENT1.LECT(J)=I
  608.                      GOTO 40
  609.                   ENDIF
  610.                ENDDO
  611.  40         CONTINUE
  612.  
  613.             CALL ECROBJ('LISTENTI',MLENT1)
  614.             SEGDES,MLENT1,IPT2
  615.  
  616. *         SYNTAXE 2
  617. *         ------------------------------------
  618.          ELSEIF (ZTOUS) THEN
  619.             JG=NN3
  620.             SEGINI,MLENT1
  621. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  622.  
  623.             JG=0
  624.             DO I=1,NN3
  625.                IVAL3=IPT3.NUM(1,I)
  626.                IF (IVAL2.EQ.IVAL3) THEN
  627.                   JG=JG+1
  628.                   MLENT1.LECT(JG)=I
  629.                ENDIF
  630.             ENDDO
  631.             SEGADJ,MLENT1
  632.  
  633.             CALL ECROBJ('LISTENTI',MLENT1)
  634.             SEGDES,MLENT1
  635.  
  636. *         SYNTAXE 1
  637. *         ------------------------------------
  638.          ELSE
  639.             IVAL1=0
  640.             DO I=1,NN3
  641.                IVAL3=IPT3.NUM(1,I)
  642.                IF (IVAL2.EQ.IVAL3) THEN
  643.                   IVAL1=I
  644.                   GOTO 41
  645.                ENDIF
  646.             ENDDO
  647.  41         CALL ECRENT(IVAL1)
  648.          ENDIF
  649.  
  650.          SEGDES,IPT3
  651.  
  652.  
  653.       ENDIF
  654.  
  655.  
  656.  
  657.       RETURN
  658.       END
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  
  670.  
  671.  

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