Télécharger enlev4.eso

Retour à la liste

Numérotation des lignes :

  1. C ENLEV4 SOURCE CB215821 18/01/29 21:15:07 9715
  2. SUBROUTINE ENLEV4 (IPOINT,IEME,IPOIN3,IPOS)
  3. C***********************************************************************
  4. C
  5. C E N L E V 4
  6. C -----------
  7. C
  8. C FONCTION:
  9. C ---------
  10. C
  11. C ENLEVER LE I-EME "CHPOINT" D'UNE SUITE DE TYPE "LISTCHPO".
  12.  
  13. C PARAMETRES: (E)=ENTREE (S)=SORTIE
  14. C -----------
  15. C
  16. C IPOINT ENTIER (E) POINTEUR DE LA SUITE DE TYPE "LISTCHPO".
  17. C IEME ENTIER (E) NUMERO D'ORDRE DU "CHPOINT" A ENLEVER DANS
  18. C LA SUITE DE TYPE "LISTCHPO".
  19. C IPOIN3 ENTIER (S) POINTEUR DU 'LISTCHPO' 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 22 FEVRIER 1985
  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. -INC CCOPTIO
  41. -INC SMLCHPO
  42. -INC SMLENTI
  43. C
  44. MLCHPO = IPOINT
  45. SEGACT,MLCHPO
  46. LDIM = ICHPOI(/1)
  47.  
  48. C Y a-t-il plusieurs remplacements a faire ?
  49. IF (IPOS.LT.0) THEN
  50. MLENT1=IEME
  51. NBENLE=MLENT1.LECT(/1)
  52.  
  53. IF (NBENLE .EQ. 0) THEN
  54. C Cas de la liste VIDE
  55. SEGINI,MLCHP1=MLCHPO
  56. IPOIN3=MLCHP1
  57. RETURN
  58. ENDIF
  59.  
  60. C Le LISTENTI est ordonne donc le min en 1 et le max en NBENLE
  61. IPOMIN=MLENT1.LECT(1)
  62. IPOMAX=MLENT1.LECT(NBENLE)
  63.  
  64. IF (IPOMIN.LT.1 ) THEN
  65. C L'indice %i1 est au dela des bornes de la liste
  66. INTERR(1) = IPOMIN
  67. CALL ERREUR(620)
  68. RETURN
  69. ELSEIF (IPOMAX.GT.LDIM) THEN
  70. C L'indice %i1 est au dela des bornes de la liste
  71. INTERR(1) = IPOMAX
  72. CALL ERREUR(620)
  73. RETURN
  74. ENDIF
  75.  
  76. ELSE
  77. NBENLE=1
  78. IF (IEME.LT.1 .OR. IEME.GT.LDIM) THEN
  79. C L'indice %i1 est au dela des bornes de la liste
  80. INTERR(1) = IEME
  81. CALL ERREUR(620)
  82. RETURN
  83. ENDIF
  84. ENDIF
  85. C
  86. N1=LDIM - 1
  87. SEGINI,MLCHP1
  88. C
  89. IENLE = 1
  90. DO II=1,LDIM
  91. IF (IPOS.LT.0) IEME=MLENT1.LECT(IENLE)
  92. IF (II.EQ.IEME) THEN
  93. IENLE = IENLE + 1
  94. IF (IENLE.GT.NBENLE) GOTO 10
  95. ELSE
  96. MLCHP1.ICHPOI(II-IENLE+1) = ICHPOI(II)
  97. ENDIF
  98. ENDDO
  99.  
  100. 10 IF (IEME.LT.LDIM) THEN
  101. DO II=IEME+1,LDIM
  102. MLCHP1.ICHPOI(II-NBENLE) = ICHPOI(II)
  103. ENDDO
  104. ENDIF
  105. C
  106. N1=LDIM-NBENLE
  107. SEGADJ,MLCHP1
  108. IPOIN3=MLCHP1
  109. SEGDES,MLCHP1
  110.  
  111. RETURN
  112. END
  113.  
  114.  
  115.  

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