Esope source files

   1 : C DERIGI    SOURCE    CHAT      09/10/09    21:17:09     6519           
   2 :       SUBROUTINE DERIGI(IRET,ktrace,msorse)                                                   
   3 : C=======================================================================        
   4 : C                                                                               
   5 : C     ROUTINE POUR DETRUIRE UNE RIGIDITE                                        
   6 : C                                                                               
   7 : C=======================================================================        
   8 :       IMPLICIT INTEGER(I-N)
   9 : -INC SMRIGID 
  10 :       character*6 msorse                                                                   
  11 :       MRIGID=IRET                                                               
  12 : C                                                                               
  13 : C     SUPPRESSION DU SEGMENT SMRIGID                                            
  14 : C                                                                               
  15 :       SEGACT MRIGID                                                             
  16 :       NRIGEL=IRIGEL(/2)                                                         
  17 :       DO 100 IA=1,NRIGEL                                                        
  18 :       IF(IRIGEL(4,IA).EQ.0) GOTO 100                                            
  19 :       DESCR=IRIGEL(3,IA)
  20 :       if(ktrace.eq.DESCR) then
  21 :         ktrace=-ktrace 
  22 :         msorse='DESCR'
  23 :       endif                                                       
  24 :       SEGSUP DESCR                                                              
  25 :       xMATRI=IRIGEL(4,IA)
  26 :       if(ktrace.eq.xmatri) then
  27 :         ktrace=-ktrace
  28 :         msorse='XMATRI'
  29 :       endif                                                       
  30 :       SEGsup xMATRI                                                             
  31 : *      NELRIG=IMATTT(/1)                                                         
  32 : *      DO 200 IB=1,NELRIG                                                        
  33 : *      XMATRI=IMATTT(IB)                                                         
  34 : *      SEGSUP XMATRI                                                             
  35 : *  200 CONTINUE                                                                  
  36 : *      SEGSUP IMATRI                                                             
  37 :   100 CONTINUE                                                                  
  38 : C  
  39 :       if(ktrace.eq.MRIGID) then
  40 :         ktrace=-ktrace
  41 :         msorse='MRIGID'
  42 :       endif                                                                             
  43 :       SEGSUP MRIGID                                                             
  44 :       RETURN                                                                    
  45 :       END                                                                       
  46 :  
  47 :  
  48 :  
  49 :  
  50 :  
  51 :  
  52 :