Télécharger la plaquette Cast3M


fr en

Télécharger listyp.eso

Retour à la liste

Numérotation des lignes : 

listyp

  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.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. C
  17.       M=0
  18.       SEGINI MLCHA8
  19.  
  20. C---- LMNOM est defini dans le COMMON CNOYAU
  21. C     et contient ??? (nombre total d'objets)
  22.       I1=LMNNOM
  23.       DO 1 I = 1,I1
  24.          IF(INOOB2(I).EQ.'        ') GO TO 1
  25.          IF(INOOB2(I).EQ.'ANNULE  ') GO TO 1
  26.  
  27. C------- Si on a trouve qqch different de '        ' ou de 'ANNULE  '
  28. C        On aggrandit le MLCHA8, on y met le type qu'on a trouve
  29. C (c.a.d. INOOB2(I)),
  30. C        puis on sort de la boucle
  31.          M=1
  32.          SEGADJ MLCHA8
  33.          MLCHAR(1)=INOOB2(I)
  34.          GO TO 2
  35.     1 CONTINUE
  36.  
  37. C---- S'il n'y avait que des '        ' et des 'ANNULE  '
  38. C     on renvoie le MLCHA8 (de longueur nulle et non-desactive ?) et on
  39. C     s'en va
  40.       ITOTO=MLCHA8
  41.       RETURN
  42.  
  43. C---- Dans cette boucle on met dans MLCHA8 tous ce que contient INOOB2
  44. C     (en 1 exemplaire) sauf les 'ANNULE  ', par contre les '        '
  45. C     peuvent etre dedans - est-ce correct ?
  46.    2  CONTINUE
  47.       DO 10 I=1,I1
  48.  
  49.          DO 4 J=1,M
  50.             IF(INOOB2(I).EQ.MLCHAR(J)) GO TO 10
  51.     4    CONTINUE
  52.  
  53.          IF(INOOB2(I).EQ.'ANNULE  ') GO TO 10
  54.  
  55. C------- Ici on augmente la taille du MLCHA8 et on y met la trouvaille
  56.          M=M+1
  57.          SEGADJ MLCHA8
  58.          MLCHAR(M)=INOOB2(I)
  59.  
  60.    10 CONTINUE
  61.  
  62. C---- A la fin on desactive le MLCHA8, on le passe comme resultat,
  63. C     puis on s'en va
  64.       SEGDES MLCHA8
  65.       ITOTO=MLCHA8
  66.  
  67.       RETURN
  68.       END
  69.  
  70.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales