Esope source files

   1 : C SORTRI    SOURCE    PV        10/10/13    21:15:44     6781           
   2 :       SUBROUTINE SORTRI(ICOLAC)                                                 
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 : C ---------------------------------------------------------------------         
   6 : C                                                                               
   7 : C     CAS DES OBJETS RIGIDITES                                                  
   8 : C         ET DES SUPERELEMNETS DONT ON DEMANDE LE SAUVETAGE                     
   9 : C      LE POINTEUR EST MIS NEGATIF (PILE 3)                                     
  10 : C                                                                               
  11 : C PROGRAMME PAR  FARVACQUE - REPRIS PAR LENA                                    
  12 : C APPELE PAR:    SAUV                                                           
  13 : C APPELLE:                                                                      
  14 : C=======================================================================        
  15 : C  TABLEAU KCOLA :                                                              
  16 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6                       
  17 : C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU                
  18 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL                
  19 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER                          
  20 : C=======================================================================        
  21 : C                                                                               
  22 : -INC SMRIGID                                                                    
  23 : -INC SMSUPER                                                                    
  24 : -INC CCOPTIO                                                                    
  25 : -INC TMCOLAC        
  26 : C                                                                               
  27 : C                                                                               
  28 : C  **** CAS DES OBJETS RIGIDITES: ON NE SAUVE QUE LES MMATRI DES OBJETS         
  29 : C  **** SPECIFIES PAR L'UTILISATEUR. POUR LES RECONNAITRE ON MET LEUR           
  30 : C  **** POINTEUR NEGATIF                                                        
  31 :       SEGACT ICOLAC                                                             
  32 :       ITLACC=KCOLA(3)                                                           
  33 :       IF (ITLACC.LE.0) GO TO 2                                                  
  34 :       N=ITLAC(/1)                                                               
  35 :       IF(N.EQ.0) GO TO 1 
  36 :       ideb = kcolac(3)+1                                                     
  37 :       DO 6 IEL=ideb,N                                                              
  38 :       MRIGID=ITLAC(IEL) 
  39 :       if(mrigid.eq.0) go to 6                                                        
  40 :       SEGACT MRIGID*MOD
  41 :       ICHOLE=-ABS(ICHOLE)
  42 :       SEGDES MRIGID                                                             
  43 :   6   CONTINUE                                                                  
  44 :    1  CONTINUE                                                                  
  45 :    2  CONTINUE                                                                  
  46 : C ------MEME TRAVAIL POUR LES SUPER ELEMENTS--------------                      
  47 :       ITLACC=KCOLA(23)                                                          
  48 :       IF (ITLACC.LE.0) GO TO 20                                                 
  49 :       N=ITLAC(/1)                                                               
  50 :       IF(N.EQ.0) GO TO 10                                                       
  51 :       DO 11 IEL=1,N                                                             
  52 :       MSUPER=ITLAC(IEL)
  53 :       if(msuper.eq.0) go to 11                                                         
  54 :       SEGACT MSUPER                                                             
  55 :       MRIGID=MRIGTO                                                             
  56 :       SEGACT MRIGID*MOD
  57 :       ICHOLE=-ABS(ICHOLE)
  58 :       SEGDES MRIGID                                                             
  59 :       MRIGID=MSURAI                                                             
  60 :       SEGACT MRIGID*MOD
  61 :       ICHOLE=-ABS(ICHOLE)
  62 :       SEGDES MRIGID                                                             
  63 :       MRIGID=MSUMAS                                                             
  64 :       IF(MRIGID.NE.0) THEN                                                      
  65 :          SEGACT MRIGID*MOD
  66 :          ICHOLE=-ABS(ICHOLE)
  67 :          SEGDES MRIGID                                                          
  68 :       ENDIF                                                                     
  69 :       SEGDES MSUPER                                                             
  70 :   11  CONTINUE                                                                  
  71 :   10  CONTINUE                                                                  
  72 :   20  CONTINUE                                                                  
  73 :       SEGDES ICOLAC                                                             
  74 :       RETURN                                                                    
  75 :       END                                                                       
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :  
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  
  87 :  
  88 :  
  89 :  
  90 :  
  91 :