Esope source files

   1 : C TABLE     SOURCE    GOUNAND   07/09/14    21:15:01     5857           
   2 :       SUBROUTINE TABLE                                                  
   3 : ************************************************************************
   4 : *                                                                       
   5 : *                              T A B L E                                
   6 : *                              ---------                                
   7 : *                                                                       
   8 : *            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "TABLE"               
   9 : *                                                                       
  10 : * FONCTION:                                                             
  11 : * ---------                                                             
  12 : *                                                                       
  13 : *     DEFINIR UN OBJET DE TYPE 'TABLE'                                  
  14 : *     OU EN RENOMMER UN                                                 
  15 : * PHRASE D'APPEL (EN GIBIANE):                                          
  16 : * ----------------------------                                          
  17 : *                                                                       
  18 : *     A = TABLE ;      OU    B = TABLE A;                               
  19 : *                                                                       
  20 : * CREATION D'UNE TABLE DE SOUS-TYPE VECTEUR :                           
  21 : *     A = TABLE VECTEUR ;                                               
  22 : *                                                                       
  23 : * AUTEUR, DATE DE CREATION:                                             
  24 : * -------------------------                                             
  25 : *                                                                       
  26 : *     PASCAL MANIGOT     5 DECEMBRE 1984    PV 12 11 1986               
  27 : *                                                                       
  28 : * LANGAGE:                                                              
  29 : * --------                                                              
  30 : *                                                                       
  31 : *     FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS            
  32 : *                                                                       
  33 : ************************************************************************
  34 : *                                                                       
  35 : *
  36 :       IMPLICIT INTEGER(I-N)
  37 :       IMPLICIT REAL*8 (A-H,O-Z)
  38 : -INC CCNOYAU
  39 : -INC SMTABLE
  40 :       POINTEUR IPTABL.MTABLE
  41 :       CHARACTER*8 ICHA,TYPOBJ
  42 :       LOGICAL LOGI                                                      
  43 :       CHARACTER*72 SOUTYP                                               
  43 :       CALL LIROBJ('TABLE',IPTABL,0,IRETOU)                              
  44 :       IF (IRETOU.EQ.0) THEN                                             
  44 :          CALL CRTABL(IPTABL) 
  45 :          SEGDES IPTABL
  46 :       ELSE        
  46 :          CALL REFUS
  47 :          RETURN 
  48 :       ENDIF                                           
  49 : * lecture de la procedur sans la lire et initialisation des methodes
  50 : * generiques des objets tables
  50 :       CALL LIROBJ('PROCEDUR',IRET,0,IRETOU)
  51 :       IF( IRETOU.NE.0) THEN
  51 :       CALL QUENOM(ICHA)
  51 :       CALL REFUS
  51 :       CALL ECCTAB(IPTABL,'MOT     ',0,0.D0,'CLASSE',LOGI,IRET,
  52 :      $      'MOT     ',0, 0.D0, ICHA(1:8),LOGI,IRET)
  53 : * mettre ici les methodes génériques
  54 :       ICHA = 'METHODE'
  54 :       CALL ECCTAB(IPTABL,ICHA,0,0.D0,'METHODE',LOGI,IPO,
  55 :      $        'MOT',0,0.D0,'METHODE',LOGI,0)
  56 :       TYPOBJ='PROCEDUR'
  56 :       CALL POSCHA('HERITE',IPO)
  57 :       TYPOBJ='PROCEDUR'
  58 :       DO 1 J =LMNNOM,1,-1
  59 :       IF(IPO.NE.INOOB1(J)) GOTO 1
  60 :          IPLAMO = IOUEP2(J)
  61 :          GO TO  2
  62 :   1   CONTINUE
  62 :       CALL ERREUR(5)
  63 :   2   CONTINUE 
  63 :       CALL ECCTAB(IPTABL,ICHA,0,0.D0,'HERITE',LOGI,IPO,            
  64 :      $        'PROCEDUR',0,0.D0,ICHA,LOGI,IPLAMO) 
  64 :        CALL ECROBJ ('TABLE',IPTABL)        
  65 :        ELSE
  66 : * LECTURE DE L'EVENTUEL SOUS-TYPE                                       
  66 :          CALL LIRCHA(SOUTYP,0,IRET)                                     
  66 :        IF (IRET.NE.0) CALL ECCTAB(IPTABL,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,
  67 :      #                   0,'MOT',0,0.D0,SOUTYP(1:IRET),.TRUE.,0)        
  68 :        ENDIF                                                            
  68 :        CALL ECROBJ ('TABLE',IPTABL)                                     
  69 :       LECTAB=1                                                          
  70 : *                                                                       
  71 :       END              
  72 :  
  73 :