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    PV090527  24/01/09    21:15:07     11817          
  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 = 2)
  14.       CHARACTER*8 CTYP
  15.       CHARACTER*4 MOCLE(NCLE)
  16.  
  17. C     TYPES EXCLUS DE LA LISTE
  18.  
  19.       DATA MOCLE  /'TABL','*   '/
  20.  
  21. -INC PPARAM
  22. -INC CCOPTIO
  23. -INC SMLOBJE
  24.  
  25. C---------------------------------
  26. C     Option TABLE ET '*'
  27. C---------------------------------
  28.       ICLE = 0
  29.       CALL LIRMOT(MOCLE,NCLE,ICLE,0)
  30. C     write(6,*) 'ICLE=',ICLE
  31.       IF (ICLE.EQ.1) THEN
  32.         CALL ENUTAB
  33.         RETURN
  34.       ELSE IF (ICLE.EQ.2) THEN
  35.         CALL ENUFOI
  36.         RETURN
  37.       ENDIF
  38.  
  39. C---------------------------------
  40. C     INITIALISATION RESULTAT
  41. C---------------------------------
  42.       NOBJ = 10000
  43.       SEGINI,MLOBJE
  44.       NOBLU = 0
  45.  
  46.  
  47. C---------------------------------
  48. C     BOUCLE DE LECTURE DES OBJETS
  49. C---------------------------------
  50. 1     CONTINUE
  51.  
  52.  
  53. C---- LECTURE DES ARGUMENTS
  54.       CALL QUETYP(CTYP,0,IRETOU)
  55.       IF (IRETOU.EQ.0) THEN
  56.          GOTO 999
  57.       ENDIF
  58.  
  59.  
  60. C---- VERIFICATION DU TYPE DE L'OBJET
  61.       IF (NOBLU.EQ.0) THEN
  62. C       TYPE ACCEPTE ?
  63. **      CALL PLACE(LTYPOB,NTYPOB,IPLAC,CTYP)
  64. C       write(6,*) 'IPLAC=',IPLAC
  65. **      IF (IPLAC.EQ.0) THEN
  66. **        MOTERR(1:8) = CTYP
  67. **        CALL ERREUR(39)
  68. **        RETURN
  69. **      ENDIF
  70.         TYPOBJ(1:8) = CTYP
  71.       ELSE
  72. C       MEME TYPE QUE 1ER ?
  73.         IF (CTYP.NE.TYPOBJ) THEN
  74.           MOTERR(1:8) = CTYP
  75.           CALL ERREUR(39)
  76.         ENDIF
  77.       ENDIF
  78.  
  79.  
  80. C---- LECTURE DE L'OBJET ET AJOUT A LA LISTE
  81.       CALL LIROBJ(TYPOBJ(1:8),IOBJ,1,IRET)
  82.       IF (IERR.NE.0) RETURN
  83.       NOBLU = NOBLU + 1
  84.       IF (NOBLU.GT.NOBJ) THEN
  85.         NOBJ = NOBJ + 10000
  86.         SEGADJ, MLOBJE
  87.       ENDIF
  88.       LISOBJ(NOBLU) = IOBJ
  89.  
  90.  
  91. C---------------------------------
  92. C     FIN DE BOUCLE
  93. C---------------------------------
  94.       GOTO 1
  95.  
  96.  
  97. C---------------------------------
  98. C     SORTIE
  99. C---------------------------------
  100. 999   CONTINUE
  101.       NOBJ = NOBLU
  102.       SEGADJ, MLOBJE
  103.       CALL ECROBJ('LISTOBJE',MLOBJE)
  104.  
  105.       RETURN
  106.       END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  

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