Télécharger listyp.eso

Retour à la liste

Numérotation des lignes :

  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.  
  68.  

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