Esope source files

   1 : C ENLEVE    SOURCE    JC220346  12/05/16    21:15:01     7372           
   2 :       SUBROUTINE ENLEVE
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : ************************************************************************
   6 : *     
   7 : *                             E N L E V E
   8 : *                             -----------
   9 : *     
  10 : *            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "ENLEVER"
  11 : *     
  12 : * FONCTION:
  13 : * ---------
  14 : *     
  15 : *     ENLEVER UN ELEMENT D'UN OBJET (QUAND CELA A UN SENS).
  16 : *     
  17 : * PHRASE D'APPEL (EN GIBIANE):
  18 : * ----------------------------
  19 : *     
  20 : *     OBJET3 = ENLEVER OBJET RANG ;
  21 : *     
  22 : * OPERANDES ET RESULTATS:
  23 : * -----------------------
  24 : *     
  25 : *     OBJET     TYPE1       OBJET DONT ON ENLEVE UN ELEMENT.
  26 : *     RANG      TYPE2       INDICE DE POSITION DE L'ELEMENT A ENLEVER
  27 : *                           DE L'OBJET "OBJET".
  28 : *     OBJET3    TYPE3       CONTIENT UN ELEMENT DE MOINS QUE "OBJET".
  29 : *     
  30 : *     SI TYPE1 = ...   ALORS, TYPE2 = ...   ET TYPE3 = ...
  31 : *        LISTREEL             ENTIER           LISTREEL
  32 : *        LISTENTI             ENTIER           LISTENTI
  33 : *        LISTMOTS             ENTIER           LISTMOTS
  34 : *        LISTCHPO             ENTIER           LISTCHPO
  35 : *        TABLE                QUELCONQUE       QUELCONQUE
  36 : *     
  37 : * MODE DE FONCTIONNEMENT:
  38 : * -----------------------
  39 : *     
  40 : *     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET
  41 : *     "OBJET".
  42 : *     
  43 : * AUTEUR, DATE DE CREATION:
  44 : * -------------------------
  45 : *     
  46 : *     PASCAL MANIGOT     5 DECEMBRE 1984
  47 : *     DATE DE MODIFICATION 22 JANVIER 88
  48 : *     P.M.  21/06/88: REINTRODUCTION DES TABLES.
  49 : *     
  50 : * LANGAGE:
  51 : * --------
  52 : *     
  53 : *     FORTRAN77
  54 : *     
  55 : ************************************************************************
  56 : *     
  57 : -INC CCOPTIO
  58 : -INC SMCHARG
  59 :       SEGMENT MSWMIL
  60 :       CHARACTER*(4)  MOTDDL(IA)
  61 :       ENDSEGMENT
  62 : *     
  63 :       CHARACTER*(4) CMOMOT
  64 :       CHARACTER*8 TYPIND
  65 : *     
  66 : *     
  67 : *     LECTURE EVENTUELLE D'UNE "TABLE"
  68 : *     (A LAISSER EN PREMIERE POSITION DANS CE SOUS-PROGRAMME)
  69 : *     
  69 :       CALL LIROBJ ('TABLE',IPTABL,0,IRETOU)
  70 :       IF (IRETOU .NE. 0) THEN
  70 :          CALL ENLEV6 (IPTABL,IPTAB2)
  71 :          IF (IERR .NE. 0) RETURN
  71 :          CALL ECROBJ ('TABLE',IPTAB2)
  72 :          RETURN
  73 :       END IF
  73 :       CALL LIROBJ('CHARGEME',MCHARG,0,IRETOU)
  74 :       IF(IRETOU .NE. 0) THEN
  74 :          CALL LIRCHA(CMOMOT,1,IRETOU)
  75 :          IF(IERR.NE.0)RETURN
  76 :          segini,MCHAR1=MCHARG
  77 :          N=0
  78 :          segact mcharg
  79 :          do IU=1,KCHARG(/1)
  80 :             if(CHANOM(iu).ne.CMOMOT) then
  81 :                n=n+1
  82 :                mchar1.kcharg(n)=kcharg(iu)
  83 :                mchar1.chanat(n)=chanat(iu)
  84 :                mchar1.chanom(n)=chanom(iu)
  85 :                mchar1.chamob(n)=chamob(iu)
  86 :                mchar1.chalie(n)=chalie(iu)
  87 :             endif
  88 :          enddo
  89 :          segadj mchar1
  90 :          segdes mchar1,mcharg
  90 :          call ecrobj('CHARGEME',mchar1)
  91 :          return
  92 :       ENDIF
  93 : *     
  94 : *     LECTURE D'UN CHPOINT S'IL Y A
  95 : *     
  95 :       CALL LIROBJ('CHPOINT',IPCHP,0,IRETOU)
  96 :       IF(IRETOU.NE.0) THEN
  96 :          CALL LIROBJ('LISTMOTS',MSWMIL,0,IRETOU)
  97 :          IF(IRETOU.NE.0) THEN
  97 :             CALL ENLEV5(IPCHP,MSWMIL,IPOIN2)
  98 :             IF (IERR .NE. 0) RETURN
  98 :             CALL ECROBJ ('CHPOINT',IPOIN2)
  99 :             RETURN
 100 :          ELSE
 101 :             IA=0
 102 :             SEGINI MSWMIL
 102 :  40         CALL LIRCHA(CMOMOT,0,IRETOU)
 103 :             IF(IRETOU.EQ.0) GO TO 41
 104 :             IA=IA+1
 105 :             SEGADJ MSWMIL
 106 :             MOTDDL(IA)=CMOMOT
 107 :             GO TO 40
 108 :  41         CONTINUE
 109 :             IF(IA.EQ.0) THEN
 109 :                CALL ERREUR(6)
 110 :                RETURN
 111 :             ENDIF
 111 :             CALL ENLEV5(IPCHP,MSWMIL,IPOIN2)
 112 :             SEGSUP MSWMIL
 113 :             IF (IERR .NE. 0) RETURN
 113 :             CALL ECROBJ ('CHPOINT',IPOIN2)
 114 :             RETURN
 115 :          ENDIF
 116 :       ENDIF
 117 : *     
 118 : *     LECTURE D'UNE LISTE:
 119 : *
 120 : *     IPOS=0 => on interdit à IPOIN2 de contenir un LISTENTI
 121 :       IPOS=0
 121 :       CALL LIRE01 (IPOIN1,IPOS,IPOIN2)
 122 : *     
 123 :       IF (IPOS .EQ. 1) THEN
 124 : *     
 124 :          CALL ENLEV1 (IPOIN1,IPOIN2,  IPOIN3)
 125 :          IF (IERR .NE. 0) RETURN
 125 :          CALL ECROBJ ('LISTREEL',IPOIN3)
 126 : *     
 127 :       ELSE IF (IPOS .EQ. 2) THEN
 128 : *     
 128 :          CALL ENLEV2 (IPOIN1,IPOIN2,  IPOIN3)
 129 :          IF (IERR .NE. 0) RETURN
 129 :          CALL ECROBJ ('LISTENTI',IPOIN3)
 130 : *     
 131 :       ELSE IF (IPOS .EQ. 3) THEN
 132 : *     
 132 :          CALL ENLEV3 (IPOIN1,IPOIN2,  IPOIN3)
 133 :          IF (IERR .NE. 0) RETURN
 133 :          CALL ECROBJ ('LISTMOTS',IPOIN3)
 134 : *     
 135 :       ELSE IF (IPOS .EQ. 4) THEN
 136 : *     
 136 :          CALL ENLEV4 (IPOIN1,IPOIN2,  IPOIN3)
 137 :          IF (IERR .NE. 0) RETURN
 137 :          CALL ECROBJ ('LISTCHPO',IPOIN3)
 138 : *     
 139 :       ELSE IF (IPOS .NE. 0) THEN
 140 : *     
 141 :          NUMERR = 196
 141 :          CALL ERREUR (NUMERR)
 142 : *     
 143 :       END IF
 144 : *     
 145 :       END
 146 : 
 147 : 
 148 : 
 149 : 
 150 : 
 151 :  
 152 :