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    CB215821  23/07/12    21:15:10     11704          
  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.             DO 20 J=1,NN2
  338.                XVAL2=MLREE2.PROG(J)
  339.                DO I=1,NN3
  340.                   XVAL3=MLREE3.PROG(I)
  341.  
  342.                   XCRIT=CRIT
  343.                   IF (ICRIT.EQ.0) XCRIT=XCRIT*MAX(XVAL2,XVAL3)
  344.  
  345. c                       IF (XVAL2.EQ.XVAL3) THEN
  346.                   IF (ABS(XVAL2-XVAL3).LT.ABS(XCRIT)) THEN
  347.                      MLENT1.LECT(J)=I
  348.                      GOTO 20
  349.                   ENDIF
  350.                ENDDO
  351.  20         CONTINUE
  352.  
  353.             CALL ECROBJ('LISTENTI',MLENT1)
  354.             SEGDES,MLENT1,MLREE2
  355.  
  356. *         SYNTAXE 2
  357. *         ------------------------------------
  358.          ELSEIF (ZTOUS) THEN
  359.             JG=NN3
  360.             SEGINI,MLENT1
  361. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  362.  
  363.             JG=0
  364.             DO I=1,NN3
  365.                XVAL3=MLREE3.PROG(I)
  366.  
  367.                XCRIT=CRIT
  368.                IF (ICRIT.EQ.0) XCRIT=XCRIT*MAX(XVAL2,XVAL3)
  369.  
  370. c                   IF (XVAL2.EQ.XVAL3) THEN
  371.                IF (ABS(XVAL2-XVAL3).LT.ABS(XCRIT)) THEN
  372.                   JG=JG+1
  373.                   MLENT1.LECT(JG)=I
  374.                ENDIF
  375.             ENDDO
  376.             SEGADJ,MLENT1
  377.  
  378.             CALL ECROBJ('LISTENTI',MLENT1)
  379.             SEGDES,MLENT1
  380.  
  381. *         SYNTAXE 1
  382. *         ------------------------------------
  383.          ELSE
  384.             IVAL1=0
  385. c               IVAL1=-1
  386.             DO I=1,NN3
  387.                XVAL3=MLREE3.PROG(I)
  388.  
  389.                XCRIT=CRIT
  390.                IF (ICRIT.EQ.0) XCRIT=XCRIT*MAX(XVAL2,XVAL3)
  391.  
  392. c                   IF (XVAL2.EQ.XVAL3) THEN
  393.                IF (ABS(XVAL2-XVAL3).LT.ABS(XCRIT)) THEN
  394.                   IVAL1=I
  395.                   GOTO 21
  396.                ENDIF
  397.             ENDDO
  398.  21         CALL ECRENT(IVAL1)
  399.          ENDIF
  400.  
  401.          SEGDES,MLREE3
  402.  
  403.  
  404. *     ==============================================
  405. *     CAS OU OBJET3 EST UNE LISTE DE MOTS (LISTMOTS)
  406. *     ==============================================
  407.  
  408.       ELSEIF (MTYP3.EQ.'LISTMOTS') THEN
  409.          MLMOT3=IOBJ3
  410.          SEGACT,MLMOT3
  411.          NN3=MLMOT3.MOTS(/2)
  412.  
  413. *         SYNTAXE 3
  414. *         ------------------------------------
  415.          IF (ZLISTE) THEN
  416.             MLMOT2=IOBJ2
  417.             SEGACT,MLMOT2
  418.             NN2=MLMOT2.MOTS(/2)
  419.  
  420.             JG=NN2
  421.             SEGINI,MLENT1
  422. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  423.  
  424.             DO 30 J=1,NN2
  425.                MVAL2=MLMOT2.MOTS(J)
  426.                DO I=1,NN3
  427.                   MVAL3=MLMOT3.MOTS(I)
  428.  
  429. *                     Si la recherche est insensible a la casse, on
  430. *                     passe tout en majuscules avant d'effectuer la
  431. *                     comparaison
  432.                   IF (ZNOCA) THEN
  433.                      CALL MINMAJ(MVAL2)
  434.                      CALL MINMAJ(MVAL3)
  435.                   ENDIF
  436.  
  437.                   IF (MVAL2.EQ.MVAL3) THEN
  438.                      MLENT1.LECT(J)=I
  439.                      GOTO 30
  440.                   ENDIF
  441.                ENDDO
  442.  30         CONTINUE
  443.  
  444.             CALL ECROBJ('LISTENTI',MLENT1)
  445.             SEGDES,MLENT1,MLMOT2
  446.  
  447. *         SYNTAXE 2
  448. *         ------------------------------------
  449.          ELSEIF (ZTOUS) THEN
  450.             JG=NN3
  451.             SEGINI,MLENT1
  452. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  453.  
  454.             JG=0
  455.             DO I=1,NN3
  456.                MVAL3=MLMOT3.MOTS(I)
  457.  
  458. *                 Si la recherche est insensible a la casse, on
  459. *                 passe tout en majuscules avant d'effectuer la
  460. *                 comparaison
  461.                IF (ZNOCA) THEN
  462.                   CALL MINMAJ(MVAL2)
  463.                   CALL MINMAJ(MVAL3)
  464.                ENDIF
  465.  
  466.                IF (MVAL2.EQ.MVAL3) THEN
  467.                   JG=JG+1
  468.                   MLENT1.LECT(JG)=I
  469.                ENDIF
  470.             ENDDO
  471.             SEGADJ,MLENT1
  472.  
  473.             CALL ECROBJ('LISTENTI',MLENT1)
  474.             SEGDES,MLENT1
  475.  
  476. *         SYNTAXE 1
  477. *         ------------------------------------
  478.          ELSE
  479.             IVAL1=0
  480. c               IVAL1=-1
  481.             DO I=1,NN3
  482.                MVAL3=MLMOT3.MOTS(I)
  483.  
  484. *                 Si la recherche est insensible a la casse, on
  485. *                 passe tout en majuscules avant d'effectuer la
  486. *                 comparaison
  487.                IF (ZNOCA) THEN
  488.                   CALL MINMAJ(MVAL2)
  489.                   CALL MINMAJ(MVAL3)
  490.                ENDIF
  491.  
  492.                IF (MVAL2.EQ.MVAL3) THEN
  493.                   IVAL1=I
  494.                   GOTO 31
  495.                ENDIF
  496.             ENDDO
  497.  31         CALL ECRENT(IVAL1)
  498.          ENDIF
  499.  
  500.          SEGDES,MLMOT3
  501.  
  502.  
  503. *     ==============================================
  504. *     CAS OU OBJET3 EST UN MOT
  505. *     ==============================================
  506.  
  507.       ELSEIF (MTYP3.EQ.'MOT') THEN
  508.          LONG3 = LONG(MVAL3L)
  509.          LONG2 = LONG(MVAL2L)
  510. *         WRITE(IOIMP,*) MVAL2L
  511. *         WRITE(IOIMP,*) MVAL3L
  512. *                 Si la recherche est insensible a la casse, on
  513. *                 passe tout en majuscules avant d'effectuer la
  514. *                 comparaison
  515.          IF (ZNOCA) THEN
  516.             CALL MINMAJ(MVAL2L(1:LONG2))
  517.             CALL MINMAJ(MVAL3L(1:LONG3))
  518.          ENDIF
  519. *         WRITE(IOIMP,*) MVAL2L
  520. *         WRITE(IOIMP,*) MVAL3L
  521. *      PAS DE   SYNTAXE 3
  522. *         SYNTAXE 2
  523. *         ------------------------------------
  524.          IF (ZTOUS) THEN
  525.             NREC=LONG3-LONG2+1
  526.             JG=NREC
  527.             SEGINI,MLENT1
  528.             JG=0
  529.             ICOLD=1
  530. *            WRITE(IOIMP,*) 'NREC=',NREC
  531.             DO I=1,NREC
  532.                IC=INDEX(MVAL3L(ICOLD:LONG3),MVAL2L(1:LONG2))
  533. *               WRITE(IOIMP,*) 'IC=',IC
  534.                IF (IC.EQ.0) GOTO 8
  535.                JG=JG+1
  536.                MLENT1.LECT(JG)=ICOLD+IC-1
  537.                ICOLD=ICOLD+IC
  538.             ENDDO
  539.  8          CONTINUE
  540.             SEGADJ,MLENT1
  541.             SEGDES,MLENT1
  542.             CALL ECROBJ('LISTENTI',MLENT1)
  543. *         SYNTAXE 1
  544. *         ------------------------------------
  545.          ELSE
  546.             IC=INDEX(MVAL3L(1:LONG3),MVAL2L(1:LONG2))
  547.             CALL ECRENT(IC)
  548.          ENDIF
  549.  
  550.  
  551.  
  552. *     ================================================
  553. *     CAS OU OBJET3 EST UN MAILLAGE
  554. *     ================================================
  555.  
  556.       ELSEIF (MTYP3.EQ.'MAILLAGE') THEN
  557.          IPT3=IOBJ3
  558.          SEGACT,IPT3
  559.  
  560. c        verification qu'il s'agit d'un maillage avec 1 zone de POI1
  561.          NBREF3=IPT3.LISREF(/1)
  562.          IF(NBREF3.NE.0) THEN
  563.            MOTERR='MAILLAGE'
  564.            CALL ERREUR(132)
  565.            RETURN
  566.          ENDIF
  567.          ITYPEL3=IPT3.ITYPEL
  568.          IF(ITYPEL3.NE.1) THEN
  569.            WRITE(IOIMP,*) 'Maillage de POI1 attendu en entree !'
  570.            CALL ERREUR(16)
  571.            RETURN
  572.          ENDIF
  573.  
  574.          NN3=IPT3.NUM(/2)
  575.  
  576. *         SYNTAXE 3
  577. *         ------------------------------------
  578.          IF (ZLISTE) THEN
  579.             IPT2=IOBJ2
  580.             SEGACT,IPT2
  581.             NN2=IPT2.NUM(/2)
  582.  
  583.             JG=NN2
  584.             SEGINI,MLENT1
  585. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  586.  
  587.             DO 40 J=1,NN2
  588.                IVAL2=IPT2.NUM(1,J)
  589.                DO I=1,NN3
  590.                   IVAL3=IPT3.NUM(1,I)
  591.                   IF (IVAL2.EQ.IVAL3) THEN
  592.                      MLENT1.LECT(J)=I
  593.                      GOTO 40
  594.                   ENDIF
  595.                ENDDO
  596.  40         CONTINUE
  597.  
  598.             CALL ECROBJ('LISTENTI',MLENT1)
  599.             SEGDES,MLENT1,IPT2
  600.  
  601. *         SYNTAXE 2
  602. *         ------------------------------------
  603.          ELSEIF (ZTOUS) THEN
  604.             JG=NN3
  605.             SEGINI,MLENT1
  606. c               CALL INITI(MLENT1.LECT(1),JG,-1)
  607.  
  608.             JG=0
  609.             DO I=1,NN3
  610.                IVAL3=IPT3.NUM(1,I)
  611.                IF (IVAL2.EQ.IVAL3) THEN
  612.                   JG=JG+1
  613.                   MLENT1.LECT(JG)=I
  614.                ENDIF
  615.             ENDDO
  616.             SEGADJ,MLENT1
  617.  
  618.             CALL ECROBJ('LISTENTI',MLENT1)
  619.             SEGDES,MLENT1
  620.  
  621. *         SYNTAXE 1
  622. *         ------------------------------------
  623.          ELSE
  624.             IVAL1=0
  625.             DO I=1,NN3
  626.                IVAL3=IPT3.NUM(1,I)
  627.                IF (IVAL2.EQ.IVAL3) THEN
  628.                   IVAL1=I
  629.                   GOTO 41
  630.                ENDIF
  631.             ENDDO
  632.  41         CALL ECRENT(IVAL1)
  633.          ENDIF
  634.  
  635.          SEGDES,IPT3
  636.  
  637.  
  638.       ENDIF
  639.  
  640.  
  641.  
  642.       RETURN
  643.       END
  644.  
  645.  
  646.  
  647.  
  648.  
  649.  
  650.  
  651.  
  652.  
  653.  
  654.  
  655.  

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