Esope source files

   1 : C FILLLU    SOURCE    FANDEUR   10/12/14    21:16:28     6812           
   2 :       SUBROUTINE FILLLU (ISORTA,ICOLAC)
   3 : C=======================================================================
   4 : C      CE SOUPROGRAMME REMPLIT LES PILES ICOLAC A
   5 : C      PARTIR  DU   TABLEAU ISORTA : TYPE-TYPE-POINTEUR  CREE PAR SAUV
   6 : C      LES OBJETS LOGIQUES SONT CHANGES PAR LA VALEUR VRAI OU FAUX
   7 : C
   8 : C ENTREE :ISORTA TABLEAU (TYPE-TYPE-POINTEUR)
   9 : C         ICOLAC POINTEUR SUR UN SEGMENT A CREER
  10 : C         INCTAB INCREMENT DANS LA TABLE
  11 : C  PROGRAMME PAR FARVACQUE - REPRIS PAR LENA
  12 : C  APPELE PAR SAUV
  13 : C  APPELLE : AJOUN  TYPFIL  ERREUR
  14 : C=======================================================================
  15 : C  TABLEAU KCOLA : VOIR SIGNIFATION DANS SOUS-PROGRAMME TYPFIL
  16 : C=======================================================================
  17 :       IMPLICIT INTEGER(I-N)
  18 :       IMPLICIT REAL*8(A-H,O-Z)
  19 : 
  20 : -INC CCOPTIO
  21 : -INC TMCOLAC
  22 : 
  23 : C=======================================================================
  24 : C ----DANS ISORTA LES VALEURS VONT TROIS PAR TROIS
  25 :       SEGMENT ISORTA
  26 :        CHARACTER*8 ISORTC(KS)
  27 :        INTEGER ISORTI(KS)
  28 :       ENDSEGMENT
  29 : C
  30 :       CHARACTER*(8) ITYPE
  31 : C
  32 :       SEGACT ISORTA
  33 :       NSORTA=ISORTI(/1)
  34 :       IF(NSORTA.EQ.0) GOTO 5000
  35 : C
  36 : C  **** BOUCLE SUR LES OBJETS A SORTIR : ON TESTE LEUR TYPE ET ON
  37 : C  **** INITIALISE LE REMPLISSAGE DES PILES ITLACC
  38 :       SEGACT ICOLAC
  39 :       ILISSE=ILISSG
  40 :       SEGACT ILISSE*MOD
  41 : C
  42 :       DO 200 ISORT=1,NSORTA
  43 : 
  44 :          ITYPE(1:8)=ISORTC(ISORT)
  45 : C
  46 :          N1=0
  46 :          CALL TYPFIL(ITYPE,N1)
  47 :          IF (N1.LT.0) THEN
  48 :             MOTERR(1:8)=ITYPE
  48 :             CALL ERREUR (336)
  49 :             GO TO 200
  50 :          ENDIF
  51 : 
  52 :          IVAL=ISORTI(ISORT)
  53 :          ICO=KCOLA(N1)
  54 :          NUMLIS=1 
  55 :          ITYP=N1 
  56 :          IF (ITYP.EQ.24) NUMLIS=6
  57 :          IF (ITYP.EQ.25) NUMLIS=4
  58 :          IF (ITYP.EQ.26) NUMLIS=2
  59 :          IF (ITYP.EQ.27) NUMLIS=5
  60 :          IF (ITYP.EQ.32) NUMLIS=3
  61 :          IF (ITYP.EQ.36) NUMLIS=7
  61 :          CALL AJOUN(ICO,IVAL,ILISSE,NUMLIS)
  62 : 
  63 :  200  CONTINUE
  64 : C
  65 : *      SEGDES ILISSE
  66 :       SEGDES ICOLAC
  67 : C
  68 :  5000 CONTINUE
  69 :       SEGDES ISORTA
  70 : 
  71 :       RETURN
  72 :       END
  73 : 
  74 :