Télécharger enutab.eso

Retour à la liste

Numérotation des lignes :

enutab
  1. C ENUTAB SOURCE SP204843 23/02/16 21:15:04 11598
  2. SUBROUTINE ENUTAB
  3. *---------------------------------------------------------------------
  4. *
  5. * OPTION TABLE 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 (NMOCLE = 1)
  14. CHARACTER*8 CTYP
  15. LOGICAL LCROI,LABSO
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMLOBJE
  20. -INC SMTABLE
  21. -INC SMLENTI
  22.  
  23. C---------------------------------
  24. C LECTURE DE LA TABLE
  25. C---------------------------------
  26. CALL LIROBJ('TABLE ',ITAB1,1,IRET)
  27. IF (IERR.NE.0) RETURN
  28.  
  29. c write(6,*) 'ITAB1=',ITAB1
  30.  
  31. C---------------------------------
  32. C LISTE INDICES ENTIERS DE LA TABLE
  33. C---------------------------------
  34. MTABLE = ITAB1
  35. SEGACT, MTABLE
  36. JG = MLOTAB
  37. SEGINI, MLENTI, MLENT1
  38. DO 10 I1=1,MLOTAB
  39. IF (MTABTI(I1).EQ.'ENTIER ') THEN
  40. LECT(I1) = MTABII(I1)
  41. CTYP = MTABTV(I1)
  42. ENDIF
  43. 10 CONTINUE
  44.  
  45. c write(6,*) 'MLENTI,MLENT1,CTYP=',MLENTI,MLENT1,CTYP
  46.  
  47. C---------------------------------
  48. C VERIFICATION LISTE INDICES ENTIER
  49. C EST CORRECTEMENT ORONNEE
  50. C---------------------------------
  51. LCROI = .true.
  52. LABSO = .false.
  53. CALL ORDON2(MLENTI,LCROI,LABSO,MLENT1)
  54. IF (IERR.NE.0) RETURN
  55. SEGACT,MLENT1
  56.  
  57. c write(6,*) 'MLENT1.lect(/1)=',MLENT1.LECT(/1)
  58.  
  59. IPLAC = 0
  60. CALL PLACE(LTYPOB,NTYPOB,IPLAC,CTYP)
  61.  
  62. C-------------------------- CAS DU LISTOBJE ---------------------------C
  63.  
  64. IF (IPLAC.NE.0) THEN
  65.  
  66. NOBJ = MLOTAB
  67. SEGINI,MLOBJE
  68. TYPOBJ(1:8) = CTYP
  69.  
  70.  
  71. C BOUCLE DE LECTURE DES OBJETS
  72. NOBLU = 0
  73. DO 1 IND1=1,MLOTAB
  74.  
  75. C IND2 : indice de la table apres ORDON2
  76. IND2 = MLENT1.LECT(IND1)
  77.  
  78. C TYPE DE L'INDICE : PAS ENTIER => ON ITERE
  79. c write(6,*) 'IND2,(MTABTI(IND2)=',IND2,MTABTI(IND2)
  80. IF (MTABTI(IND2)(1:8).NE.'ENTIER ') GOTO 1
  81.  
  82. C VERIFICATION DU TYPE de L'OBJET CONTENU EN INDICE
  83. CTYP = MTABTV(IND2)
  84. c write(6,*) 'CTYP=',CTYP
  85. IF (CTYP.NE.TYPOBJ) THEN
  86. MOTERR(1:8) = CTYP
  87. CALL ERREUR(39)
  88. RETURN
  89. ENDIF
  90.  
  91. C AJOUT A LA LISTE
  92. NOBLU = NOBLU + 1
  93. LISOBJ(NOBLU) = MTABIV(IND2)
  94.  
  95. 1 CONTINUE
  96.  
  97. C Ecriture du resultat
  98. NOBJ = NOBLU
  99. SEGADJ, MLOBJE
  100. CALL ECROBJ('LISTOBJE',MLOBJE)
  101.  
  102. ENDIF
  103.  
  104. RETURN
  105. END
  106.  
  107.  
  108.  
  109.  

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