Download rempl2.eso

Back to the list

   1 : C REMPL2    SOURCE    JC220346  12/05/15    21:15:03     7370           
   2 :       SUBROUTINE REMPL2 (IPOINT,IEME,INTEGR,IPLISE,IPOS)                                    
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             R E M P L 2                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     REMPLACER LE I-EME ELEMENT D'UN OBJET DE TYPE "LISTENTI".                 
  12 : *                                                                               
  13 : * MODE D'APPEL:                                                                 
  14 : * -------------                                                                 
  15 : *                                                                               
  15 : *     CALL REMPL2 (IPOINT,IEME,INTEGR)                                          
  16 : *                                                                               
  17 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  18 : * -----------                                                                   
  19 : *                                                                               
  20 : *     IPOINT  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTENTI".            
  21 : *     IEME    ENTIER    (E)  NUMERO D'ORDRE DE L'ELEMENT A REMPLACER            
  22 : *                            DANS L'OBJET DE TYPE "LISTENTI".                   
  23 : *     INTEGR  ENTIER    (E)  ELEMENT REMPLACANT.
  24 : *     IPLISE  ENTIER    (E)  POINTEUR VERS UN "LISTENTI" 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     5 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 : *                                                                               
  48 :       MLENTI=IPOINT
  49 :       SEGACT,MLENTI*MOD
  50 : *
  51 : *     Y a-t-il plusieurs remplacements a faire ?
  52 :       NBRMPL=1
  53 :       IF (IPOS.LT.0) THEN
  54 :           MLENT1=IEME
  55 :           SEGACT,MLENT1
  56 :           NBRMPL=MLENT1.LECT(/1)
  57 : *
  58 : *         Y a-t-il des valeurs de remplacement distinctes ?
  59 :           IF (IPLISE.NE.0) THEN
  60 :               MLENT2=IPLISE
  61 :               SEGACT,MLENT2
  62 :               IF (MLENT2.LECT(/1).NE.NBRMPL) THEN
  63 :                   MOTERR(1:8)='LISTENTI'
  63 :                   CALL ERREUR(1015)
  64 :                   RETURN
  65 :               ENDIF
  66 :           ENDIF
  67 :       ENDIF
  68 : *
  69 : *     Mise a jour du LISTENTI
  70 :       DO II=1,NBRMPL
  71 :           IF (IPOS.LT.0) IEME=MLENT1.LECT(II)
  72 :           IF (IPLISE.NE.0) INTEGR=MLENT2.LECT(II)
  73 :           IF (0.LT.IEME.AND.IEME.LE.LECT(/1)) THEN
  74 :               LECT(IEME)=INTEGR
  75 :           ELSE
  76 :               INTERR(1)=IEME
  76 :               CALL ERREUR(36)
  77 :           ENDIF
  78 :       ENDDO                                                             
  79 : *                                                                               
  80 :       SEGDES,MLENTI
  81 :       IF (IPOS.LT.0) SEGDES,MLENT1
  82 :       IF (IPLISE.NE.0) SEGDES,MLENT2
  83 : *                                                                               
  84 :       END                                                                       
  85 :  
  86 :  
  87 :  

© Cast3M 2003 - All rights reserved.
Disclaimer