Download inser1.eso

Back to the list

   1 : C INSER1    SOURCE    CHAT      05/01/13    00:38:44     5004           
   2 :       SUBROUTINE INSER1 (MLREEL,IEME,REELDP)                                    
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             I N S E R 1                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     INSERER UN ELEMENT EN I-EME POSITION (ET NON PAS APRES LA I-EME           
  12 : *     POSITION) DANS UN OBJET DE TYPE 'LISTREEL'.                               
  13 : *                                                                               
  14 : *                                                                               
  15 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  16 : * -----------                                                                   
  17 : *                                                                               
  18 : *     MLREEL  ENTIER    (E)  POINTEUR DE L'OBJET DE TYPE "LISTREEL".            
  19 : *     IEME    ENTIER    (E)  POSITION D'INSERTION DE L'ELEMENT DANS             
  20 : *                            L'OBJET DE TYPE "LISTREEL".                        
  21 : *     REELDP  REEL DP   (E)  ELEMENT INSERE.                                    
  22 : *                                                                               
  23 : * SOUS-PROGRAMMES APPELES:                                                      
  24 : * ------------------------                                                      
  25 : *                                                                               
  26 : *     ERREUR                                                                    
  27 : *                                                                               
  28 : * AUTEUR, DATE DE CREATION:                                                     
  29 : * -------------------------                                                     
  30 : *                                                                               
  31 : *     PASCAL MANIGOT     6 DECEMBRE 1984                                        
  32 : *                                                                               
  33 : * LANGAGE:                                                                      
  34 : * --------                                                                      
  35 : *                                                                               
  36 : *     ESOPE + FORTRAN77                                                         
  37 : *                                                                               
  38 : ************************************************************************        
  39 : *                                                                               
  40 :       IMPLICIT INTEGER(I-N)
  41 : -INC CCOPTIO                                                                    
  42 : -INC SMLREEL                                                                    
  43 : *                                                                               
  44 :       REAL*8 REELDP                                                             
  45 : *                                                                               
  46 :       SEGACT,MLREEL                                                             
  47 :       LDIM = PROG(/1)                                                           
  48 :       LDIM1 = LDIM + 1                                                          
  49 :       JG = LDIM1                                                                
  50 :       SEGADJ,MLREEL                                                             
  51 :                                                                                 
  52 : *                                                                               
  53 : *                                                                               
  54 :       IF (0 .LT. IEME .AND. IEME .LE. LDIM1) THEN                               
  55 :         IF ( IEME .LT .LDIM1)  THEN                                             
  56 :          DO 110 I= LDIM   , IEME , -1                                           
  57 :            PROG(I + 1 ) = PROG(I)                                               
  58 :   110    CONTINUE                                                               
  59 :         ENDIF                                                                   
  60 :         PROG(IEME) = REELDP                                                     
  61 :       ELSE                                                                      
  62 :          INTERR(1) = IEME                                                       
  63 :          NUMERR = 36                                                            
  63 :          CALL ERREUR (NUMERR)                                                   
  64 : *                                                                               
  65 :       END IF                                                                    
  66 : *                                                                               
  67 :       SEGDES,MLREEL                                                             
  68 : *                                                                               
  69 :       END                                                                       
  70 :  

© Cast3M 2003 - All rights reserved.
Disclaimer