Esope source files

   1 : C REMPL1    SOURCE    JC220346  12/05/15    21:15:03     7370           
   2 :       SUBROUTINE REMPL1 (IPOINT,IEME,REELDP,IPLISR,IPOS)
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             R E M P L 1                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTREEL".                 
  12 : *                                                                               
  13 : * MODE D'APPEL:                                                                 
  14 : * -------------                                                                 
  15 : *                                                                               
  15 : *     CALL REMPL1 (IPOINT,IEME,REELDP)                                          
  16 : *                                                                               
  17 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  18 : * -----------                                                                   
  19 : *                                                                               
  20 : *     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTREEL".            
  21 : *     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'ELEMENT A REMPLACER            
  22 : *                            DANS L'OBJET DE TYPE "LISTREEL".                   
  23 : *     REELDP  REEL DP   (E)  ELEMENT REMPLACANT.
  24 : *     IPLISR  ENTIER    (E)  POINTEUR VERS UN "LISTREEL" 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     6 DECEMBRE 1984                                        
  36 : *                                                                               
  37 : * LANGAGE:                                                                      
  38 : * --------                                                                      
  39 : *                                                                               
  40 : *     ESOPE + FORTRAN77                                                         
  41 : *                                                                               
  42 : ************************************************************************        
  43 : *                                                                               
  44 :       IMPLICIT INTEGER(I-N)
  45 : -INC CCOPTIO
  46 : -INC SMLENTI                                                                 
  47 : -INC SMLREEL                                                                    
  48 : *                                                                               
  49 :       REAL*8 REELDP                                                             
  50 : *
  51 :       MLREEL=IPOINT
  52 :       SEGACT,MLREEL*MOD
  53 : *
  54 : *     Y a-t-il plusieurs remplacements a faire ?
  55 :       NBRMPL=1
  56 :       IF (IPOS.LT.0) THEN
  57 :           MLENT1=IEME
  58 :           SEGACT,MLENT1
  59 :           NBRMPL=MLENT1.LECT(/1)
  60 : *
  61 : *         Y a-t-il des valeurs de remplacement distinctes ?
  62 :           IF (IPLISR.NE.0) THEN
  63 :               MLREE1=IPLISR
  64 :               SEGACT,MLREE1
  65 :               IF (MLREE1.PROG(/1).NE.NBRMPL) THEN
  66 :                   MOTERR(1:8)='LISTxxxx'
  66 :                   CALL ERREUR(1015)
  67 :                   RETURN
  68 :               ENDIF
  69 :           ENDIF
  70 :       ENDIF
  71 : *
  72 : *     Mise a jour du LISTREEL
  73 :       DO II=1,NBRMPL
  74 :           IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
  75 :           IF (IPLISR.NE.0) REELDP=MLREE1.PROG(II)
  76 :           IF (0.LT.IEME.AND.IEME.LE.PROG(/1)) THEN
  77 :               PROG(IEME)=REELDP
  78 :           ELSE
  79 :               INTERR(1)=IEME
  79 :               CALL ERREUR(36)
  80 :           ENDIF
  81 :       ENDDO
  82 : *                                                                               
  83 :       SEGDES,MLREEL
  84 :       IF (IPOS.LT.0) SEGDES,MLENT1
  85 :       IF (IPLISR.NE.0) SEGDES,MLREE1
  86 : *                                                                               
  87 :       END                                                                       
  88 :  
  89 :  
  90 :