Télécharger ecpi.eso

Retour à la liste

Numérotation des lignes :

  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.  
  55.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales