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