Esope source files

   1 : C CREPIL    SOURCE    PV        10/06/15    21:15:13     6692           
   2 :       SUBROUTINE CREPIL (ICOLAC,NITLAC)
   3 : C=======================================================================
   4 : C      CE SOUPROGRAMME INITIALISE LES PILES ICOLAC
   5 : C
   6 : C ENTREE :
   7 : C         ICOLAC POINTEUR SUR UN SEGMENT A CREER
   8 : C         NITLAC LONGUEUR DE CE SEGMENT= NB DE PILES CREEES
   9 : C  PROGRAMME PAR FARVACQUE
  10 : C  APPELE PAR SAUV
  11 : C  APPELLE :
  12 : C=======================================================================
  13 : C  TABLEAU KCOLA :
  14 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6
  15 : C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
  16 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  17 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  18 : C=======================================================================
  19 : C
  20 :       IMPLICIT INTEGER(I-N)
  21 : -INC CCOPTIO
  22 : -INC TMCOLAC
  23 : C
  24 : C=======================================================================
  25 : C  ICOLAC :  KCOLA : POINTEUR SUR LA PILE ITLACC
  26 : C            MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  27 : C            ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  28 : C            KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  29 : C                    SORTIR
  30 : C=======================================================================
  31 : C
  32 : C
  33 : C  **** INITIALISATION DE ICOLAC
  34 : C
  35 :       segment IBIDD(NP)
  35 :       CALL OOOLIS(IBIDD)
  36 :       SEGACT IBIDD
  37 : **     write(6,*) ' taille de ibidd',ibidd(/1)
  38 :       nlisse=0
  39 :       ipgcd=ibidd(1)-1
  40 :       DO 1,I=1,IBIDD(/1)
  41 :        nlisse=max(nlisse,ibidd(I))
  42 :        if (i.gt.1) ipgcd=min(ipgcd,abs(ibidd(i)-ibidd(i-1)))
  43 :   1   CONTINUE      
  44 :       SEGINI ICOLAC
  45 : *      write(6,*) 'icolac nlisse',icolac,nlisse
  46 : *      write(6,*) 'icolac pgcd  ',icolac,ipgcd
  47 : *      NLISSE = ICOLAC
  48 :       nlisse=(nlisse-1)/ipgcd
  49 :       SEGINI ILISSE
  50 :       npgcd=ipgcd
  51 :       ILISSG=ILISSE
  52 :       DO 300 I=1,NITLAC
  53 : 
  54 :          SEGINI ITLACC
  55 :          KCOLA(I)=ITLACC
  56 : 
  57 :          KS=0
  58 :          SEGINI ISGTR
  59 :             ICOLA(I)=ISGTR
  60 : 
  61 :          MCOLA(I)=0
  62 : C         KCOLAC(I)=0
  63 : 
  64 :  300  CONTINUE
  65 : C
  66 : *      SEGDES ICOLAC
  67 : *      SEGDES ILISSE
  68 : C
  69 : C
  70 :       RETURN
  71 :       END
  72 :  
  73 :  
  74 :  
  75 :  
  76 :  
  77 :  
  78 :  
  79 :