Esope source files

   1 : C LISTYP    SOURCE    CHAT      06/03/16    21:20:37     5336           
   2 :       SUBROUTINE LISTYP(ITOTO)
   3 : C---------------------------------------------------------------------
   4 : C    RECUPERE  A PARTIR DE LA TABLE DES OBJETS TOUS LES TYPES
   5 : C    SORTIE: ITOTO= POINTEUR SUR LE SEGMENT DES TYPES POSSIBLES
   6 : C   APPELLE    :
   7 : C   APPELE PAR : PILOBJ  SAUV
   8 : C---------------------------------------------------------------------
   9 :       IMPLICIT INTEGER(I-N)
  10 :       SEGMENT MTY(0)
  11 : -INC CCNOYAU
  12 : -INC TMLCHA8
  13 : -INC CCOPTIO
  14 : C
  15 :       M=0
  16 :       SEGINI MLCHA8
  17 : 
  18 : C---- LMNOM est defini dans le COMMON CNOYAU
  19 : C     et contient ??? (nombre total d'objets)
  20 :       I1=LMNNOM
  21 :       DO 1 I = 1,I1
  22 :          IF(INOOB2(I).EQ.'        ') GO TO 1
  23 :          IF(INOOB2(I).EQ.'ANNULE  ') GO TO 1
  24 : 
  25 : C------- Si on a trouve qqch different de '        ' ou de 'ANNULE  '
  26 : C        On aggrandit le MLCHA8, on y met le type qu'on a trouve 
  27 : C (c.a.d. INOOB2(I)),
  28 : C        puis on sort de la boucle
  29 :          M=1
  30 :          SEGADJ MLCHA8
  31 :          MLCHAR(1)=INOOB2(I)
  32 :          GO TO 2
  33 :     1 CONTINUE
  34 : 
  35 : C---- S'il n'y avait que des '        ' et des 'ANNULE  '
  36 : C     on renvoie le MLCHA8 (de longueur nulle et non-desactive ?) et on 
  37 : C     s'en va
  38 :       ITOTO=MLCHA8
  39 :       RETURN
  40 : 
  41 : C---- Dans cette boucle on met dans MLCHA8 tous ce que contient INOOB2
  42 : C     (en 1 exemplaire) sauf les 'ANNULE  ', par contre les '        '
  43 : C     peuvent etre dedans - est-ce correct ?
  44 :    2  CONTINUE
  45 :       DO 10 I=1,I1
  46 : 
  47 :          DO 4 J=1,M
  48 :             IF(INOOB2(I).EQ.MLCHAR(J)) GO TO 10
  49 :     4    CONTINUE
  50 : 
  51 :          IF(INOOB2(I).EQ.'ANNULE  ') GO TO 10
  52 : 
  53 : C------- Ici on augmente la taille du MLCHA8 et on y met la trouvaille
  54 :          M=M+1
  55 :          SEGADJ MLCHA8
  56 :          MLCHAR(M)=INOOB2(I)
  57 : 
  58 :    10 CONTINUE
  59 : 
  60 : C---- A la fin on desactive le MLCHA8, on le passe comme resultat,
  61 : C     puis on s'en va
  62 :       SEGDES MLCHA8
  63 :       ITOTO=MLCHA8
  64 : 
  65 :       RETURN
  66 :       END
  67 :