1 : C ECPI SOURCE CHAT 06/03/16 21:17:13 5336 2 : SUBROUTINE ECPI( ITAMP , MTEM ) 3 : C 4 : C **** ECRITURE DANS LA PILE INTERNE D'UN OBJET DE TYPE MTEM 5 : C **** ITAMP(1) EST LE NUMERO DE LA PILE DEFINITIVE 6 : C **** ITAMP(2) EST LA PLACE DANS CETTE PILE DEFINITIVE 7 : IMPLICIT INTEGER(I-N) 8 : -INC CCNOYAU 9 : -INC CCOPTIO 10 : DIMENSION ITAMP(2) 11 : CHARACTER*(*) MTEM 12 : CHARACTER*8 MTE,MTA 13 : IF (IERR.GT.1) RETURN 14 : C POUR INHIBER LA LECTURE DE CARTES 15 : NOMLU=1 16 : IJDIM=JPOOB1(/1) 17 : DO 34 IAUX=IBPILE,IHPILE 18 : IF (JPOOB1(IAUX)) GOTO 36 19 : 34 CONTINUE 20 : IAUX=IHPILE+1 21 : 36 CONTINUE 22 : IBPILE=IAUX 23 : I=IBPILE-1 24 : IF (I.LT.1) GO TO 30 25 : * 26 : JPOOB1(I)=.TRUE. 27 : JPOOB2(I)=ITAMP(2) 28 : JPOOB4(I)=ITAMP(1) 29 : JTYOBJ(I)=MTEM 30 : IBPILE=I 31 : * 32 : RETURN 33 : 30 CONTINUE 34 : C***************************** ON DOIT DECALER LA PILE POUR METTRE 35 : C***************************** LA NOUVELLE DONNEE EN PREMIER 36 : N=IHPILE+50 37 : IF(N.GT.IJDIM) THEN 38 : SEGADJ JPOOB 39 : ENDIF 40 : DO 32 I=N,51,-1 41 : JPOOB1(I)=JPOOB1(I-50) 42 : JPOOB2(I)=JPOOB2(I-50) 43 : JPOOB4(I)=JPOOB4(I-50) 44 : JTYOBJ(I)=JTYOBJ(I-50) 45 : 32 CONTINUE 46 : JPOOB1(50)=.TRUE. 47 : JPOOB2(50)=ITAMP(2) 48 : JPOOB4(50)=ITAMP(1) 49 : JTYOBJ(50)=MTEM 50 : IHPILE=N 51 : IBPILE=50 52 : RETURN 53 : END 54 :
© Cast3M 2003 - All rights reserved.
Disclaimer