Esope source files

   1 : C REMPL3    SOURCE    JC220346  12/05/15    21:15:04     7370           
   2 : *                                                                               
   3 :       SUBROUTINE REMPL3 (IPOINT,IEME,LEMOT,IPLISM,IPOS)
   4 : ************************************************************************        
   5 : *                                                                               
   6 : *                             R E M P L 3                                       
   7 : *                             -----------                                       
   8 : *                                                                               
   9 : * FONCTION:                                                                     
  10 : * ---------                                                                     
  11 : *                                                                               
  12 : *     REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE 'LISTMOTS'.                 
  13 : *                                                                               
  14 : * MODE D'APPEL:                                                                 
  15 : * -------------                                                                 
  16 : *                                                                               
  16 : *     CALL REMPL3 (IPOINT,IEME,LEMOT)                                           
  17 : *                                                                               
  18 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  19 : * -----------                                                                   
  20 : *                                                                               
  21 : *     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTMOTS".            
  22 : *     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'ELEMENT A REMPLACER            
  23 : *                            DANS L'OBJET DE TYPE "LISTMOTS".                   
  24 : *     LEMOT   ENTIER    (E)  ELEMENT REMPLACANT (CONTIENT UNE CHAINE DE         
  25 : *                            CARACTERES).
  26 : *     IPLISM  ENTIER    (E)  POINTEUR VERS UN "LISTMOTS" DE REMPLACANTS
  27 : *     IPOS    ENTIER    (E)  SI NEGATIF, IEME EST UN POINTEUR "LISTENTI"                           
  28 : *                                                                               
  29 : * SOUS-PROGRAMMES APPELES:                                                      
  30 : * ------------------------                                                      
  31 : *                                                                               
  32 : *     ERREUR                                                                    
  33 : *                                                                               
  34 : * AUTEUR, DATE DE CREATION:                                                     
  35 : * -------------------------                                                     
  36 : *                                                                               
  37 : *     PASCAL MANIGOT     5 DECEMBRE 1984                                        
  38 : *                                                                               
  39 : * LANGAGE:                                                                      
  40 : * --------                                                                      
  41 : *                                                                               
  42 : *     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS            
  43 : *                                                                               
  44 : ************************************************************************        
  45 : *                                                                               
  46 :       IMPLICIT INTEGER(I-N)
  47 : *                                                                               
  48 : -INC CCOPTIO
  49 : -INC SMLENTI                                                                    
  50 : -INC SMLMOTS                                                                    
  51 : *                                                                               
  52 :       CHARACTER*(*) LEMOT                                                       
  53 : *                                                                               
  54 :       MLMOTS=IPOINT
  55 :       SEGACT,MLMOTS*MOD                                                         
  56 : *
  57 : *     Y a-t-il plusieurs remplacements a faire ?
  58 :       NBRMPL=1
  59 :       IF (IPOS.LT.0) THEN
  60 :           MLENT1=IEME
  61 :           SEGACT,MLENT1
  62 :           NBRMPL=MLENT1.LECT(/1)
  63 : *
  64 : *         Y a-t-il des valeurs de remplacement distinctes ?
  65 :           IF (IPLISM.NE.0) THEN
  66 :               MLMOT1=IPLISM
  67 :               SEGACT,MLMOT1
  68 :               IF (MLMOT1.MOTS(/2).NE.NBRMPL) THEN
  69 :                   MOTERR(1:8)='LISTxxxx'
  69 :                   CALL ERREUR(1015)
  70 :                   RETURN
  71 :               ENDIF
  72 :           ENDIF
  73 :       ENDIF
  74 : *
  75 : *     Mise a jour du LISTMOTS
  76 :       DO II=1,NBRMPL
  77 :           IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
  78 :           IF (IPLISM.NE.0) LEMOT=MLMOT1.MOTS(II)
  79 :           IF (0.LT.IEME.AND.IEME.LE.MOTS(/2)) THEN
  80 :               MOTS(IEME)=LEMOT
  81 :           ELSE
  82 :               INTERR(1)=IEME
  82 :               CALL ERREUR(36)
  83 :           ENDIF
  84 :       ENDDO
  85 : *                                                                               
  86 :       SEGDES,MLMOTS
  87 :       IF (IPOS.LT.0) SEGDES,MLENT1
  88 :       IF (IPLISM.NE.0) SEGDES,MLMOT1
  89 : *                                                                               
  90 :       END                                                                       
  91 : 
  92 :  
  93 :