Télécharger enlev3.eso

Retour à la liste

Numérotation des lignes :

  1. C ENLEV3 SOURCE CB215821 17/04/20 21:15:07 9406
  2. SUBROUTINE ENLEV3 (IPOINT,IEME,IPOIN3,IPOS)
  3. ************************************************************************
  4. *
  5. * E N L E V 3
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * ENLEVER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTMOTS".
  12. *
  13. * MODE D'APPEL:
  14. * -------------
  15. *
  16. * CALL ENLEV3 (IPOINT,IEME,IPOIN3)
  17. *
  18. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  19. * -----------
  20. *
  21. * IEME ENTIER (E) NUMERO D'ORDRE DE L'ELEMENT A ENLEVER DANS
  22. * L'OBJET DE TYPE "LISTMOTS".
  23. * IPOINT ENTIER (E) POINTEUR DE L'OBJET DE TYPE "LISTMOTS".
  24. * IPOIN3 ENTIER (S) POINTEUR DU 'LISTMOTS' CREE.
  25. * IPOS ENTIER (E) SI NEGATIF, IEME EST UN POINTEUR "LISTENTI"
  26. *
  27. * SOUS-PROGRAMMES APPELES:
  28. * ------------------------
  29. *
  30. * ERREUR
  31. *
  32. * AUTEUR, DATE DE CREATION:
  33. * -------------------------
  34. *
  35. * PASCAL MANIGOT 6 DECEMBRE 1984
  36. *
  37. * LANGAGE:
  38. * --------
  39. *
  40. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  41. *
  42. ************************************************************************
  43. *
  44. IMPLICIT INTEGER(I-N)
  45. -INC CCOPTIO
  46. -INC SMLMOTS
  47. -INC SMLENTI
  48. *
  49. MLMOTS = IPOINT
  50. SEGACT,MLMOTS
  51. LDIM = MOTS(/2)
  52. LDIM1 = LDIM - 1
  53. *
  54. * Y a-t-il plusieurs remplacements a faire ?
  55. NBENLE=1
  56. IF (IPOS.LT.0) THEN
  57. MLENT1=IEME
  58. NBENLE=MLENT1.LECT(/1)
  59. IPOMIN=MLENT1.LECT(1)
  60. IPOMAX=MLENT1.LECT(NBENLE)
  61. IF (IPOMIN.LT.1 ) THEN
  62. * L'indice %i1 est au dela des bornes de la liste
  63. INTERR(1) = IPOMIN
  64. CALL ERREUR(620)
  65. RETURN
  66. ELSEIF (IPOMAX.GT.LDIM) THEN
  67. * L'indice %i1 est au dela des bornes de la liste
  68. INTERR(1) = IPOMAX
  69. CALL ERREUR(620)
  70. RETURN
  71. ENDIF
  72. ELSE
  73. IF (IEME.LT.1 .OR. IEME.GT.LDIM) THEN
  74. * L'indice %i1 est au dela des bornes de la liste
  75. INTERR(1) = IEME
  76. CALL ERREUR(620)
  77. RETURN
  78. ENDIF
  79. ENDIF
  80. *
  81. JGN=MOTS(/1)
  82. JGM=LDIM1
  83. SEGINI,MLMOT1
  84. *
  85. IENLE = 1
  86. DO II=1,LDIM
  87. IF (IPOS.LT.0) IEME=MLENT1.LECT(IENLE)
  88. IF (II.EQ.IEME) THEN
  89. IENLE = IENLE + 1
  90. IF (IENLE.GT.NBENLE) GOTO 10
  91. ELSE
  92. MLMOT1.MOTS(II-IENLE+1) = MOTS(II)
  93. ENDIF
  94. ENDDO
  95. 10 IF (IEME.LT.LDIM) THEN
  96. DO II=IEME+1,LDIM
  97. MLMOT1.MOTS(II-NBENLE) = MOTS(II)
  98. ENDDO
  99. ENDIF
  100. *
  101. JGM=LDIM-NBENLE
  102. SEGADJ,MLMOT1
  103. IPOIN3=MLMOT1
  104. SEGDES,MLMOT1
  105.  
  106. RETURN
  107. END
  108.  
  109.  

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