Télécharger la plaquette Cast3M


fr en

Télécharger enumer.eso

Retour à la liste

Numérotation des lignes : 

enumer

  1. C ENUMER    SOURCE    SP204843  26/02/03    21:15:18     12461          
  2.       SUBROUTINE ENUMER
  3. *---------------------------------------------------------------------
  4. *
  5. *              OPERATEUR ENUMERER
  6. *
  7. *     SYNTAXE : voir notice ENUM
  8. *
  9. *--------------------------------------------------------------------
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13.       PARAMETER   (NCLE = 3)
  14.       CHARACTER*8 CTYP
  15.       CHARACTER*4 MOCLE(NCLE)
  16.       LOGICAL     LOGI1
  17.  
  18. C     TYPES EXCLUS DE LA LISTE
  19.  
  20.       DATA MOCLE  /'TABL','*   ','COMP'/
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. -INC SMLOBJE
  25.  
  26. C---------------------------------
  27. C     Option TABLE, '*', COMP
  28. C---------------------------------
  29.       ICLE = 0
  30.       CALL LIRMOT(MOCLE,NCLE,ICLE,0)
  31. C     write(6,*) 'ICLE=',ICLE
  32.       IF (ICLE.EQ.1) THEN
  33.         CALL ENUTAB
  34.         RETURN
  35.       ELSE IF (ICLE.EQ.2) THEN
  36.         CALL ENUFOI
  37.         RETURN
  38.       ELSE IF (ICLE.EQ.3) THEN
  39.         CALL ENUCOM
  40.         RETURN
  41.       ENDIF
  42.  
  43.  
  44. C---------------------------------
  45. C     INITIALISATION RESULTAT
  46. C---------------------------------
  47.       CALL QUETYP(CTYP,0,IRETOU)
  48.       IF (IERR.NE.0) RETURN
  49.  
  50.       CALL PLAMO8(LTYPOB,NTYPOB,IPLA,CTYP)
  51.       IF (IPLA.EQ.0) THEN
  52.         CALL ERREUR(1138)
  53.         RETURN
  54.       ENDIF
  55.  
  56. *     ENTIERS ou OBJETS (POINTEUR)
  57.       LOGI1 = (IPLA.EQ.2).OR.(IPLA.GE.4)
  58.  
  59.       NOBJ = 0
  60.       NREE = 0
  61.       IF (LOGI1)     NOBJ = 10000
  62.       IF (IPLA.EQ.3) NREE = 10000
  63.       SEGINI,MLOBJE
  64.       NOBLU = 0
  65.       IF (IRETOU.EQ.0) GOTO 999
  66.       TYPOBJ(1:8) = CTYP
  67.       NELT = MAX(NOBJ,NREE) 
  68.  
  69.  
  70. C---------------------------------
  71. C     BOUCLE DE LECTURE DES OBJETS
  72. C---------------------------------
  73.  
  74. 1     CONTINUE
  75.  
  76.  
  77. C---- LECTURE D'UN OBJET ET AJOUT A LA LISTE
  78.       IF (IPLA.EQ.2) CALL LIRENT(IOBJ,1,IRET)
  79.       IF (IPLA.EQ.3) CALL LIRREE(XFLO,1,IRET)
  80.       IF (IPLA.GE.4) CALL LIROBJ(CTYP,IOBJ,1,IRET)
  81.       IF (IERR.NE.0) RETURN
  82.  
  83.       NOBLU = NOBLU + 1
  84.       IF (NOBLU.GT.NELT) THEN
  85.         IF (LOGI1)     NOBJ = NOBJ + 10000
  86.         IF (IPLA.EQ.3) NREE = NREE + 10000
  87.         SEGADJ, MLOBJE
  88.       ENDIF
  89.       IF (LOGI1)     LISOBJ(NOBLU) = IOBJ
  90.       IF (IPLA.EQ.3) RLIREE(NOBLU) = XFLO
  91.  
  92.  
  93. C---- LECTURE ARGUMENT SUIVANT
  94.       CALL QUETYP(CTYP,0,IRETOU)
  95.       IF (IRETOU.EQ.0) THEN
  96.          GOTO 999
  97.       ENDIF
  98.  
  99.  
  100. C---- VERIFICATION DU TYPE DE L'OBJET
  101. C     MEME TYPE QUE 1ER ?
  102.       IF (CTYP.NE.TYPOBJ) THEN
  103.         MOTERR(1:8) = CTYP
  104.         CALL ERREUR(39)
  105.         RETURN
  106.       ENDIF
  107.  
  108.  
  109. C---------------------------------
  110. C     FIN DE BOUCLE
  111. C---------------------------------
  112.       GOTO 1
  113.  
  114.  
  115. C---------------------------------
  116. C     SORTIE
  117. C---------------------------------
  118. 999   CONTINUE
  119.       IF (LOGI1)     NOBJ = NOBLU
  120.       IF (IPLA.EQ.3) NREE = NOBLU
  121.       SEGADJ, MLOBJE
  122.       SEGACT, MLOBJE*NOMOD
  123.       CALL ECROBJ('LISTOBJE',MLOBJE)
  124.  
  125.       RETURN
  126.       END
  127.  
  128.  
  129.  
  130.  

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