Esope source files

   1 : C INSERE    SOURCE    JC220346  12/05/16    21:15:03     7372           
   2 :       SUBROUTINE INSERE                                                         
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             I N S E R E                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : *            SOUS-PROGRAMME ASSOCIE A LA DIRECTIVE "INSERER"                    
   9 : *                                                                               
  10 : * FONCTION:                                                                     
  11 : * ---------                                                                     
  12 : *                                                                               
  13 : *     INSERER UN ELEMENT DANS UN OBJET (QUAND CELA A UN SENS).                  
  14 : *                                                                               
  15 : * PHRASE D'APPEL (EN GIBIANE):                                                  
  16 : * ----------------------------                                                  
  17 : *                                                                               
  18 : *     INSERER OBJET RANG ELEM ;                                                 
  19 : *                                                                               
  20 : * OPERANDES:                                                                    
  21 : * ----------                                                                    
  22 : *                                                                               
  23 : *     OBJET     TYPE1       OBJET OU ON INSERE UN ELEMENT.                      
  24 : *     RANG      TYPE2       INDICE DE POSITION DE L'ELEMENT A INSERER           
  25 : *                           DANS L'OBJET "OBJET".                               
  26 : *     ELEM      TYPE3       OBJET INSERE.                                       
  27 : *                                                                               
  28 : *     SI TYPE1 = ...   ALORS, TYPE2 = ...   ET TYPE3 = ...                      
  29 : *        LISTREEL             ENTIER           FLOTTANT                         
  30 : *        LISTENTI             ENTIER           ENTIER                           
  31 : *        LISTMOTS             ENTIER           MOT                              
  32 : *        LISTCHPO             ENTIER           CHPOINT                          
  33 : *                                                                               
  34 : * MODE DE FONCTIONNEMENT:                                                       
  35 : * -----------------------                                                       
  36 : *                                                                               
  37 : *     APPEL D'UN SOUS-PROGRAMME DISTINCT SELON LE TYPE DE L'OBJET               
  38 : *     "OBJET".                                                                  
  39 : *                                                                               
  40 : * AUTEUR, DATE DE CREATION:                                                     
  41 : * -------------------------                                                     
  42 : *                                                                               
  43 : *     PASCAL MANIGOT     5 DECEMBRE 1984                                        
  44 : *              MODIF LE 22 JANVIER 1988                                         
  45 : * LANGAGE:                                                                      
  46 : * --------                                                                      
  47 : *                                                                               
  48 : *     FORTRAN77                                                                 
  49 : *                                                                               
  50 : ************************************************************************        
  51 : *                                                                               
  52 :       IMPLICIT INTEGER(I-N)
  53 : -INC CCOPTIO                                                                    
  54 : *                                                                               
  55 :       REAL*8 REELDP                                                             
  56 :       CHARACTER *4 LEMOT                                                        
  57 : *                                                                               
  58 : *
  59 : *     IPOS=0 => on interdit à IPOIN2 de contenir un LISTENTI
  60 :       IPOS=0                                                            
  60 :       CALL LIRE01 (IPOIN1,IPOS,IPOIN2)                                          
  61 :       IF (IERR .NE. 0) RETURN                                                   
  62 : *                                                                               
  63 :       IF (IPOS .EQ. 1) THEN                                                     
  63 :          CALL LIRREE (REELDP,1,IRETOU)                                          
  63 :          CALL INSER5 (IPOIN1,IPOIN2,REELDP,IPOIN3)                              
  63 :          CALL ECROBJ ('LISTREEL',IPOIN3)                                        
  64 :       ELSE IF (IPOS .EQ. 2) THEN                                                
  64 :          CALL LIRENT (IPOIN3,1,IRETOU)                                          
  64 :          CALL INSER6 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)                              
  64 :          CALL ECROBJ ('LISTENTI',IPOIN4)                                        
  65 :       ELSE IF (IPOS .EQ. 3) THEN                                                
  65 :          CALL LIRCHA (LEMOT,1,IRETOU)                                           
  66 :           IF (IERR.NE.0) RETURN                                                 
  66 :          CALL INSER7 (IPOIN1,IPOIN2,LEMOT,IPOIN3)                               
  66 :          CALL ECROBJ ('LISTMOTS',IPOIN3)                                        
  67 :       ELSE IF (IPOS .EQ. 4) THEN                                                
  67 :          CALL LIROBJ ('CHPOINT',IPOIN3,1,IRETOU)                                
  67 :          CALL INSER8 (IPOIN1,IPOIN2,IPOIN3,IPOIN4)                              
  67 :          CALL ECROBJ ('LISTCHPO',IPOIN4)                                        
  68 :       ELSE IF (IPOS .NE. 0) THEN                                                
  69 :          NUMERR = 196                                                           
  69 :          CALL ERREUR (NUMERR)                                                   
  70 :       END IF                                                                    
  71 : *                                                                               
  72 :       END                                                                       
  73 :  
  74 :