C DTRIGZ    SOURCE    CHAT      09/10/09    21:17:24     6519           
               SUBROUTINE DTRIGz(IRET,ktrace,msorse)                                                   
C  **** DESTRUCTION DE LA MATRICE SI ELLE EXISTE,DESTRUCTION DU CHAPEAU         
C  **** MATRICE: ON DETRUIT TOUT                                                
      IMPLICIT INTEGER(I-N)
-INC SMRIGID                                                                    
-INC SMMATRI                                                                    
-INC SMELEME                                                                    
-INC CCOPTIO
-INC TMCOLAC
-INC TMVECRIG                                                                    
      CHARACTER*4 MOMOT(1) 
      character*6 msorse                                                     
      DATA MOMOT(1)/'ELEM'/                                                     
      CALL LIRMOT(MOMOT,1,IDET,0)                                               
      MRIGID=IRET                                                               
      SEGACT MRIGID                                                             
      IF(IIMPI.EQ.1) WRITE(IOIMP,10) ICHOLE                                     
   10 FORMAT('  ON DETRUIT UNE RIGIDITE CHOLEVSKISE SI ICHOLE = 1',             
     1 I5)                                                                      
      IF(ICHOLE.EQ.0) GOTO 2                                                    
C                                                                               
C  **** DESTRUCTION DE LA MATRICE                                               
      MMATRI=ICHOLE                                                             
      SEGACT MMATRI                                                             
      MDIAG=IDIAG
      if(ktrace.eq.mdiag) then
        ktrace=-ktrace 
        msorse='MDIAG'
      endif                   
      SEGSUP MDIAG                                                              
      MELEME=IGEOMA
         IF(IPSAUV.NE.0) THEN
         ICOLAC = IPSAUV
         SEGACT ICOLAC
         ILISSE=ILISSG
         SEGACT ILISSE*MOD 
         CALL TYPFIL('MAILLAGE',ICO)
         ITLACC = KCOLA(ICO)
         SEGACT ITLACC*MOD
         CALL AJOUN0(ITLACC,MELEME,ILISSE,1)
*        SEGDES ITLACC,ILISSE
*        SEGDES ICOLAC
         ENDIF                                                             
      SEGSUP MELEME                                                                      
      MINCPO=IINCPO 
      if(ktrace.eq.mincpo) then
        ktrace=-ktrace         
        msorse='MINCPO'
      endif                     
      SEGSUP MINCPO                                                             
      MIDUA=IIDUA 
      if(ktrace.eq.midua) then
        ktrace=-ktrace
        msorse='MIDUA'
      endif                             
      SEGSUP MIDUA                                                              
      MHARK=IHARK
      if(ktrace.eq.mhark) then
        ktrace=-ktrace
        msorse='MHARK'
      endif                       
      SEGSUP MHARK                                                              
      MIMIK=IIMIK
      if(ktrace.eq.mimik) then
        ktrace=-ktrace
        msorse='MIMIK'
      endif                      
      SEGSUP MIMIK                       
      MDNOR=IDNORM
      if(ktrace.eq.mdnor) then
        ktrace=-ktrace 
        msorse='MDNOR'
      endif                
      SEGSUP MDNOR                                                              
      MILIGN=IILIGN                                                             
      SEGACT MILIGN                                                             
      INC=ILIGN(/1)                                                             
      DO 1 I=1,INC                                                              
      LIGN=ILIGN(I)
      if(ktrace.eq.lign) then
        ktrace=-ktrace 
        msorse='LIGN'
      endif                 
      SEGSUP LIGN                                                               
 1    CONTINUE
      if(ktrace.eq.milign)  then
        ktrace=-ktrace
        msorse='MILIGN'
      endif     
      SEGSUP MILIGN 
      if(ktrace.eq.mmatri) then
        ktrace=-ktrace 
        msorse='MMATRI' 
      endif       
      SEGSUP MMATRI                             
C                                                                               
C  **** DESTRUCTION DU CHAPEAU                                                  
 2    CONTINUE                                                                  
C                                                                               
CCCCCCCCCCCCC  SI ON MIS DETRUIRE ELEM ON DETRUIT AUSSI LES RIGI    
C              ELEMENTAIRES                                
      IF(IMGEO1.NE.0) THEN                                                      
              IMGEOD=IMGEO1
              if(ktrace.eq.imgeo1) then
                ktrace=-ktrace 
                msorse='IMGEOD'
              endif       
              SEGSUP IMGEOD                                         
      ENDIF  
      IF(ivecri.ne.0) then
            mvecri=ivecri
            segsup mvecri
            if(ktrace.eq.ivecri) then
                ktrace=-ktrace 
                msorse='IVECRI'
            endif
      ENDIF                                                                       
      IF(IDET.EQ.1) CALL DERIGI(IRET,KTRACE,MSORSE)                                      
      IF(IDET.EQ.0) THEN
        if(ktrace.eq.mrigid) then
          ktrace=-ktrace
          msorse='MRIGID'
        endif      
        SEGSUP MRIGID  
      ENDIF                                             
      IRET=0                                                                    
      RETURN                                                                      
      END