Sources Esope | Cast3M

ectabl
C ECTABL    SOURCE    JC220346  18/12/04    21:15:16     9991           
      SUBROUTINE ECTABL(ITAB)
*----------------------------------------------------------------------
*             IMPRESSION D'UN OBJET DE TYPE TABLE
*----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (a-h,o-z)
      EQUIVALENCE (IENT,REEL)
 
-INC PPARAM
-INC CCOPTIO
-INC SMTABLE
-INC CCNOYAU
-INC CCASSIS
      CHARACTER*(8) ITYPE,ITYP
      CHARACTER*24 IWRI,IWRV
      REAL*8 XR,XRET
      LOGICAL BRET
 
c     on recupere l'objet TABLE (lu par prlist si operateur LIST par ex)
      MTABLE=ABS(ITAB)
      INTERR(1) = MTABLE
      IF(ITAB.GE.0) THEN
c -124 0 :  TABLE de pointeur %i1
         CALL ERREUR(-124)
      ELSE
c -321 0 :  Objet de type OBJET de pointeur %i1
         CALL ERREUR(-321)
      ENDIF
 
c     activation de la TABLE
      SEGACT MTABLE
      NB=MLOTAB
      IF(NB.EQ.0) GO TO 99
 
cbp : on lit eventuellement la profondeur a explorer :
      NMAX=1
      CALL LIRENT(IMAX,0,IRETOU)
      IF(IRETOU.NE.0) THEN
        NMAX=IMAX 
c       Impression recursive
        CALL ECTAB1(MTABLE,NMAX)
        SEGDES MTABLE
        RETURN
      ENDIF
 
c -125 0 :         Indice                          Objet
c -125 0 :     Type    Value                  Type   Value  
      CALL ERREUR(-125)
c     8 caracteres pour le type d'objet et 24 pour sa valeur      
  513 FORMAT(1X,A8,2X,A24,2X,A8,2X,A24)
      if(nbesc.ne.0) segact ipiloc
 
c---- boucle sur les indices -------------------------------------------
      DO 10 IJ=1,NB
 
c     IJieme  Indice 
      ITYPE=MTABTI(IJ)
      IRET=MTABII(IJ)
      XRET=RMTABI(IJ)
      IWRI=' '
      IF(ITYPE.EQ.'MOT     '.OR.ITYPE.EQ.'METHODE ') THEN
        ID=IPCHAR(IRET)
        IFI=IPCHAR(IRET+1)
        IL=IFI-ID
        IL=MIN(IL,24)
        IWRI(1:IL)=ICHARA(ID:ID+IL-1)
      ELSEIF(ITYPE.EQ.'ENTIER  ') THEN
        IV=IRET
        WRITE(IWRI(1:8),FMT='(I8)') IV
      ELSEIF(ITYPE.EQ.'FLOTTANT') THEN
        XR=XRET
        WRITE(IWRI(1:15),FMT='(E15.8)') XR
      ELSEIF(ITYPE.EQ.'LOGIQUE')THEN
        BRET=IPLOGI(IRET)
        IF(BRET) IWRI(1:4)='VRAI'
        IF(.NOT.BRET) IWRI(1:4)='FAUX'
      ELSE
        WRITE(IWRI(1:8),FMT='(I8)') IRET
      ENDIF
 
c     IJieme Valeur
      ITYP=MTABTV(IJ)
      IRET=MTABIV(IJ)
      XRET=RMTABV(IJ)
      IWRV=' '
      IF(ITYP.EQ.'MOT     ') THEN
        ID=IPCHAR(IRET)
        IFI=IPCHAR(IRET+1)
        IL=IFI-ID
        IL=MIN(IL,24)
        IWRV(1:IL)=ICHARA(ID:ID+IL-1)
      ELSEIF(ITYP.EQ.'ENTIER  ') THEN
        IV=IRET
        WRITE(IWRV(1:8),FMT='(I8)') IV
      ELSEIF(ITYP.EQ.'FLOTTANT')THEN
        XR=XRET
        WRITE(IWRV(1:15),FMT='(E15.8)') XR
      ELSEIF(ITYP.EQ.'LOGIQUE')THEN
        BRET=IPLOGI(IRET)
        IF(BRET) IWRV(1:4)='VRAI'
        IF(.NOT.BRET) IWRV(1:4)='FAUX'
      ELSE
        WRITE(IWRV(1:8),FMT='(I8)') IRET
      ENDIF
 
c     on ecrit la IJieme ligne : 
c     TYPE_Indice  VALEUR_Indice   TYPE_Valeur  VALEUR_Valeur
      WRITE(IOIMP,513) ITYPE,IWRI,ITYP,IWRV
 
  10  CONTINUE
c---- fin de boucle sur les indices ------------------------------------
 
      if(nbesc.ne.0) SEGDES,IPILOC
  99  SEGDES MTABLE
      RETURN
      END