Télécharger indeta.eso

Retour à la liste

Numérotation des lignes :

  1. C INDETA SOURCE JC220346 18/12/04 21:15:29 9991
  2. SUBROUTINE INDETA
  3. C-----------------------------------------------------------------------
  4. C FABRIQUE L'INDEX D'UNE TABLE DANS UNE TABLE |
  5. C RECUPERE TOUS LES OBJETS NOMMES D'UN TYPE DANS UNE TABLE |
  6. C-----------------------------------------------------------------------
  7.  
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10.  
  11. -INC CCNOYAU
  12. -INC SMTABLE
  13. -INC CCOPTIO
  14. -INC TMLNOMS
  15.  
  16. LOGICAL LOGI,LVAL
  17. REAL*8 XVA
  18. CHARACTER*(1) CHARI
  19. CHARACTER*512 IMO
  20. CHARACTER*(LONOM) CNOM
  21. CHARACTER*8 CTYP,CTYP2,CVAL
  22.  
  23.  
  24. PARAMETER (NMO=36)
  25. CHARACTER*(8) LISMO(NMO)
  26. DATA LISMO / 'MOT ','ENTIER ','FLOTTANT','LOGIQUE ',
  27. $ 'MAILLAGE','LISTENTI','POINT ','LISTREEL',
  28. $ 'CHPOINT ','RIGIDITE','TEXTE ','STRUCTUR',
  29. $ 'ATTACHE ','SOLUTION','BASEMODA','--------',
  30. $ '--------','VECTDOUB','LISTMOTS','DEFORME ',
  31. $ 'LISTCHPO','CHARGEME','EVOLUTIO','--------',
  32. $ 'VECTEUR ','TABLE ','PROCEDUR','ELEMSTRU',
  33. $ 'BLOQSTRU','MCHAML ','MMODEL ','ANNULE ',
  34. $ 'NUAGE ','MATRIK ','OBJET ','ESCLAVE ' /
  35.  
  36.  
  37. C Syntaxe qui fait l'index d'un type d'OBJET Cast3M (Indexation par leurs noms dans la pile des objets nommes)
  38. CALL LIRCHA(IMO,0,IRETOU)
  39. IF(IERR.NE.0) RETURN
  40. IF ((IRETOU .EQ. 0) .OR. (IMO(1:1).NE.'*')) GOTO 100
  41.  
  42. CTYP = IMO(2:9)
  43.  
  44. IF (CTYP .EQ. ' ') THEN
  45. C Lecture OBLIGATOIRE d'un autre MOT
  46. CALL LIRCHA(CTYP,1,IRETOU)
  47. ENDIF
  48.  
  49. C Creation de la TABLE de resultats
  50. M=0
  51. SEGINI,MTABLE
  52.  
  53. C Recuperation de la liste des noms des objets de ce type
  54. CALL REPLIS(CTYP,MLNOMS)
  55.  
  56. IF (LINOMS(/2) .EQ. 0) THEN
  57. C Cas où la liste est vide
  58. MOTERR(1:8)=CTYP
  59. CALL ERREUR(-14)
  60. ELSE
  61. C Cas où la liste n'est pas vide
  62. DO I=1,LINOMS(/2)
  63. C Recherche du numero de pointeur associe au nom
  64. CTYP2=' '
  65. CNOM=LINOMS(I)
  66. IVAL=0
  67. RVAL=0.D0
  68. CVAL=' '
  69. LVAL=.FALSE.
  70. IOBJ=0
  71. CALL CQUOI(CNOM,CTYP2,IVAL,RVAL,CVAL,LVAL,IOBJ)
  72.  
  73. C Ecriture dans la table du TYPE CTYP
  74. CALL ECCTAB(MTABLE,'MOT ',0,0.d0,CNOM,.FALSE.,0,
  75. & CTYP,IVAL,RVAL,CVAL,LVAL,IOBJ)
  76. ENDDO
  77. ENDIF
  78.  
  79. SEGSUP MLNOMS
  80. C Ecriture de l'objet TABLE resultat
  81. 20 CONTINUE
  82. CALL ECROBJ('TABLE ',MTABLE)
  83. RETURN
  84.  
  85.  
  86. 100 CONTINUE
  87. C Syntaxe qui fait l'index d'une table (Indexation par des entiers)
  88. CALL LIROBJ('TABLE ',ITAB,1,IRETOU)
  89. IF(IERR.NE.0) RETURN
  90.  
  91. MTABLE=ITAB
  92. SEGACT MTABLE
  93. NB=MLOTAB
  94. IF(NB.EQ.0) GOTO 99
  95. M=NB
  96. SEGINI MTAB1
  97. MTAB1.MLOTAB=M
  98.  
  99. DO 10 IJ=1,NB
  100. CALL QUERAN(IRET,'ENTIER ',IJ,XVA,CHARI,LOGI,IOB)
  101. MTAB1.MTABTI(IJ)='ENTIER '
  102. MTAB1.MTABII(IJ)=IRET
  103. MTAB1.MTABTV(IJ)=MTABTI(IJ)
  104. IF (MTABTI(IJ).EQ.'FLOTTANT') THEN
  105. MTAB1.RMTABV(IJ)=RMTABI(IJ)
  106. ELSE
  107. MTAB1.MTABIV(IJ)=MTABII(IJ)
  108. ENDIF
  109. 10 CONTINUE
  110.  
  111. SEGDES MTAB1,MTABLE
  112. CALL ECROBJ('TABLE ',MTAB1)
  113. RETURN
  114.  
  115. 99 CONTINUE
  116. CALL CRTABL(ita1)
  117. CALL ECROBJ('TABLE ',ita1)
  118. RETURN
  119.  
  120. END
  121.  
  122.  
  123.  
  124.  

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