Télécharger ectabl.eso

Retour à la liste

Numérotation des lignes :

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

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