C DTRIGI    SOURCE    PV090527  24/09/04    21:15:02     12002          
      SUBROUTINE DTRIGI(IRET)
C  **** DESTRUCTION DE LA MATRICE SI ELLE EXISTE,DESTRUCTION DU CHAPEAU
C  **** MATRICE: ON DETRUIT TOUT
      IMPLICIT INTEGER(I-N)
      character*4 momot(1)
      character*6 msorse
      integer i,ico, idet, inc, ipile, iret

-INC PPARAM
-INC CCOPTIO
-INC COCOLL
-INC SMRIGID
-INC SMMATRI
-INC SMELEME
-INC TMCOLAC
-INC TMVECRIG

      pointeur piles.LISPIL
      pointeur jcolac.ICOLAC
      pointeur jlisse.ILISSE
      pointeur jtlacc.ITLACC
      pointeur pile.ITLACC
      DATA MOMOT(1)/'ELEM'/
      iun=1
      CALL LIRMOT(MOMOT,1,IDET,0)
      MRIGID=IRET
      IF(IIMPI.EQ.1) WRITE(IOIMP,10) ICHOLE
   10 FORMAT('  ON DETRUIT UNE RIGIDITE CHOLEVSKISE SI ICHOLE = 1',
     1 I5)
 1000 continue
      SEGACT MRIGID
      IF(ICHOLE.EQ.0) GOTO 2
C
C  **** DESTRUCTION DE LA MATRICE
      MMATRI=ICHOLE
      SEGACT MMATRI
      MDIAG=IDIAG
      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,iun)
*        SEGDES ITLACC,ILISSE
*        SEGDES ICOLAC
      ENDIF
C        Suppression du meleme des piles d'objets communiques
      if(piComm.gt.0) then
         piles=piComm
         segact piles
         call typfil('MAILLAGE',ico)
         do ipile=1,piles.proc(/1)
            jcolac= piles.proc(ipile)
            if(jcolac.ne.0) then
               segact jcolac
               jlisse=jcolac.ilissg
               segact jlisse*mod
               jtlacc=jcolac.kcola(ico)
               segact jtlacc*mod
               call ajoun0(jtlacc,MELEME,jlisse,iun)
               segdes jtlacc
               segdes jlisse
               segdes jcolac
            endif
         enddo
         segdes piles
      endif
***   SEGSUP MELEME
      MINCPO=IINCPO
      SEGSUP MINCPO
      MIDUA=IIDUA
      SEGSUP MIDUA
      MHARK=IHARK
      SEGSUP MHARK
      MIMIK=IIMIK
      SEGSUP MIMIK
      MDNOR=IDNORM
      SEGSUP MDNOR
      MILIGN=IILIGN
      SEGACT MILIGN
      INC=ILIGN(/1)
      DO 1 I=1,INC
      LIGN=ILIGN(I)
      SEGSUP LIGN
 1    CONTINUE
      SEGSUP MILIGN
      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
              SEGSUP IMGEOD
      ENDIF
      IF(IVECRI.NE.0) then
            MVECRI=IVECRI
            segsup MVECRI
      endif
      IF(IDET.EQ.1) THEN
        ktrace = -1
        CALL DERIGI(IRET,ktrace,msorse)
      ENDIF
      mrigt=jrcond
**    IF(IDET.EQ.0) then
      nrigel=irigel(/2)
      segadj mrigid
      imgeo1=0
      ICHOLE=0
      ivecri=0
**    endif
      mrigid=mrigt
      if(mrigid.ne.0) goto 1000
      IRET=0
      RETURN
      END