Télécharger la plaquette Cast3M


fr en

Télécharger enlev9.eso

Retour à la liste

Numérotation des lignes : 

enlev9

  1. C ENLEV9    SOURCE    SP204843  24/09/05    21:15:02     12005          
  2.       SUBROUTINE ENLEV9 (IPOINT,IEME,IPOIN3,IPOS)
  3. C***********************************************************************
  4. C
  5. C                             E N L E V 9
  6. C                             -----------
  7. C
  8. C FONCTION:
  9. C ---------
  10. C
  11. C     ENLEVER LE I-EME "OBJET" D'UN "LISTOBJE"
  12.  
  13. C PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  14. C -----------
  15. C
  16. C     IPOINT  ENTIER    (E)  POINTEUR SUR LE "LISTOBJE"
  17. C     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'"OBJET" A ENLEVER DANS
  18. C                            LA SUITE DE TYPE "LISTOBJE"
  19. C     IPOIN3  ENTIER    (S)  POINTEUR DU 'LISTOBJE' 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     SERGE PASCAL       5 SEPTEMBRE 2024
  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 SMLOBJE
  44. -INC SMLENTI
  45. C
  46.       MLOBJE = IPOINT
  47.       SEGACT,MLOBJE
  48.       LDIM = LISOBJ(/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,MLOBJ1=MLOBJE
  58.           IPOIN3=MLOBJ1
  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.       NOBJ=LDIM - 1
  89.       SEGINI,MLOBJ1
  90.       MLOBJ1.TYPOBJ = MLOBJE.TYPOBJ
  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.           MLOBJ1.LISOBJ(II-IENLE+1) = LISOBJ(II)
  100.         ENDIF
  101.       ENDDO
  102.  
  103.  10   IF (IEME.LT.LDIM) THEN
  104.         DO II=IEME+1,LDIM
  105.           MLOBJ1.LISOBJ(II-NBENLE) = LISOBJ(II)
  106.         ENDDO
  107.       ENDIF
  108. C
  109.       NOBJ=LDIM-NBENLE
  110.       SEGADJ,MLOBJ1
  111.       IPOIN3=MLOBJ1
  112. C     SEGDES,MLOBJ1
  113.  
  114.       RETURN
  115.       END
  116.  
  117.  
  118.  
  119.  

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