1 : C ENLEV6 SOURCE CHAT 05/01/12 23:40:02 5004 2 : SUBROUTINE ENLEV6 (IPTABL, IPTAB2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * E N L E V 6 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * ENLEVER UN ELEMENT D'UNE "TABLE". 14 : * 15 : * MODULES UTILISES: 16 : * ----------------- 17 : * 18 : -INC CCOPTIO 19 : -INC SMTABLE 20 : * 21 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 22 : * ----------- 23 : * 24 : * IPTABL (E) TABLE A REDUIRE. 25 : * INDICE INDICE DE L'OBJET A ENLEVER. 26 : * TYPIND TYPE DE L'INDICE DE L'OBJET A ENLEVER. 27 : * IPTAB2 (S) TABLE REDUITE. 28 : * 29 : CHARACTER*(8) TYPIND 30 : * 31 : * AUTEUR, DATE DE CREATION: 32 : * ------------------------- 33 : * 34 : * PASCAL MANIGOT 21 JUIN 1988 35 : * 36 : * LANGAGE: 37 : * -------- 38 : * 39 : * ESOPE + FORTRAN77 40 : * 41 : ************************************************************************ 42 : * 43 : 43 : CALL QUETYP ( TYPIND,1,IRETOU) 44 : IF(IERR.NE.0) RETURN 45 : IF(TYPIND.EQ.'FLOTTANT' ) THEN 45 : CALL LIRREE ( XVA,1,IRETOU) 46 : ELSE 46 : CALL LIROBJ ( TYPIND , INDICE, 1,IRETOU) 47 : ENDIF 48 : IF ( IERR.NE.0) RETURN 49 : MTABLE = IPTABL 50 : SEGACT,MTABLE 51 : M = MLOTAB 52 : M0 = 0 53 : IF (TYPIND.EQ.'FLOTTANT') THEN 54 : DO 103 I=1,M 55 : IF( RMTABI(I) . EQ. XVA) THEN 56 : M0 = I 57 : GO TO 102 58 : ENDIF 59 : 103 CONTINUE 60 : ELSE 61 : DO 100 I=1,M 62 : IF (MTABTI(I) .EQ. TYPIND) THEN 63 : IF (MTABII(I) .EQ. INDICE) THEN 64 : M0 = I 65 : GOTO 102 66 : END IF 67 : END IF 68 : 100 CONTINUE 69 : * END DO 70 : ENDIF 71 : 102 CONTINUE 72 : * 73 : IF (M0 .EQ. 0) THEN 73 : CALL ERREUR (171) 74 : RETURN 75 : END IF 76 : * 77 : M = M - 1 78 : SEGINI,MTAB2 79 : MTAB2.MLOTAB=M 80 : IPTAB2 = MTAB2 81 : * 82 : DO 200 I=1,(M0-1) 83 : MTAB2.MTABTI(I) = MTABLE.MTABTI(I) 84 : MTAB2.MTABTV(I) = MTABLE.MTABTV(I) 85 : MTAB2.RMTABI(I) = MTABLE.RMTABI(I) 86 : MTAB2.MTABII(I) = MTABLE.MTABII(I) 87 : MTAB2.MTABIV(I) = MTABLE.MTABIV(I) 88 : MTAB2.RMTABV(I) = MTABLE.RMTABV(I) 89 : 200 CONTINUE 90 : * END DO 91 : DO 210 I=M0,M 92 : MTAB2.MTABTI(I) = MTABLE.MTABTI(I+1) 93 : MTAB2.MTABTV(I) = MTABLE.MTABTV(I+1) 94 : MTAB2.RMTABI(I) = MTABLE.RMTABI(I+1) 95 : MTAB2.MTABII(I) = MTABLE.MTABII(I+1) 96 : MTAB2.MTABIV(I) = MTABLE.MTABIV(I+1) 97 : MTAB2.RMTABV(I) = MTABLE.RMTABV(I+1) 98 : 210 CONTINUE 99 : * END DO 100 : * 101 : SEGDES,MTABLE 102 : SEGDES,MTAB2 103 : * 104 : END 105 : 106 :
© Cast3M 2003 - All rights reserved.
Disclaimer