Esope source files

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