1 : C DTCHPZ SOURCE CHAT 09/09/21 21:16:17 6511 2 : SUBROUTINE DTCHPZ(IRET,ktrace,msorse) 3 : C 4 : C **** DESTRUCTION D'UN CHPOINT: ON TUE LES VALEURS,LES MSOUPO, 5 : C **** LE CHAPEAU. IGEOC EST CONSERVE SI PAS LECTURE DU MOT GEOM 6 : C 7 : IMPLICIT INTEGER(I-N) 8 : -INC SMCHPOI 9 : -INC SMELEME 10 : -INC TMCOLAC 11 : -INC CCOPTIO 12 : CHARACTER*4 MOMOT(1) 13 : character*6 msorse 14 : DATA MOMOT/'GEOM'/ 14 : CALL LIRMOT(MOMOT,1,IDET,0) 15 : MCHPOI=IRET 16 : SEGACT MCHPOI*MOD 17 : NSOUPO=IPCHP(/1) 18 : DO 1 I=1,NSOUPO 19 : MSOUPO=IPCHP(I) 20 : SEGACT MSOUPO 21 : MPOVAL=IPOVAL 22 : MELEME=IGEOC 23 : IF (IDET.EQ.1) THEN 24 : if(meleme.eq.ktrace) then 25 : msorse='MELEME' 26 : ktrace=-ktrace 27 : endif 28 : SEGSUP MELEME 29 : IF(IPSAUV.NE.0) THEN 30 : ICOLAC=IPSAUV 31 : SEGACT ICOLAC 32 : ILISSE=ILISSG 33 : SEGACT ILISSE*MOD 33 : CALL TYPFIL('MAILLAGE',ICO) 34 : ITLACC=KCOLA(ICO) 35 : SEGACT ITLACC*MOD 35 : CALL AJOUN0(ITLACC,MELEME,ILISSE,1) 36 : SEGDES ITLACC 37 : SEGDES ILISSE 38 : SEGDES ICOLAC 39 : ENDIF 40 : ENDIF 41 : if( msoupo.eq.ktrace) then 42 : msorse='MSOUPO' 43 : ktrace=-ktrace 44 : endif 45 : if( mpoval.eq.ktrace) then 46 : msorse='MPOVAL' 47 : ktrace=-ktrace 48 : endif 49 : SEGSUP MPOVAL 50 : SEGSUP MSOUPO 51 : 1 CONTINUE 52 : NSOUPO=0 53 : NAT=0 54 : SEGADJ MCHPOI 55 : SEGDES MCHPOI 56 : IRET=0 57 : RETURN 58 : END 59 : 60 :
© Cast3M 2003 - All rights reserved.
Disclaimer