C ENLEVE    SOURCE    JC220346  12/05/16    21:15:01     7372           
      SUBROUTINE ENLEVE
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
************************************************************************
*     
*                             E N L E V E
*                             -----------
*     
*            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "ENLEVER"
*     
* FONCTION:
* ---------
*     
*     ENLEVER UN ELEMENT D'UN OBJET (QUAND CELA A UN SENS).
*     
* PHRASE D'APPEL (EN GIBIANE):
* ----------------------------
*     
*     OBJET3 = ENLEVER OBJET RANG ;
*     
* OPERANDES ET RESULTATS:
* -----------------------
*     
*     OBJET     TYPE1       OBJET DONT ON ENLEVE UN ELEMENT.
*     RANG      TYPE2       INDICE DE POSITION DE L'ELEMENT A ENLEVER
*                           DE L'OBJET "OBJET".
*     OBJET3    TYPE3       CONTIENT UN ELEMENT DE MOINS QUE "OBJET".
*     
*     SI TYPE1 = ...   ALORS, TYPE2 = ...   ET TYPE3 = ...
*        LISTREEL             ENTIER           LISTREEL
*        LISTENTI             ENTIER           LISTENTI
*        LISTMOTS             ENTIER           LISTMOTS
*        LISTCHPO             ENTIER           LISTCHPO
*        TABLE                QUELCONQUE       QUELCONQUE
*     
* MODE DE FONCTIONNEMENT:
* -----------------------
*     
*     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET
*     "OBJET".
*     
* AUTEUR, DATE DE CREATION:
* -------------------------
*     
*     PASCAL MANIGOT     5 DECEMBRE 1984
*     DATE DE MODIFICATION 22 JANVIER 88
*     P.M.  21/06/88: REINTRODUCTION DES TABLES.
*     
* LANGAGE:
* --------
*     
*     FORTRAN77
*     
************************************************************************
*     
-INC CCOPTIO
-INC SMCHARG
      SEGMENT MSWMIL
      CHARACTER*(4)  MOTDDL(IA)
      ENDSEGMENT
*     
      CHARACTER*(4) CMOMOT
      CHARACTER*8 TYPIND
*     
*     
*     LECTURE EVENTUELLE D'UNE "TABLE"
*     (A LAISSER EN PREMIERE POSITION DANS CE SOUS-PROGRAMME)
*     
      CALL LIROBJ ('TABLE',IPTABL,0,IRETOU)
      IF (IRETOU .NE. 0) THEN
         CALL ENLEV6 (IPTABL,IPTAB2)
         IF (IERR .NE. 0) RETURN
         CALL ECROBJ ('TABLE',IPTAB2)
         RETURN
      END IF
      CALL LIROBJ('CHARGEME',MCHARG,0,IRETOU)
      IF(IRETOU .NE. 0) THEN
         CALL LIRCHA(CMOMOT,1,IRETOU)
         IF(IERR.NE.0)RETURN
         segini,MCHAR1=MCHARG
         N=0
         segact mcharg
         do IU=1,KCHARG(/1)
            if(CHANOM(iu).ne.CMOMOT) then
               n=n+1
               mchar1.kcharg(n)=kcharg(iu)
               mchar1.chanat(n)=chanat(iu)
               mchar1.chanom(n)=chanom(iu)
               mchar1.chamob(n)=chamob(iu)
               mchar1.chalie(n)=chalie(iu)
            endif
         enddo
         segadj mchar1
         segdes mchar1,mcharg
         call ecrobj('CHARGEME',mchar1)
         return
      ENDIF
*     
*     LECTURE D'UN CHPOINT S'IL Y A
*     
      CALL LIROBJ('CHPOINT',IPCHP,0,IRETOU)
      IF(IRETOU.NE.0) THEN
         CALL LIROBJ('LISTMOTS',MSWMIL,0,IRETOU)
         IF(IRETOU.NE.0) THEN
            CALL ENLEV5(IPCHP,MSWMIL,IPOIN2)
            IF (IERR .NE. 0) RETURN
            CALL ECROBJ ('CHPOINT',IPOIN2)
            RETURN
         ELSE
            IA=0
            SEGINI MSWMIL
 40         CALL LIRCHA(CMOMOT,0,IRETOU)
            IF(IRETOU.EQ.0) GO TO 41
            IA=IA+1
            SEGADJ MSWMIL
            MOTDDL(IA)=CMOMOT
            GO TO 40
 41         CONTINUE
            IF(IA.EQ.0) THEN
               CALL ERREUR(6)
               RETURN
            ENDIF
            CALL ENLEV5(IPCHP,MSWMIL,IPOIN2)
            SEGSUP MSWMIL
            IF (IERR .NE. 0) RETURN
            CALL ECROBJ ('CHPOINT',IPOIN2)
            RETURN
         ENDIF
      ENDIF
*     
*     LECTURE D'UNE LISTE:
*
*     IPOS=0 => on interdit à IPOIN2 de contenir un LISTENTI
      IPOS=0
      CALL LIRE01 (IPOIN1,IPOS,IPOIN2)
*     
      IF (IPOS .EQ. 1) THEN
*     
         CALL ENLEV1 (IPOIN1,IPOIN2,  IPOIN3)
         IF (IERR .NE. 0) RETURN
         CALL ECROBJ ('LISTREEL',IPOIN3)
*     
      ELSE IF (IPOS .EQ. 2) THEN
*     
         CALL ENLEV2 (IPOIN1,IPOIN2,  IPOIN3)
         IF (IERR .NE. 0) RETURN
         CALL ECROBJ ('LISTENTI',IPOIN3)
*     
      ELSE IF (IPOS .EQ. 3) THEN
*     
         CALL ENLEV3 (IPOIN1,IPOIN2,  IPOIN3)
         IF (IERR .NE. 0) RETURN
         CALL ECROBJ ('LISTMOTS',IPOIN3)
*     
      ELSE IF (IPOS .EQ. 4) THEN
*     
         CALL ENLEV4 (IPOIN1,IPOIN2,  IPOIN3)
         IF (IERR .NE. 0) RETURN
         CALL ECROBJ ('LISTCHPO',IPOIN3)
*     
      ELSE IF (IPOS .NE. 0) THEN
*     
         NUMERR = 196
         CALL ERREUR (NUMERR)
*     
      END IF
*     
      END