C DTCHPZ    SOURCE    CB215821  21/11/25    21:15:05     11201          
              SUBROUTINE DTCHPZ(IRET,ktrace,msorse)
C
C **** DESTRUCTION D'UN CHPOINT: ON TUE LES VALEURS,LES MSOUPO,
C **** LE CHAPEAU. IGEOC EST CONSERVE  SI PAS LECTURE DU MOT GEOM
C
      IMPLICIT INTEGER(I-N)
      character*4 momot(1)
      character*6 msorse
      integer i,ico, idet,ipile, iret, ktrace, nat, nsoupo

-INC PPARAM
-INC CCOPTIO
-INC COCOLL
-INC SMCHPOI
-INC SMELEME
-INC TMCOLAC

      pointeur piles.LISPIL
      pointeur jcolac.ICOLAC
      pointeur jlisse.ILISSE
      pointeur jtlacc.ITLACC
      DATA MOMOT/'GEOM'/
      iun=1
      CALL LIRMOT(MOMOT,1,IDET,0)
      MCHPOI=IRET
      SEGACT MCHPOI*MOD
      NSOUPO=IPCHP(/1)
      DO 1 I=1,NSOUPO
         MSOUPO=IPCHP(I)
         SEGACT MSOUPO
         MPOVAL=IPOVAL
         MELEME=IGEOC
         IF (IDET.EQ.1) THEN
            if(meleme.eq.ktrace) then
              msorse='MELEME'
              ktrace=-ktrace
            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,iun)
               SEGDES ITLACC
               SEGDES ILISSE
               SEGDES ICOLAC
            ENDIF
C        Suppression du chpo 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
C                    normalement, deja active par detrui
C                     segact jcolac
                     jlisse=jcolac.ilissg
C                    normalement, deja active par detrui
C                     segact jlisse*mod
                     jtlacc=jcolac.kcola(ico)
                     segact jtlacc*mod
                     call ajoun0(jtlacc,MELEME,jlisse,iun)
                     segdes jtlacc
C                    Faut-il desactiver jlisse et icolac ?
C                    Non, ils sont actives par detrui et seul detrui
C                    appelle cette fonction
                  endif
               enddo
               segdes piles
            endif
         ENDIF
         if( msoupo.eq.ktrace) then
           msorse='MSOUPO'
           ktrace=-ktrace
         endif
         if( mpoval.eq.ktrace) then
           msorse='MPOVAL'
           ktrace=-ktrace
         endif
C        Les MPOVAL ne sont plus necessairement dupliques
C        SEGSUP MPOVAL
         
         SEGSUP MSOUPO
 1    CONTINUE
      NSOUPO=0
      NAT=0
      SEGADJ MCHPOI
      SEGDES MCHPOI
      IRET=0
      RETURN
      END