Esope source files

   1 : C IMPPIL    SOURCE    CHAT      05/01/13    00:34:22     5004           
   2 :       SUBROUTINE IMPPIL (ITOTO,IVOULU)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C=======================================================================
   6 : C      CE SUBROUTINE IMPRIME SUR LE FICHIER IOIMP
   7 : C      LE CONTENU DES PILES
   8 : C      APPELE PAR SAUV
   9 : C      APPELLE :
  10 : C      ECRIT PAR FARVACQUE-LENA
  11 : C=======================================================================
  12 : C  TABLEAU KCOLA :
  13 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6
  14 : C    77          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
  15 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  16 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  17 : C=======================================================================
  18 : -INC CCOPTIO
  19 : -INC TMCOLAC
  20 : C=======================================================================
  21 : C  ICOLAC :  KCOLA : POINTEUR SUR LA PILE ITLACC
  22 : C            MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE
  23 : C            ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC)
  24 : C            KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A
  25 : C                    SORTIR
  26 : C=======================================================================
  27 : C
  28 :       IF (IVOULU.NE.0) THEN
  29 :          NPIL1=IVOULU
  30 :          NPIL2= NPIL1
  31 :       ELSE
  32 :          ICOLAC=ITOTO
  33 :          NPIL1=1
  34 :          SEGACT ICOLAC
  35 :          NITLAC=ICOLA(/1)
  36 :          NPIL2=NITLAC
  37 :          WRITE(IOIMP,900)(ICOLA(I),KCOLA(I),MCOLA(I),
  38 :      +                                               I=1,NPIL2)
  39 :       ENDIF
  40 : 
  41 :       DO 2 I=NPIL1,NPIL2
  42 :          IF (IVOULU.EQ.0) THEN
  43 :             ITLACC=KCOLA(I)
  44 :             segact itlacc
  45 :          ELSE
  46 :             ITLACC=ITOTO
  47 :          ENDIF
  48 :          N1=ITLAC(/1)
  49 :          WRITE(IOIMP,901) I,N1
  50 :          IF(I.EQ.38)  WRITE(6,*) (ITLAC(KO),KO=1,N1)
  51 :          IF (IVOULU.NE.0) GO TO 2
  52 : 
  53 :          ISGTR=ICOLA(I)
  54 :          IF(ISGTR.EQ.0) GO TO 1
  55 :          segact isgtr
  56 :          WRITE(IOIMP,906)
  57 :          NTOTO=ISGTRI(/1)
  58 :          IF (NTOTO.NE.0) THEN
  59 :             DO 9 K=1,NTOTO
  60 :                WRITE(IOIMP,905) ISGTRC(K),ISGTRI(K)
  61 :  9          CONTINUE
  62 :          ENDIF
  63 :  1       CONTINUE
  64 :  2    CONTINUE
  65 :       IF (IVOULU.EQ.0) SEGDES ICOLAC
  66 :       RETURN
  67 : C
  68 :  900  FORMAT(' SEGMENT ICOLAC ,TETE DES PILES'/(1X,3I8) )
  69 :  901  FORMAT('  PILE NUMERO=',I4,'  . IL Y A ',I5,'  TERMES.')
  70 :  902  FORMAT(6I12)
  71 :  906  FORMAT(' TABLES DES  NOMS-POINTEURS ASSOCIES')
  72 :  905  FORMAT(2X,A8,1X,I8)
  73 : C
  74 :       END
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :