Télécharger la plaquette Cast3M


fr en

Télécharger ecpi.eso

Retour à la liste

Numérotation des lignes : 

ecpi

  1. C ECPI      SOURCE    CB215821  19/11/15    21:15:13     10378          
  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.  
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8 (A-H,O-Z)
  10.  
  11. -INC CCNOYAU
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15.  
  16.       DIMENSION ITAMP(2)
  17.       CHARACTER*(*) MTEM
  18.       CHARACTER*8 MTE,MTA
  19.  
  20.       IF (IERR.GT.1) RETURN
  21.  
  22. C  POUR INHIBER LA LECTURE DE CARTES
  23.       NOMLU = 1
  24.       IJDIM = JPOOB1(/1)
  25.       INCIJD= MAX(INT(REAL(IJDIM)*0.2D0),50)
  26.       DO 34 IAUX=IBPILE,IHPILE
  27.         IF(JPOOB1(IAUX)) GOTO 36
  28.   34  CONTINUE
  29.  
  30.       IAUX=IHPILE+1
  31.   36  CONTINUE
  32.       IBPILE=IAUX
  33.       I=IBPILE-1
  34.       IF (I.LT.1)  GOTO 30
  35.       JPOOB1(I)= .TRUE.
  36.       JPOOB2(I)= ITAMP(2)
  37.       JPOOB4(I)= ITAMP(1)
  38.       JTYOBJ(I)= MTEM
  39.       IBPILE   = I
  40.       RETURN
  41.  
  42.   30  CONTINUE
  43. C*****************************    ON DOIT DECALER LA PILE POUR METTRE
  44. C*****************************    LA NOUVELLE DONNEE EN PREMIER
  45.       N=IHPILE+INCIJD
  46.       IF(N.GT.IJDIM) SEGADJ,JPOOB
  47.  
  48.       DO 32 I=N,INCIJD+1,-1
  49.         JPOOB1(I)=JPOOB1(I-INCIJD)
  50.         JPOOB2(I)=JPOOB2(I-INCIJD)
  51.         JPOOB4(I)=JPOOB4(I-INCIJD)
  52.         JTYOBJ(I)=JTYOBJ(I-INCIJD)
  53.    32 CONTINUE
  54.  
  55.       JPOOB1(INCIJD)=.TRUE.
  56.       JPOOB2(INCIJD)=ITAMP(2)
  57.       JPOOB4(INCIJD)=ITAMP(1)
  58.       JTYOBJ(INCIJD)=MTEM
  59.       IHPILE=N
  60.       IBPILE=INCIJD
  61.  
  62.       END
  63.  
  64.  

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