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