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    OF166741  24/12/18    21:15:24     12090          
  2.  
  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.       SUBROUTINE LISTYP(ITOTO)
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC CCNOYAU
  16.  
  17. -INC TMLCHA8
  18.  
  19.       SEGMENT MTY(0)
  20.  
  21.       M = 100
  22.       SEGINI,MLCHA8
  23.  
  24.       ML8 = 0
  25.  
  26. C---- LMNOM est defini dans le COMMON CNOYAU
  27. C     et contient ??? (nombre total d'objets)
  28.       IDEB = 0
  29.       IFIN = LMNNOM
  30.  
  31.       DO I = 1, IFIN
  32.          IF (INOOB2(I).EQ.'        ') GOTO 1
  33.          IF (INOOB2(I).EQ.'ANNULE  ') GOTO 1
  34.  
  35. C------- Si on a trouve qqch different de '        ' ou de 'ANNULE  '
  36. C        On met dans MLCHA8 le type qu'on a trouve (c.a.d. INOOB2(I)).
  37.          ML8 = ML8 + 1
  38.          MLCHAR(ML8) = INOOB2(I)
  39.          IDEB = I + 1
  40.          GO TO 2
  41.  
  42.  1       CONTINUE
  43.       ENDDO
  44.  
  45. C---- S'il n'y avait que des '        ' et des 'ANNULE  '
  46.       GOTO 900
  47.  
  48.  2    CONTINUE
  49. C---- Dans cette boucle on met dans MLCHA8 tout ce que contient INOOB2
  50. C     (en 1 exemplaire) sauf les 'ANNULE  ', par contre les '        '
  51. C     peuvent etre dedans - est-ce correct ?
  52.       DO I = IDEB, IFIN
  53.  
  54.         IF (INOOB2(I).EQ.'ANNULE  ') GOTO 10
  55.         DO J = 1, ML8
  56.           IF (INOOB2(I).EQ.MLCHAR(J)) GOTO 10
  57.         ENDDO
  58.  
  59. C---- On augmente la taille du MLCHA8 si besoin et on y met la trouvaille
  60.         ML8 = ML8 + 1
  61.         IF (ML8.GT.M) THEN
  62.           M = M + 100
  63.           SEGADJ,MLCHA8
  64.         ENDIF
  65.         MLCHAR(ML8) = INOOB2(I)
  66.  
  67.  10     CONTINUE
  68.       ENDDO
  69.  
  70. C---- Ajustement final du segment MLCHA8
  71.  900  CONTINUE
  72.       IF (ML8.NE.M) THEN
  73.         M = ML8
  74.         SEGADJ,MLCHA8
  75.       ENDIF
  76. C---- On desactive le MLCHA8, on le passe comme resultat, puis fin
  77.       SEGDES,MLCHA8
  78.       ITOTO = MLCHA8
  79.  
  80.       RETURN
  81.       END
  82.  
  83.  
  84.  

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