C ENLEV3 SOURCE CHAT 05/01/12 23:39:48 5004 SUBROUTINE ENLEV3 (IPOINT,IEME,IPOIN3) ************************************************************************ * * E N L E V 3 * ----------- * * FONCTION: * --------- * * ENLEVER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTMOTS". * * MODE D'APPEL: * ------------- * * CALL ENLEV3 (IPOINT,IEME,IPOIN3) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IEME ENTIER (E) NUMERO D'ORDRE DE L'ELEMENT A ENLEVER DANS * L'OBJET DE TYPE "LISTMOTS". * IPOINT ENTIER (E) POINTEUR DE L'OBJET DE TYPE "LISTMOTS". * IPOIN3 ENTIER (S) POINTEUR DU 'LISTMOTS' CREE. * * SOUS-PROGRAMMES APPELES: * ------------------------ * * ERREUR * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 6 DECEMBRE 1984 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS * ************************************************************************ * IMPLICIT INTEGER(I-N) -INC CCOPTIO -INC SMLMOTS * MLMOTS = IPOINT SEGACT,MLMOTS LDIM = MOTS(/2) LDIM1 = LDIM - 1 * IF (0 .LT. IEME .AND. IEME .LE. LDIM) THEN * JGN=MOTS(/1) JGM=LDIM1 SEGINI,MLMOT1 IPOIN3 = MLMOT1 * END DO * DO 200 I=1,(IEME-1) MLMOT1.MOTS(I) = MLMOTS.MOTS(I) 200 CONTINUE * END DO DO 210 I=IEME,LDIM1 MLMOT1.MOTS(I) = MLMOTS.MOTS(I+1) 210 CONTINUE * END DO * SEGDES,MLMOT1 * ELSE * INTERR(1) = IEME NUMERR = 36 CALL ERREUR (NUMERR) * END IF * SEGDES,MLMOTS * END