Télécharger ectabl.eso

Retour à la liste

Numérotation des lignes :

  1. C ECTABL SOURCE JC220346 18/12/04 21:15:16 9991
  2. SUBROUTINE ECTABL(ITAB)
  3. *----------------------------------------------------------------------
  4. * IMPRESSION D'UN OBJET DE TYPE TABLE
  5. *----------------------------------------------------------------------
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (a-h,o-z)
  8. EQUIVALENCE (IENT,REEL)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. -INC SMTABLE
  13. -INC CCNOYAU
  14. -INC CCASSIS
  15. CHARACTER*(8) ITYPE,ITYP
  16. CHARACTER*24 IWRI,IWRV
  17. REAL*8 XR,XRET
  18. LOGICAL BRET
  19.  
  20. c on recupere l'objet TABLE (lu par prlist si operateur LIST par ex)
  21. MTABLE=ABS(ITAB)
  22. INTERR(1) = MTABLE
  23. IF(ITAB.GE.0) THEN
  24. c -124 0 : TABLE de pointeur %i1
  25. CALL ERREUR(-124)
  26. ELSE
  27. c -321 0 : Objet de type OBJET de pointeur %i1
  28. CALL ERREUR(-321)
  29. ENDIF
  30.  
  31. c activation de la TABLE
  32. SEGACT MTABLE
  33. NB=MLOTAB
  34. IF(NB.EQ.0) GO TO 99
  35.  
  36. cbp : on lit eventuellement la profondeur a explorer :
  37. NMAX=1
  38. CALL LIRENT(IMAX,0,IRETOU)
  39. IF(IRETOU.NE.0) THEN
  40. NMAX=IMAX
  41. c Impression recursive
  42. CALL ECTAB1(MTABLE,NMAX)
  43. SEGDES MTABLE
  44. RETURN
  45. ENDIF
  46.  
  47. c -125 0 : Indice Objet
  48. c -125 0 : Type Value Type Value
  49. CALL ERREUR(-125)
  50. c 8 caracteres pour le type d'objet et 24 pour sa valeur
  51. 513 FORMAT(1X,A8,2X,A24,2X,A8,2X,A24)
  52. if(nbesc.ne.0) segact ipiloc
  53.  
  54. c---- boucle sur les indices -------------------------------------------
  55. DO 10 IJ=1,NB
  56.  
  57. c IJieme Indice
  58. ITYPE=MTABTI(IJ)
  59. IRET=MTABII(IJ)
  60. XRET=RMTABI(IJ)
  61. IWRI=' '
  62. IF(ITYPE.EQ.'MOT '.OR.ITYPE.EQ.'METHODE ') THEN
  63. ID=IPCHAR(IRET)
  64. IFI=IPCHAR(IRET+1)
  65. IL=IFI-ID
  66. IL=MIN(IL,24)
  67. IWRI(1:IL)=ICHARA(ID:ID+IL-1)
  68. ELSEIF(ITYPE.EQ.'ENTIER ') THEN
  69. IV=IRET
  70. WRITE(IWRI(1:8),FMT='(I8)') IV
  71. ELSEIF(ITYPE.EQ.'FLOTTANT') THEN
  72. XR=XRET
  73. WRITE(IWRI(1:15),FMT='(E15.8)') XR
  74. ELSEIF(ITYPE.EQ.'LOGIQUE')THEN
  75. BRET=IPLOGI(IRET)
  76. IF(BRET) IWRI(1:4)='VRAI'
  77. IF(.NOT.BRET) IWRI(1:4)='FAUX'
  78. ELSE
  79. WRITE(IWRI(1:8),FMT='(I8)') IRET
  80. ENDIF
  81.  
  82. c IJieme Valeur
  83. ITYP=MTABTV(IJ)
  84. IRET=MTABIV(IJ)
  85. XRET=RMTABV(IJ)
  86. IWRV=' '
  87. IF(ITYP.EQ.'MOT ') THEN
  88. ID=IPCHAR(IRET)
  89. IFI=IPCHAR(IRET+1)
  90. IL=IFI-ID
  91. IL=MIN(IL,24)
  92. IWRV(1:IL)=ICHARA(ID:ID+IL-1)
  93. ELSEIF(ITYP.EQ.'ENTIER ') THEN
  94. IV=IRET
  95. WRITE(IWRV(1:8),FMT='(I8)') IV
  96. ELSEIF(ITYP.EQ.'FLOTTANT')THEN
  97. XR=XRET
  98. WRITE(IWRV(1:15),FMT='(E15.8)') XR
  99. ELSEIF(ITYP.EQ.'LOGIQUE')THEN
  100. BRET=IPLOGI(IRET)
  101. IF(BRET) IWRV(1:4)='VRAI'
  102. IF(.NOT.BRET) IWRV(1:4)='FAUX'
  103. ELSE
  104. WRITE(IWRV(1:8),FMT='(I8)') IRET
  105. ENDIF
  106.  
  107. c on ecrit la IJieme ligne :
  108. c TYPE_Indice VALEUR_Indice TYPE_Valeur VALEUR_Valeur
  109. WRITE(IOIMP,513) ITYPE,IWRI,ITYP,IWRV
  110.  
  111. 10 CONTINUE
  112. c---- fin de boucle sur les indices ------------------------------------
  113.  
  114. if(nbesc.ne.0) SEGDES,IPILOC
  115. 99 SEGDES MTABLE
  116. RETURN
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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