Download fillpi.eso

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer