1 : C INSER1 SOURCE CHAT 05/01/13 00:38:44 5004 2 : SUBROUTINE INSER1 (MLREEL,IEME,REELDP) 3 : ************************************************************************ 4 : * 5 : * I N S E R 1 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * INSERER UN ELEMENT EN I-EME POSITION (ET NON PAS APRES LA I-EME 12 : * POSITION) DANS UN OBJET DE TYPE 'LISTREEL'. 13 : * 14 : * 15 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 16 : * ----------- 17 : * 18 : * MLREEL ENTIER (E) POINTEUR DE L'OBJET DE TYPE "LISTREEL". 19 : * IEME ENTIER (E) POSITION D'INSERTION DE L'ELEMENT DANS 20 : * L'OBJET DE TYPE "LISTREEL". 21 : * REELDP REEL DP (E) ELEMENT INSERE. 22 : * 23 : * SOUS-PROGRAMMES APPELES: 24 : * ------------------------ 25 : * 26 : * ERREUR 27 : * 28 : * AUTEUR, DATE DE CREATION: 29 : * ------------------------- 30 : * 31 : * PASCAL MANIGOT 6 DECEMBRE 1984 32 : * 33 : * LANGAGE: 34 : * -------- 35 : * 36 : * ESOPE + FORTRAN77 37 : * 38 : ************************************************************************ 39 : * 40 : IMPLICIT INTEGER(I-N) 41 : -INC CCOPTIO 42 : -INC SMLREEL 43 : * 44 : REAL*8 REELDP 45 : * 46 : SEGACT,MLREEL 47 : LDIM = PROG(/1) 48 : LDIM1 = LDIM + 1 49 : JG = LDIM1 50 : SEGADJ,MLREEL 51 : 52 : * 53 : * 54 : IF (0 .LT. IEME .AND. IEME .LE. LDIM1) THEN 55 : IF ( IEME .LT .LDIM1) THEN 56 : DO 110 I= LDIM , IEME , -1 57 : PROG(I + 1 ) = PROG(I) 58 : 110 CONTINUE 59 : ENDIF 60 : PROG(IEME) = REELDP 61 : ELSE 62 : INTERR(1) = IEME 63 : NUMERR = 36 63 : CALL ERREUR (NUMERR) 64 : * 65 : END IF 66 : * 67 : SEGDES,MLREEL 68 : * 69 : END 70 :
© Cast3M 2003 - All rights reserved.
Disclaimer