C DTCHPO SOURCE MB234859 22/10/27 21:15:01 11488 SUBROUTINE DTCHPO(IRET) 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) integer i,ico, idet, ipile, iret,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) if(ierr.ne.0) return 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 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 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 ENDIF SEGSUP MPOVAL SEGSUP MSOUPO 1 CONTINUE NSOUPO=0 NAT=0 SEGADJ MCHPOI ** ipchp(1)=0 SEGDES MCHPOI IRET=0 RETURN END