Esope source files

   1 : C LIRTAB    SOURCE    CHAT      09/06/17    21:15:05     6428           
   2 :       SUBROUTINE LIRTAB(ITYP,IRETA,ICODE,IRETOU)                                 
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC CCOPTIO                                                                    
   5 : -INC CCNOYAU                                                                    
   6 :       CHARACTER*(*)ITYP                                                         
   7 :       CHARACTER*8 TYPE,TAPIND,TYPOBJ,CHARIN                                     
   8 :       CHARACTER*72 CHARRE                                                       
   9 :       CHARACTER*8 LETYPE                                                        
  10 :       REAL*8 XVALIN,XVALRE                                                      
  11 :       LOGICAL IV,LOGIN,LOGRE                                                    
  12 :       SEGMENT IVAL1                                                             
  13 :         INTEGER NOVAL(N)                                                    
  14 :       ENDSEGMENT                                                                
  15 :       SEGMENT IVAL2                                                             
  16 :         CHARACTER*8 TYVAL(N)                                                    
  17 :       ENDSEGMENT                                                                
  18 :       SEGMENT IVAL3                                                             
  19 :         INTEGER IVAL(N)                                                         
  20 :       ENDSEGMENT                                                                
  21 :       IRET = 0  
  22 :       ireta=0  
  23 :       iretou=0                                                              
  24 :       N=0                                                                       
  25 :       IFIN=0                                                                    
  26 :       LE= LEN(ITYP)                                                             
  27 :       SEGINI IVAL1,IVAL2,IVAL3                                                  
  28 :       TYPE=ITYP                                                                 
  29 :     1 CONTINUE                                                                  
  30 :       MOTERR(1:8)=TYPE                                                          
  30 :       CALL MESLIR(-173)                                                         
  30 :       CALL LIROBJ ('TABLE',IRET,ICODE,IRETO) 
  31 : *      write(6,*) ' lecture de la table ' , iret                                  
  32 :       IF(IERR.NE.0) GO TO 10                                                    
  33 :       IF(IRETO.EQ.0)GO TO 10                                                   
  34 :       TYPOBJ = ' '                                                              
  34 :       CALL ACCTAB(IRET,'MOT     ',IVALIN,XVALIN,'SOUSTYPE',LOGIN,               
  35 :      $        IOBIN, TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)                   
  36 :       IF(TYPOBJ.EQ.'MOT     ') THEN
  37 : *         write(6,*) ' le  ivalre ' , le , ivalre                                            
  38 :         IF(IVALRE.EQ.LE) THEN                                                   
  39 :           IF(CHARRE(1:LE).EQ.ITYP) THEN                                         
  40 : *    ON A TROUVE LA TABLE RECHERCHEE IL FAUT METTRE A JOUR LA                   
  41 : *    LECTURE DES TABLES PRECEDEMMENT LUES 
  42 :              ireta=iret
  43 :              iretou=1 
  44 : *             write(6,*) ' c est celle la'                                     
  45 :               GO TO 10                                                          
  46 :           ENDIF                                                                 
  47 :         ENDIF                                                                   
  48 :       ENDIF                                                                     
  49 : *   CE N EST PAS UNE BONNE TABLE  ON REMPLIT IVAL ET ON RETOURNE EN             
  50 : *   LECTURE                                                                     
  51 :       N = N + 1                                                                 
  52 :       SEGADJ IVAL1,IVAL2,IVAL3                                                  
  53 :       IVAL(N)=IMOTLU 
  54 :                                                            
  55 :       NOVAL(N)=INOOB1(IMOTLU)                                                   
  56 :       TYVAL(N)=INOOB2(IMOTLU)                                                   
  57 :       GO TO 1                                                                   
  58 : *                                                                               
  59 : *  AVANT DE SORTIR ON REMET LES TABLES LUES PAS(DU BON SOUSTYPE) EN             
  60 : *  LECTURE                                                                      
  61 : *                                                                               
  62 :    10 CONTINUE                                                                  
  63 :       ID = IVAL(/1)                                                             
  64 :       IF(ID.EQ.0) GO TO 20                                                      
  65 :       DO 2 J=1,ID                                                               
  66 :       IV=.TRUE.                                                                 
  67 :       imola= IVAL(J)                                                           
  68 :       IF(INOOB1(imola).NE.NOVAL(J)) IV=.FALSE.                                 
  69 :       IF(INOOB2(imola).NE.TYVAL(J)) IV=.FALSE.                                 
  70 :       IF(IV)  THEN                                                              
  71 :            JPOOB1(imola)=.TRUE.                                                
  72 :            IF(IBPILE.GT.imola) IBPILE=imola                                  
  73 :            IF(IHPILE.LT.imola) IHPILE=imola                                  
  74 :       ELSE                                                                      
  75 :            NN = JPOOB1(/1)                                                      
  76 :            DO 5 KK=1,NN                                                         
  77 :            IF(INOOB1(KK).NE.NOVAL(KK))  GO TO 5                                 
  78 :            IF(INOOB2(KK).NE.TYVAL(KK))  GO TO 5                                 
  79 :            IF(JPOOB1(KK)) GO TO 5                                               
  80 :            JPOOB1(KK)=.TRUE.                                                    
  81 :            GO TO 6                                                              
  82 :     5      CONTINUE                                                             
  82 :            CALL ERREUR(5)                                                       
  83 :            RETURN                                                               
  84 :     6      CONTINUE                                                             
  85 :       ENDIF                                                                     
  86 :     2 CONTINUE                                                                  
  87 :    20 CONTINUE                                                                  
  88 :       SEGSUP IVAL1,IVAL2,IVAL3                                                  
  89 :       RETURN                                                                    
  90 :       END   
  91 :  
  92 :