Sources Esope | Cast3M

enlev9
C ENLEV9    SOURCE    SP204843  26/02/03    21:15:14     12461          
      SUBROUTINE ENLEV9 (IPOINT,IEME,IPOIN3,IPOS)
C***********************************************************************
C
C                             E N L E V 9
C                             -----------
C
C FONCTION:
C ---------
C
C     ENLEVER LE I-EME "OBJET" D'UN "LISTOBJE"
 
C PARAMETRES:   (E)=ENTREE   (S)=SORTIE
C -----------
C
C     IPOINT  ENTIER    (E)  POINTEUR SUR LE "LISTOBJE"
C     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'"OBJET" A ENLEVER DANS
C                            LA SUITE DE TYPE "LISTOBJE"
C     IPOIN3  ENTIER    (S)  POINTEUR DU 'LISTOBJE' CREE
C     IPOS    ENTIER    (E)  SI NEGATIF, IEME EST UN POINTEUR "LISTENTI"
C
C SOUS-PROGRAMMES APPELES:
C ------------------------
C
C     ERREUR
C
C AUTEUR, DATE DE CREATION:
C -------------------------
C
C     SERGE PASCAL       5 SEPTEMBRE 2024
C
C LANGAGE:
C --------
C
C     ESOPE + FORTRAN77
C
C***********************************************************************
C
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLOBJE
-INC SMLENTI
C
      MLOBJE = IPOINT
      SEGACT,MLOBJE
      NOBJ = LISOBJ(/1)
      NREE = RLIREE(/1)
      LDIM = MAX(NOBJ,NREE)
      IK = 1
      IF (TYPOBJ.EQ.'FLOTTANT') IK = 2
 
C     Y a-t-il plusieurs remplacements a faire ?
      IF (IPOS.LT.0) THEN
        MLENT1=IEME
        NBENLE=MLENT1.LECT(/1)
 
        IF (NBENLE .EQ. 0) THEN
C         Cas de la liste VIDE
          SEGINI,MLOBJ1=MLOBJE
          IPOIN3=MLOBJ1
          RETURN          
        ENDIF
 
C       Le LISTENTI est ordonne donc le min en 1 et le max en NBENLE
        IPOMIN=MLENT1.LECT(1)
        IPOMAX=MLENT1.LECT(NBENLE)
 
        IF     (IPOMIN.LT.1   ) THEN
C         L'indice %i1 est au dela des bornes de la liste
          INTERR(1) = IPOMIN
          CALL ERREUR(620)
          RETURN
        ELSEIF (IPOMAX.GT.LDIM) THEN
C         L'indice %i1 est au dela des bornes de la liste
          INTERR(1) = IPOMAX
          CALL ERREUR(620)
          RETURN
        ENDIF
 
      ELSE
        NBENLE=1
        IF (IEME.LT.1 .OR. IEME.GT.LDIM) THEN
C         L'indice %i1 est au dela des bornes de la liste
          INTERR(1) = IEME
          CALL ERREUR(620)
          RETURN
        ENDIF
      ENDIF
C
      NOBJ = 0
      NREE = 0
      IF (IK.EQ.1) NOBJ = LDIM - 1
      IF (IK.EQ.2) NREE = LDIM - 1
      SEGINI,MLOBJ1
      MLOBJ1.TYPOBJ = MLOBJE.TYPOBJ
C
      IENLE = 1
      DO II=1,LDIM
        IF (IPOS.LT.0) IEME=MLENT1.LECT(IENLE)
        IF (II.EQ.IEME) THEN
          IENLE = IENLE + 1
          IF (IENLE.GT.NBENLE) GOTO 10
        ELSE
          IF (IK.EQ.1) MLOBJ1.LISOBJ(II-IENLE+1) = LISOBJ(II)
          IF (IK.EQ.2) MLOBJ1.RLIREE(II-IENLE+1) = RLIREE(II)
        ENDIF
      ENDDO
 
 10   IF (IEME.LT.LDIM) THEN
        DO II=IEME+1,LDIM
          IF (IK.EQ.1) MLOBJ1.LISOBJ(II-NBENLE) = LISOBJ(II)
          IF (IK.EQ.2) MLOBJ1.RLIREE(II-NBENLE) = RLIREE(II)
        ENDDO
      ENDIF
C
      IF (IK.EQ.1) NOBJ = LDIM-NBENLE
      IF (IK.EQ.2) NREE = LDIM-NBENLE
      SEGADJ,MLOBJ1
      IPOIN3=MLOBJ1
C     SEGDES,MLOBJ1
 
      RETURN
      END