Télécharger fillpi.eso

Retour à la liste

Numérotation des lignes :

  1. C FILLPI SOURCE PV 16/11/26 21:15:53 9205
  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. -INC CCOPTIO
  28. -INC TMCOLAC
  29. IIICHA=0
  30. SEGACT ICOLAC
  31. C
  32. C **** BOUCLE SUR LES PILES NON ENCORE ENTIEREMENT EXAMINEES. ON PREND
  33. C **** LES OBJETS COMPRIS ENTRE MCOLA(I)+1 ET ITLAC(/1)
  34. C
  35. iprem=1
  36. 10 CONTINUE
  37. IENCOR=0
  38. DO 386 IKKK=1,KCOLA(/1)
  39. ITLACC=KCOLA(IKKK)
  40. c segact ITLACC*mod
  41. N=ITLAC(/1)
  42. IF((N.NE.0.AND.N.NE.MCOLA(IKKK)).or.(iprem.eq.1.and.ikkk.eq.20))
  43. $ THEN
  44. IENCOR=1
  45. M1=MCOLA(IKKK)+1
  46. if(iprem.eq.1.and.ikkk.eq.20) M1=1
  47. M2=ITLAC(/1)
  48. CALL EXPIL (IKKK,ICOLAC,M1,M2 ,IIICHA)
  49. SEGACT ICOLAC*MOD
  50. MCOLA(IKKK)=M2
  51. ENDIF
  52. 386 CONTINUE
  53. IPREM=0
  54. IF(IENCOR.EQ.1) GO TO 10
  55. SEGDES ICOLAC
  56. RETURN
  57. END
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  

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