Télécharger la plaquette Cast3M


fr en

Télécharger enlev3.eso

Retour à la liste

Numérotation des lignes : 

enlev3

  1. C ENLEV3    SOURCE    CB215821  18/01/29    21:15:05     9715           
  2.       SUBROUTINE ENLEV3 (IPOINT,IEME,IPOIN3,IPOS)
  3. C***********************************************************************
  4. C
  5. C                             E N L E V 3
  6. C                             -----------
  7. C
  8. C FONCTION:
  9. C ---------
  10. C
  11. C     ENLEVER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTMOTS".
  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 "LISTMOTS".
  18. C     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTMOTS".
  19. C     IPOIN3  ENTIER    (S)  POINTEUR DU 'LISTMOTS' 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 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  36. C
  37. C***********************************************************************
  38. C
  39.       IMPLICIT INTEGER(I-N)
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC SMLMOTS
  44. -INC SMLENTI
  45. C
  46.       MLMOTS = IPOINT
  47.       SEGACT,MLMOTS
  48.       LDIM = MOTS(/2)
  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,MLMOT1=MLMOTS
  58.           IPOIN3=MLMOT1
  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.       JGN=MOTS(/1)
  89.       JGM=LDIM - 1
  90.       SEGINI,MLMOT1
  91. C
  92.       IENLE = 1
  93.       DO II=1,LDIM
  94.         IF (IPOS.LT.0) IEME=MLENT1.LECT(IENLE)
  95.         IF (II.EQ.IEME) THEN
  96.           IENLE = IENLE + 1
  97.           IF (IENLE.GT.NBENLE) GOTO 10
  98.         ELSE
  99.           MLMOT1.MOTS(II-IENLE+1) = MOTS(II)
  100.         ENDIF
  101.       ENDDO
  102.  
  103.  10   IF (IEME.LT.LDIM) THEN
  104.         DO II=IEME+1,LDIM
  105.           MLMOT1.MOTS(II-NBENLE) = MOTS(II)
  106.         ENDDO
  107.       ENDIF
  108. C
  109.       JGM=LDIM-NBENLE
  110.       SEGADJ,MLMOT1
  111.       IPOIN3=MLMOT1
  112.       SEGDES,MLMOT1
  113.  
  114.       RETURN
  115.       END
  116.  
  117.  
  118.  

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