Esope source files

   1 : C ECTABL    SOURCE    PV        11/03/07    21:16:39     6885           
   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 :       MTABLE=ABS(ITAB)                                                   
  18 :       SEGACT MTABLE                                                      
  19 :       NB=MLOTAB                                                          
  20 :       INTERR(1) = MTABLE                                                 
  21 :       IF(ITAB.GE.0) THEN
  21 :          CALL ERREUR(-124) 
  22 :       ELSE 
  22 :          CALL ERREUR(-321) 
  23 :       ENDIF                                                        
  24 :       IF(NB.EQ.0) GO TO 99                                               
  24 :       CALL ERREUR(-125)                                                  
  25 :   513 FORMAT(1X,A8,2X,A20,2X,A8,2X,A20) 
  26 :       if(nbesc.ne.0) segact ipiloc                                       
  27 :       DO 10 IJ=1,NB                                                      
  28 :       ITYPE=MTABTI(IJ)                                                   
  29 :       IRET=MTABII(IJ)                                                    
  30 :       XRET=RMTABI(IJ)                                                    
  31 :       IWRI=' '                                                           
  32 :       IF(ITYPE.EQ.'MOT     '.OR.ITYPE.EQ.'METHODE ') THEN                
  33 :       ID=IPCHAR(IRET)                                           
  34 :       IFI=IPCHAR(IRET+1)                                                 
  35 :       IL=IFI-ID                                                          
  36 :       IL=MIN(IL,20)                                                      
  37 :       IWRI(1:IL)=ICHARA(ID:ID+IL-1)                                      
  38 :       ELSEIF(ITYPE.EQ.'ENTIER  ') THEN                                   
  39 :       IV=IRET                                                            
  40 :       WRITE(IWRI(1:8),FMT='(I8)') IV                                     
  41 :       ELSEIF(ITYPE.EQ.'FLOTTANT') THEN                                   
  42 :       XR=XRET                                                            
  43 :       WRITE(IWRI(1:15),FMT='(E15.8)') XR                                 
  44 :       ELSEIF(ITYPE.EQ.'LOGIQUE')THEN                                     
  45 :            BRET=IPLOGI(IRET)                                             
  46 :            IF(BRET) IWRI(1:4)='VRAI'                                     
  47 :            IF(.NOT.BRET) IWRI(1:4)='FAUX'                                
  48 :       ELSE                                                               
  49 :       WRITE(IWRI(1:8),FMT='(I8)') IRET                                   
  50 :       ENDIF                                                              
  51 :       ITYP=MTABTV(IJ)                                                    
  52 :       IRET=MTABIV(IJ)                                                    
  53 :       XRET=RMTABV(IJ)                                                    
  54 :       IWRV=' '                                                           
  55 :       IF(ITYP.EQ.'MOT     ') THEN                                        
  56 :       ID=IPCHAR(IRET)                                           
  57 :       IFI=IPCHAR(IRET+1)                                                 
  58 :       IL=IFI-ID                                                          
  59 :       IL=MIN(IL,20)                                                      
  60 :       IWRV(1:IL)=ICHARA(ID:ID+IL-1)                                      
  61 :       ELSEIF(ITYP.EQ.'ENTIER  ') THEN                                    
  62 :       IV=IRET                                                            
  63 :       WRITE(IWRV(1:8),FMT='(I8)') IV                                     
  64 :       ELSEIF(ITYP.EQ.'FLOTTANT')THEN                                     
  65 :       XR=XRET                                                            
  66 :       WRITE(IWRV(1:15),FMT='(E15.8)') XR                                 
  67 :       ELSEIF(ITYP.EQ.'LOGIQUE')THEN                                      
  68 :            BRET=IPLOGI(IRET)                                             
  69 :            IF(BRET) IWRV(1:4)='VRAI'                                     
  70 :            IF(.NOT.BRET) IWRV(1:4)='FAUX'                                
  71 :       ELSE                                                               
  72 :       WRITE(IWRV(1:8),FMT='(I8)') IRET                                   
  73 :       ENDIF                                                              
  74 :       WRITE(IOIMP,513) ITYPE,IWRI,ITYP,IWRV                              
  75 :   10  CONTINUE  
  76 :       if(nbesc.ne.0) segdes ipiloc                                       
  77 :   99  SEGDES MTABLE                                                      
  78 :       RETURN                                                             
  79 :       END      
  80 :  
  81 :