C ENLEV1 SOURCE CHAT 05/01/12 23:39:41 5004 SUBROUTINE ENLEV1 (IPOINT,IEME,IPOIN3) ************************************************************************ * * E N L E V 1 * ----------- * * FONCTION: * --------- * * ENLEVER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTREEL". * * MODE D'APPEL: * ------------- * * CALL ENLEV1 (IPOINT,IEME,IPOIN3) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IEME ENTIER (E) NUMERO D'ORDRE DE L'ELEMENT A ENLEVER DANS * L'OBJET DE TYPE "LISTREEL". * IPOINT ENTIER (E) POINTEUR DE L'OBJET DE TYPE "LISTREEL". * IPOIN3 ENTIER (S) POINTEUR DU 'LISTREEL' CREE. * * SOUS-PROGRAMMES APPELES: * ------------------------ * * ERREUR * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 6 DECEMBRE 1984 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 * ************************************************************************ * IMPLICIT INTEGER(I-N) -INC CCOPTIO -INC SMLREEL * MLREEL = IPOINT SEGACT,MLREEL LDIM = PROG(/1) LDIM1 = LDIM - 1 * IF (0 .LT. IEME .AND. IEME .LE. LDIM) THEN * JG=LDIM1 SEGINI,MLREE1 IPOIN3 = MLREE1 DO 200 I=1,(IEME-1) MLREE1.PROG(I) = MLREEL.PROG(I) 200 CONTINUE * END DO DO 210 I=IEME,LDIM1 MLREE1.PROG(I) = MLREEL.PROG(I+1) 210 CONTINUE * END DO * SEGDES,MLREE1 * ELSE * INTERR(1) = IEME NUMERR = 36 CALL ERREUR (NUMERR) * END IF * SEGDES,MLREEL * END