Télécharger enlev1.eso

Retour à la liste

Numérotation des lignes :

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

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