Esope source files

   1 : C SAVSEG    SOURCE    PV        11/04/15    21:15:18     6945           
   2 : C  SIGNALE A MENAGE QU'IL FAUT GARDER UN SEGMENT                                
   3 : C                                                                               
   4 :       SUBROUTINE SAVSEG(IPOINT)                                                 
   5 : *                                                                               
   6 : *  LE BUT DE CE S-P EST DE RAJOUTER A LA LISTE DES SEGMENTS                     
   7 : *  PREEXISTANT UN SEGMENT                                                       
   8 :       IMPLICIT INTEGER(I-N)
   9 : -INC CCNOYAU                                                                    
  10 :       SEGMENT ISLIS(NBS)                                                        
  11 :       ISLIS=NOYSEG                                                              
  12 :       SEGACT ISLIS*mod
  13 : *  TRI                                                                          
  14 :       NBS=ISLIS(/1)                                                             
  15 :       DO 10 I=1,NBS                                                             
  16 :        if (islis(i).eq.0) goto 15
  17 :        IF (IPOINT.GT.ISLIS(I)) GOTO 10                                          
  18 :        IF (IPOINT.EQ.ISLIS(I)) GOTO 20                                          
  19 :        IF (IPOINT.LT.ISLIS(I)) GOTO 30                                          
  20 :   10  CONTINUE                                                                  
  21 :       I=NBS+1                                                                   
  22 :   30  CONTINUE                                                                  
  23 :       if (islis(nbs).ne.0) then
  24 :        NBS=NBS+1
  25 :        SEGADJ ISLIS
  26 :       endif
  27 :       DO 40 J=NBS,I+1,-1                                                        
  28 :        ISLIS(J)=ISLIS(J-1)                                                      
  29 :   40  CONTINUE                                                                  
  30 :   15  continue
  31 :       ISLIS(I)=IPOINT                                                           
  32 :   20  CONTINUE                                                                  
  33 :       SEGDES ISLIS                                                              
  34 : *     write (6,*) ' savseg longueur, insertion ',nbs,i
  35 :       END                        
  36 :  
  37 :