1 : C CHANLI SOURCE GOUNAND 14/01/31 21:15:01 7924 2 : SUBROUTINE CHANLI 3 : * 4 : * ce sub fait passer tous les elemnts quadratique en lineaire, 5 : * il conserve le nombre d'elements 6 : * modif SG 01/2014 : passage des QUAFs aux linéaires 7 : 8 : IMPLICIT INTEGER(I-N) 9 : -INC CCOPTIO 10 : -INC SMELEME 11 : logical ltelq 12 : SEGMENT INOO 13 : INTEGER INOU(NA) 14 : ENDSEGMENT 15 : 15 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 16 : IF(IERR.NE.0) RETURN 17 : SEGACT IPT1 18 : MELEME=IPT1 19 : NBNN= NUM(/1) 20 : NBELEM=NUM(/2) 21 : NBSOUS=LISOUS(/1) 22 : NBREF=0 23 : NA= MAX(NBSOUS,1) 24 : SEGINI INOO 25 : DO 100 I=1,MAX(IPT1.LISOUS(/1),1) 26 : IF( IPT1.LISOUS(/1).NE.0) THEN 27 : MELEME=IPT1.LISOUS(I) 28 : SEGACT MELEME 29 : ENDIF 30 : NBELEM=NUM(/2) 31 : NBSOUS=0 32 : NBREF=0 33 : IF( ITYPEL.EQ.3)THEN 34 : * cas des seg3 ---> seg2 35 : NBNN=2 36 : SEGINI IPT2 37 : IPT2.ITYPEL=2 38 : INOU(I) = IPT2 39 : DO 1 K=1,NBELEM 40 : IPT2.NUM(1,K)=NUM(1,K) 41 : IPT2.NUM(2,K)=NUM(3,K) 42 : IPT2.ICOLOR(K)=ICOLOR(K) 43 : 1 CONTINUE 44 : SEGDES IPT2 45 : ELSEIF( ITYPEL.EQ.6. OR. ITYPEL.EQ.7) THEN 46 : * cas des tri6,tri7 ---> tri3 47 : NBNN=3 48 : SEGINI IPT2 49 : IPT2.ITYPEL=4 50 : INOU(I) = IPT2 51 : DO 2 K=1,NBELEM 52 : IPT2.NUM(1,K)=NUM(1,K) 53 : IPT2.NUM(2,K)=NUM(3,K) 54 : IPT2.NUM(3,K)=NUM(5,K) 55 : IPT2.ICOLOR(K)=ICOLOR(K) 56 : 2 CONTINUE 57 : SEGDES IPT2 58 : ELSEIF( ITYPEL.EQ.10 . OR. ITYPEL.EQ.11) THEN 59 : * cas des qua8,qua9-----> qua4 60 : NBNN=4 61 : SEGINI IPT2 62 : IPT2.ITYPEL=8 63 : INOU(I) = IPT2 64 : DO 3 K=1,NBELEM 65 : IPT2.NUM(1,K)=NUM(1,K) 66 : IPT2.NUM(2,K)=NUM(3,K) 67 : IPT2.NUM(3,K)=NUM(5,K) 68 : IPT2.NUM(4,K)=NUM(7,K) 69 : IPT2.ICOLOR(K)=ICOLOR(K) 70 : 3 CONTINUE 71 : SEGDES IPT2 72 : ELSEIF( ITYPEL.EQ.13) THEN 73 : *4 cas des rac3 ---> rac2 74 : NBNN=4 75 : SEGINI IPT2 76 : IPT2.ITYPEL=12 77 : INOU(I) = IPT2 78 : DO 4 K=1,NBELEM 79 : IPT2.NUM(1,K)=NUM(1,K) 80 : IPT2.NUM(2,K)=NUM(3,K) 81 : IPT2.NUM(3,K)=NUM(4,K) 82 : IPT2.NUM(4,K)=NUM(6,K) 83 : IPT2.ICOLOR(K)=ICOLOR(K) 84 : 4 CONTINUE 85 : SEGDES IPT2 86 : ELSEIF( ITYPEL.EQ.15.OR.ITYPEL.EQ.33) THEN 87 : *5 cas des cu20, cu27 ---> cub8 88 : NBNN=8 89 : SEGINI IPT2 90 : IPT2.ITYPEL=14 91 : INOU(I) = IPT2 92 : DO 5 K=1,NBELEM 93 : IPT2.NUM(1,K)=NUM(1,K) 94 : IPT2.NUM(2,K)=NUM(3,K) 95 : IPT2.NUM(3,K)=NUM(5,K) 96 : IPT2.NUM(4,K)=NUM(7,K) 97 : IPT2.NUM(5,K)=NUM(13,K) 98 : IPT2.NUM(6,K)=NUM(15,K) 99 : IPT2.NUM(7,K)=NUM(17,K) 100 : IPT2.NUM(8,K)=NUM(19,K) 101 : IPT2.ICOLOR(K)=ICOLOR(K) 102 : 5 CONTINUE 103 : SEGDES IPT2 104 : ELSEIF( ITYPEL.EQ.17.OR.ITYPEL.EQ.34) THEN 105 : *6 cas des pr15, pr21 ---> pri6 106 : NBNN=6 107 : SEGINI IPT2 108 : IPT2.ITYPEL=16 109 : INOU(I) = IPT2 110 : DO 6 K=1,NBELEM 111 : IPT2.NUM(1,K)=NUM(1,K) 112 : IPT2.NUM(2,K)=NUM(3,K) 113 : IPT2.NUM(3,K)=NUM(5,K) 114 : IPT2.NUM(4,K)=NUM(10,K) 115 : IPT2.NUM(5,K)=NUM(12,K) 116 : IPT2.NUM(6,K)=NUM(14,K) 117 : IPT2.ICOLOR(K)=ICOLOR(K) 118 : 6 CONTINUE 119 : SEGDES IPT2 120 : ELSEIF( ITYPEL.EQ.20. OR. itypel.eq.21) THEN 121 : *7 cas des lia6,lia8 ---> lia3,lia4 122 : NBNN=6 123 : IF(ITYPEL.EQ.21) NBNN=8 124 : SEGINI IPT2 125 : IPT2.ITYPEL=18 126 : IF(ITYPEL.EQ.21)IPT2.ITYPEL=19 127 : INOU(I) = IPT2 128 : DO 7 K=1,NBELEM 129 : IPT2.NUM(1,K)=NUM(1,K) 130 : IPT2.NUM(2,K)=NUM(3,K) 131 : IPT2.NUM(3,K)=NUM(5,K) 132 : IPT2.NUM(4,K)=NUM(7,K) 133 : IPT2.NUM(5,K)=NUM(9,K) 134 : IPT2.NUM(6,K)=NUM(11,K) 135 : IPT2.ICOLOR(K)=ICOLOR(K) 136 : IF( ITYPEL.EQ.21) THEN 137 : IPT2.NUM(7,K)=NUM(13,K) 138 : IPT2.NUM(8,K)=NUM(15,K) 139 : ENDIF 140 : 7 CONTINUE 141 : SEGDES IPT2 142 : ELSEIF( ITYPEL.EQ.24.OR.ITYPEL.EQ.35) THEN 143 : *8 cas des te10, te15 ---> te4 144 : NBNN=4 145 : SEGINI IPT2 146 : IPT2.ITYPEL=23 147 : INOU(I) = IPT2 148 : DO 8 K=1,NBELEM 149 : IPT2.NUM(1,K)=NUM(1,K) 150 : IPT2.NUM(2,K)=NUM(3,K) 151 : IPT2.NUM(3,K)=NUM(5,K) 152 : IPT2.NUM(4,K)=NUM(10,K) 153 : IPT2.ICOLOR(K)=ICOLOR(K) 154 : 8 CONTINUE 155 : SEGDES IPT2 156 : ELSEIF( ITYPEL.EQ.26.OR.ITYPEL.EQ.36) THEN 157 : *9 cas des py13, py19 ---> pyr5 158 : NBNN=5 159 : SEGINI IPT2 160 : IPT2.ITYPEL=25 161 : INOU(I) = IPT2 162 : DO 9 K=1,NBELEM 163 : IPT2.NUM(1,K)=NUM(1,K) 164 : IPT2.NUM(2,K)=NUM(3,K) 165 : IPT2.NUM(3,K)=NUM(5,K) 166 : IPT2.NUM(4,K)=NUM(7,K) 167 : IPT2.NUM(5,K)=NUM(13,K) 168 : IPT2.ICOLOR(K)=ICOLOR(K) 169 : 9 CONTINUE 170 : SEGDES IPT2 171 : ELSE 172 : *tous les autres elements : on engrange 173 : INOU(I) = MELEME 174 : ENDIF 175 : SEGDES MELEME 176 : 100 CONTINUE 177 : SEGDES IPT1 178 : * on fusionne les sous parties 179 : II=INOU(/1) 180 : IRETOU=INOU(1) 181 : IF(II.EQ.1) GO TO 15 182 : DO 16 J=2,II 183 : INN=INOU(J) 184 : ltelq=.false. 184 : CALL FUSE( IRETOU,INN,IPT5,ltelq) 185 : IRETOU=IPT5 186 : 16 CONTINUE 187 : 15 CONTINUE 187 : CALL ECROBJ('MAILLAGE',IRETOU) 188 : RETURN 189 : END 190 : 191 : 192 : 193 : 194 : 195 : 196 : 197 : 198 : 199 : 200 :
© Cast3M 2003 - All rights reserved.
Disclaimer