1 : C DTRIGI SOURCE PV 11/03/08 21:15:26 6888 2 : SUBROUTINE DTRIGI(IRET) 3 : C **** DESTRUCTION DE LA MATRICE SI ELLE EXISTE,DESTRUCTION DU CHAPEAU 4 : C **** MATRICE: ON DETRUIT TOUT 5 : IMPLICIT INTEGER(I-N) 6 : -INC SMRIGID 7 : -INC SMMATRI 8 : -INC SMELEME 9 : -INC CCOPTIO 10 : -INC TMCOLAC 11 : -INC TMVECRIG 12 : CHARACTER*4 MOMOT(1) 13 : CHARACTER*6 msorse 14 : DATA MOMOT(1)/'ELEM'/ 14 : CALL LIRMOT(MOMOT,1,IDET,0) 15 : MRIGID=IRET 16 : SEGACT MRIGID 17 : IF(IIMPI.EQ.1) WRITE(IOIMP,10) ICHOLE 18 : 10 FORMAT(' ON DETRUIT UNE RIGIDITE CHOLEVSKISE SI ICHOLE = 1', 19 : 1 I5) 20 : IF(ICHOLE.EQ.0) GOTO 2 21 : C 22 : C **** DESTRUCTION DE LA MATRICE 23 : MMATRI=ICHOLE 24 : SEGACT MMATRI 25 : MDIAG=IDIAG 26 : SEGSUP MDIAG 27 : MELEME=IGEOMA 28 : IF(IPSAUV.NE.0) THEN 29 : ICOLAC = IPSAUV 30 : SEGACT ICOLAC 31 : ILISSE=ILISSG 32 : SEGACT ILISSE*MOD 32 : CALL TYPFIL('MAILLAGE',ICO) 33 : ITLACC = KCOLA(ICO) 34 : SEGACT ITLACC*MOD 34 : CALL AJOUN0(ITLACC,MELEME,ILISSE,1) 35 : * SEGDES ITLACC,ILISSE 36 : * SEGDES ICOLAC 37 : ENDIF 38 : SEGSUP MELEME 39 : MINCPO=IINCPO 40 : SEGSUP MINCPO 41 : MIDUA=IIDUA 42 : SEGSUP MIDUA 43 : MHARK=IHARK 44 : SEGSUP MHARK 45 : MIMIK=IIMIK 46 : SEGSUP MIMIK 47 : MDNOR=IDNORM 48 : SEGSUP MDNOR 49 : MILIGN=IILIGN 50 : SEGACT MILIGN 51 : INC=ILIGN(/1) 52 : DO 1 I=1,INC 53 : LIGN=ILIGN(I) 54 : SEGSUP LIGN 55 : 1 CONTINUE 56 : SEGSUP MILIGN 57 : SEGSUP MMATRI 58 : C 59 : C **** DESTRUCTION DU CHAPEAU 60 : 2 CONTINUE 61 : C 62 : CCCCCCCCCCCCC SI ON MIS DETRUIRE ELEM ON DETRUIT AUSSI LES RIGI 63 : C ELEMENTAIRES 64 : IF(IMGEO1.NE.0) THEN 65 : IMGEOD=IMGEO1 66 : SEGSUP IMGEOD 67 : ENDIF 68 : IF(IVECRI.NE.0) then 69 : MVECRI=IVECRI 70 : segsup MVECRI 71 : endif 71 : IF(IDET.EQ.1) CALL DERIGI(IRET,-1,msorse) 72 : IF(IDET.EQ.0) SEGSUP MRIGID 73 : IRET=0 74 : RETURN 75 : END 76 : 77 : 78 : 79 : 80 : 81 : 82 : 83 : 84 : 85 : 86 : 87 : 88 : 89 : 90 : 91 :
© Cast3M 2003 - All rights reserved.
Disclaimer