C DTSUPZ    SOURCE    PV        11/03/08    21:15:29     6888           
               SUBROUTINE DTSUPz(IRET,ktrace,msorse)                                                   
C  **** DESTRUCTION APPROXIMATIVE D'UN SUPER-ELEMENT                            
      IMPLICIT INTEGER(I-N)
-INC SMSUPER                                                                    
-INC SMELEME                                                                    
-INC SMMATRI 
-INC CCOPTIO
-INC TMCOLAC 
      character*6 msorse                                                                        MSUPER=IRET                                                               
      MSUPER=IRET
      SEGACT MSUPER                                                             
C
      IAUX=MRIGTO                                                               
      CALL DTRIGZ(IAUX,ktrace,msorse)
C
      IAUX=MSURAI                                                               
      CALL DTRIGZ(IAUX,ktrace,msorse)
C
      MELEME=MSUPEL
      if( ktrace.eq.meleme) then
        ktrace=-ktrace  
        msorse='MELEME'
      endif                           
      SEGSUP MELEME
         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)
         CALL TYPFIL('RIGIDITE',ICO)
         ITLACC = KCOLA(ICO)
         SEGACT ITLACC*MOD
         IAUX=MSURAI
         CALL AJOUN0(ITLACC,IAUX,ILISSE,1)
         IAUX=MRIGTO
         CALL AJOUN0(ITLACC,IAUX,ILISSE,1)
         SEGDES ITLACC
         SEGDES ICOLAC,ILISSE
         ENDIF                                                             
C
      MMATRI=MCROUT
      SEGACT MMATRI                                                             
      MDIAG=IDIAG
      if( ktrace.eq.mdiag) then 
        ktrace=-ktrace 
        msorse='MDNOR'
      endif                              
      SEGSUP MDIAG                                                              
      MELEME=IGEOMA
      if( ktrace.eq.meleme) then
        ktrace=-ktrace 
        msorse='MELEME'
      endif                                                            
      SEGSUP MELEME 
         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
         SEGDES ICOLAC,ILISSE
         ENDIF                                                     
      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
         IF(IPSAUV.NE.0) THEN
         ICOLAC = IPSAUV
         SEGACT ICOLAC
         ILISSE=ILISSG
         SEGACT ILISSE*MOD
         CALL TYPFIL('IMATRI  ',ICO)
         ITLACC = KCOLA(ICO)
         SEGACT ITLACC*MOD
         CALL AJOUN0(ITLACC,MMATRI,ILISSE,1)
         SEGDES ITLACC
         SEGDES ICOLAC,ILISSE
         ENDIF                                                             
C
      if( ktrace.eq.msuper) then
        ktrace=-ktrace
        msorse='MSUPER'
      endif
      SEGSUP MSUPER                                                             
      RETURN                                                                               
      END