Télécharger la plaquette Cast3M


fr en

Télécharger enlev2.eso

Retour à la liste

Numérotation des lignes : 

enlev2

  1. C ENLEV2    SOURCE    CB215821  18/01/29    21:15:04     9715           
  2.       SUBROUTINE ENLEV2 (IPOINT,IEME,IPOIN3,IPOS)
  3. C***********************************************************************
  4. C
  5. C                             E N L E V 2
  6. C                             -----------
  7. C
  8. C FONCTION:
  9. C ---------
  10. C
  11. C     ENLEVER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTENTI".
  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 "LISTENTI".
  18. C     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTENTI".
  19. C     IPOIN3  ENTIER    (S)  POINTEUR DU 'LISTENTI' 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.  
  44. -INC SMLENTI
  45. C
  46.       MLENTI = IPOINT
  47.       SEGACT,MLENTI
  48.       LDIM = LECT(/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,MLENT2=MLENTI
  58.           IPOIN3=MLENT2
  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,MLENT2
  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.           MLENT2.LECT(II-IENLE+1) = LECT(II)
  99.         ENDIF
  100.       ENDDO
  101.  
  102.  10   IF (IEME.LT.LDIM) THEN
  103.         DO II=IEME+1,LDIM
  104.           MLENT2.LECT(II-NBENLE) = LECT(II)
  105.         ENDDO
  106.       ENDIF
  107. C
  108.       JG=LDIM-NBENLE
  109.       SEGADJ,MLENT2
  110.       IPOIN3=MLENT2
  111.       SEGDES,MLENT2
  112.  
  113.       RETURN
  114.       END
  115.  
  116.  
  117.  

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