Télécharger la plaquette Cast3M


fr en

Télécharger fillpi.eso

Retour à la liste

Numérotation des lignes : 

fillpi

  1. C FILLPI    SOURCE    PV        17/12/05    21:16:22     9646           
  2.       SUBROUTINE FILLPI (ICOLAC)
  3. C----------------------------------------------------------------------
  4. C
  5. C  BUT:  REMPLIT LES PILES A PARTIR DE L EXAMEN DE CHAQUE PILE
  6. C        SI IIICHA =1 ON  CHANGE  LES POINTEURS----
  7. C  ****  ON COMPTE DANS CHAQUE PILE ITLACC LE NOMBRE D'OBJETS A
  8. C        SORTIR
  9. C  ****  ON REGARDE SI TOUS LES OBJETS DE CHAQUE PILE ONT ETE EXAMINES
  10. C        (TEST N.EQ.MCOLA)
  11. C        ON BOUCLE JUSQU A EPUISEMENT
  12. C        LE TRAVAIL EST TERMINE QUAND IK=0
  13. C  ****  ITRAVV CONTIENT LES NUMEROS DES PILES A TRAITER
  14. C
  15. C----------------------------------------------------------------
  16. C   PROGRAMME PAR FARVACQUE- REPRIS PAR LENA
  17. C   APPELE PAR    SAUV
  18. C   APPELLE       EXPIL
  19. C
  20. C=======================================================================
  21. C  TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL
  22. C=======================================================================
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.       integer iencor, iiicha, ikkk, iprem
  26.       integer m1, m2, n
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30. -INC TMCOLAC
  31.       IIICHA=0
  32.       SEGACT ICOLAC
  33. C
  34. C  **** BOUCLE SUR LES PILES NON ENCORE ENTIEREMENT EXAMINEES. ON PREND
  35. C  **** LES OBJETS COMPRIS ENTRE MCOLA(I)+1 ET ITLAC(/1)
  36. C
  37.       iprem=1
  38.  10   CONTINUE
  39.       IENCOR=0
  40.       DO 386 IKKK=1,KCOLA(/1)
  41.          ITLACC=KCOLA(IKKK)
  42. c         segact ITLACC*mod
  43.          N=ITLAC(/1)
  44.        IF((N.NE.0.AND.N.NE.MCOLA(IKKK)).or.(iprem.eq.1.and.ikkk.eq.20))
  45.      $     THEN
  46.             IENCOR=1
  47.             M1=MCOLA(IKKK)+1
  48.             if(iprem.eq.1.and.ikkk.eq.20) M1=1
  49.             M2=ITLAC(/1)
  50.             CALL EXPIL (IKKK,ICOLAC,M1,M2 ,IIICHA)
  51.             SEGACT ICOLAC*MOD
  52.             MCOLA(IKKK)=M2
  53.          ENDIF
  54.  386  CONTINUE
  55.       IPREM=0
  56.       IF(IENCOR.EQ.1) GO TO 10
  57.       SEGDES ICOLAC
  58.       RETURN
  59.       END
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  

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