1 : C DEMCHA SOURCE BP208322 13/02/07 21:15:11 7696 2 : SUBROUTINE DEMCHA(IPT8,MELEME) 3 : * 4 : * met en element quadratique un maillage meleme. 5 : * on teste dans ipt8 si des elements quadratiques existent deja 6 : * 7 : IMPLICIT INTEGER(I-N) 8 : -INC SMELEME 9 : -INC CCOPTIO 10 : -INC CCGEOME 11 : -INC SMCOORD 12 : logical ltelq 13 : SEGMENT KONPOS(NBPTS) 14 : SEGMENT KONFIN(IKOUR) 15 : SEGMENT KONMIL(IKOUR) 16 : SEGMENT KONSUI(IKOUR) 17 : SEGMENT INOU(NBS) 18 : 19 : * I PRISE EN COMPTE DU MAILLAGE DE SURFACE 20 : NBPTS=XCOOR(/1)/(IDIM+1) 21 : SEGINI KONPOS 22 : IKOUR=4*NBPTS 23 : SEGINI KONFIN,KONMIL,KONSUI 24 : KONCOU=0 25 : * 26 : * traitement des elements deja quadratiques 27 : * 28 : SEGACT IPT8 29 : IPT7=IPT8 30 : NBSOUS=IPT8.LISOUS(/1) 31 : DO 60 ISOUS=1,MAX(1,NBSOUS) 32 : IF (NBSOUS.NE.0) IPT7=IPT8.LISOUS(ISOUS) 33 : SEGACT IPT7 34 : ITY= IPT7.ITYPEL 35 : ISUP=0 36 : IF( KDEGRE(ITY) . NE. 3) GO TO 61 37 : IF( ITY.NE.3) THEN 38 : ISUP=1 38 : CALL ECROBJ('MAILLAGE', IPT7) 38 : CALL CHANLG 38 : CALL LIROBJ('MAILLAGE',IPT7,1,IRETOU) 39 : IF(IERR.NE.0) RETURN 40 : SEGACT IPT7 41 : ENDIF 42 : DO 70 J=1,IPT7.NUM(/2) 43 : I1=IPT7.NUM(1,J) 44 : I3=IPT7.NUM(3,J) 45 : J1=MIN(I1,I3) 46 : J3=MAX(I1,I3) 47 : ITFA=KONPOS(J1) 48 : IF (ITFA.EQ.0) GOTO 90 49 : 85 CONTINUE 50 : ITF=KONSUI(ITFA) 51 : IF (KONFIN(ITFA).EQ.J3) GOTO 70 52 : IF (ITF.EQ.0) GOTO 90 53 : ITFA=ITF 54 : GOTO 85 55 : 90 KONCOU=KONCOU+1 56 : IF (KONCOU.GE.KONFIN(/1)) THEN 57 : IKOUR=KONCOU+500 58 : SEGADJ KONFIN,KONMIL,KONSUI 59 : ENDIF 60 : IF (ITFA.EQ.0) THEN 61 : KONPOS(J1)=KONCOU 62 : ELSE 63 : KONSUI(ITFA)=KONCOU 64 : ENDIF 65 : KONFIN(KONCOU)=J3 66 : KONMIL(KONCOU)=IPT7.NUM(2,J) 67 : 70 CONTINUE 68 : 61 CONTINUE 69 : IF(ISUP.EQ.0) THEN 70 : SEGDES IPT7 71 : ELSE 72 : SEGSUP IPT7 73 : ENDIF 74 : 60 CONTINUE 75 : SEGDES IPT8 76 : * MAINTENANT ON S'ATTAQUE A LA TRANSFORMATION DU MAILLAGE lineaire 77 : IPT7=MELEME 78 : SEGACT MELEME 79 : NBSOU7=LISOUS(/1) 80 : NBSOUS=NBSOU7 81 : NBS = MAX(1,NBSOU7) 82 : SEGINI INOU 83 : NBREF=0 84 : NBELEM=0 85 : NBNN=0 86 : DO 100 ISOUS=1,MAX(1,NBSOU7) 87 : IF (NBSOU7.NE.0) IPT7=LISOUS(ISOUS) 88 : SEGACT IPT7 89 : INOU(ISOUS)=IPT7 90 : NBELEM=IPT7.NUM(/2) 91 : ITYPE=IPT7.ITYPEL+1 92 : IF(IPT7.ITYPEL.EQ.4 . OR. IPT7.ITYPEL.EQ.5. OR . 93 : # IPT7.ITYPEL.EQ.8 . OR. IPT7.ITYPEL.EQ.9. OR. 94 : # IPT7.ITYPEL.EQ.18 . OR. IPT7.ITYPEL.EQ.19) ITYPE=ITYPE+1 95 : NBNN=NBNNE(ITYPE) 96 : NBSOUS=0 97 : NBREF=0 98 : SEGINI IPT6 99 : IPT6.ITYPEL=ITYPE 100 : * IF (NBSOU7.NE.0) IPT1.LISOUS(ISOUS)=IPT6 101 : * CAS DES TETRAEDRES 102 : IF (IPT7.ITYPEL.EQ.23) THEN 103 : INOU(ISOUS)=IPT6 104 : DO 200 J=1,NBELEM 105 : I1=IPT7.NUM(1,J) 106 : I2=IPT7.NUM(2,J) 107 : I3=IPT7.NUM(3,J) 108 : I4=IPT7.NUM(4,J) 108 : CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 109 : IPT6.NUM(1,J)=I1 110 : IPT6.NUM(2,J)=I5 111 : IPT6.NUM(3,J)=I2 111 : CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 112 : IPT6.NUM(4,J)=I5 113 : IPT6.NUM(5,J)=I3 113 : CALL DEMCH1(I3,I1,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 114 : IPT6.NUM(6,J)=I5 114 : CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 115 : IPT6.NUM(7,J)=I5 115 : CALL DEMCH1(I2,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 116 : IPT6.NUM(8,J)=I5 116 : CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 117 : IPT6.NUM(9,J)=I5 118 : IPT6.NUM(10,J)=I4 119 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 120 : 200 CONTINUE 121 : * CAS DES PYRAMIDES 122 : ELSEIF (IPT7.ITYPEL.EQ.25) THEN 123 : INOU(ISOUS)=IPT6 124 : DO 210 J=1,NBELEM 125 : I1=IPT7.NUM(1,J) 126 : I2=IPT7.NUM(2,J) 127 : I3=IPT7.NUM(3,J) 128 : I4=IPT7.NUM(4,J) 129 : I5=IPT7.NUM(5,J) 129 : CALL DEMCH1(I1,I2,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 130 : IPT6.NUM(1,J)=I1 131 : IPT6.NUM(2,J)=I6 132 : IPT6.NUM(3,J)=I2 132 : CALL DEMCH1(I2,I3,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 133 : IPT6.NUM(4,J)=I6 134 : IPT6.NUM(5,J)=I3 134 : CALL DEMCH1(I3,I4,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 135 : IPT6.NUM(6,J)=I6 136 : IPT6.NUM(7,J)=I4 136 : CALL DEMCH1(I4,I1,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 137 : IPT6.NUM(8,J)=I6 137 : CALL DEMCH1(I1,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 138 : IPT6.NUM(9,J)=I6 138 : CALL DEMCH1(I2,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 139 : IPT6.NUM(10,J)=I6 139 : CALL DEMCH1(I3,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 140 : IPT6.NUM(11,J)=I6 140 : CALL DEMCH1(I4,I5,I6,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 141 : IPT6.NUM(12,J)=I6 142 : IPT6.NUM(13,J)=I5 143 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 144 : 210 CONTINUE 145 : * CAS DES PRISMES 146 : ELSEIF (IPT7.ITYPEL.EQ.16) THEN 147 : INOU(ISOUS)=IPT6 148 : DO 220 J=1,NBELEM 149 : I1=IPT7.NUM(1,J) 150 : I2=IPT7.NUM(2,J) 151 : I3=IPT7.NUM(3,J) 152 : I4=IPT7.NUM(4,J) 153 : I5=IPT7.NUM(5,J) 154 : I6=IPT7.NUM(6,J) 154 : CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 155 : IPT6.NUM(1,J)=I1 156 : IPT6.NUM(2,J)=I7 157 : IPT6.NUM(3,J)=I2 157 : CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 158 : IPT6.NUM(4,J)=I7 159 : IPT6.NUM(5,J)=I3 159 : CALL DEMCH1(I3,I1,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 160 : IPT6.NUM(6,J)=I7 160 : CALL DEMCH1(I1,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 161 : IPT6.NUM(7,J)=I7 161 : CALL DEMCH1(I2,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 162 : IPT6.NUM(8,J)=I7 162 : CALL DEMCH1(I3,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 163 : IPT6.NUM(9,J)=I7 163 : CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 164 : IPT6.NUM(10,J)=I4 165 : IPT6.NUM(11,J)=I7 166 : IPT6.NUM(12,J)=I5 166 : CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 167 : IPT6.NUM(13,J)=I7 168 : IPT6.NUM(14,J)=I6 168 : CALL DEMCH1(I6,I4,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 169 : IPT6.NUM(15,J)=I7 170 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 171 : 220 CONTINUE 172 : * CAS DES CUBES 173 : ELSEIF (IPT7.ITYPEL.EQ.14) THEN 174 : INOU(ISOUS)=IPT6 175 : DO 230 J=1,NBELEM 176 : I1=IPT7.NUM(1,J) 177 : I2=IPT7.NUM(2,J) 178 : I3=IPT7.NUM(3,J) 179 : I4=IPT7.NUM(4,J) 180 : I5=IPT7.NUM(5,J) 181 : I6=IPT7.NUM(6,J) 182 : I7=IPT7.NUM(7,J) 183 : I8=IPT7.NUM(8,J) 183 : CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 184 : IPT6.NUM(1,J)=I1 185 : IPT6.NUM(2,J)=I9 186 : IPT6.NUM(3,J)=I2 186 : CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 187 : IPT6.NUM(4,J)=I9 188 : IPT6.NUM(5,J)=I3 188 : CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 189 : IPT6.NUM(6,J)=I9 190 : IPT6.NUM(7,J)=I4 190 : CALL DEMCH1(I4,I1,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 191 : IPT6.NUM(8,J)=I9 191 : CALL DEMCH1(I1,I5,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 192 : IPT6.NUM(9,J)=I9 192 : CALL DEMCH1(I2,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 193 : IPT6.NUM(10,J)=I9 193 : CALL DEMCH1(I3,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 194 : IPT6.NUM(11,J)=I9 194 : CALL DEMCH1(I4,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 195 : IPT6.NUM(12,J)=I9 195 : CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 196 : IPT6.NUM(13,J)=I5 197 : IPT6.NUM(14,J)=I9 198 : IPT6.NUM(15,J)=I6 198 : CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 199 : IPT6.NUM(16,J)=I9 200 : IPT6.NUM(17,J)=I7 200 : CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 201 : IPT6.NUM(18,J)=I9 202 : IPT6.NUM(19,J)=I8 202 : CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 203 : IPT6.NUM(20,J)=I9 204 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 205 : 230 CONTINUE 206 : * CAS DES SEG2 207 : ELSEIF (IPT7.ITYPEL.EQ.2) THEN 208 : INOU(ISOUS)=IPT6 209 : DO 240 J=1,NBELEM 210 : I1=IPT7.NUM(1,J) 211 : I2=IPT7.NUM(2,J) 211 : CALL DEMCH1(I1,I2,I3,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 212 : IPT6.NUM(1,J)=I1 213 : IPT6.NUM(2,J)=I3 214 : IPT6.NUM(3,J)=I2 215 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 216 : 240 CONTINUE 217 : * CAS DES TRI3 ou des tri4 218 : ELSEIF (IPT7.ITYPEL.EQ.4.OR.IPT7.ITYPEL.EQ.5) THEN 219 : INOU(ISOUS)=IPT6 220 : DO 250 J=1,NBELEM 221 : I1=IPT7.NUM(1,J) 222 : I2=IPT7.NUM(2,J) 223 : I3=IPT7.NUM(3,J) 223 : CALL DEMCH1(I1,I2,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 224 : IPT6.NUM(1,J)=I1 225 : IPT6.NUM(2,J)=I4 226 : IPT6.NUM(3,J)=I2 226 : CALL DEMCH1(I2,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 227 : IPT6.NUM(4,J)=I4 228 : IPT6.NUM(5,J)=I3 228 : CALL DEMCH1(I1,I3,I4,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 229 : IPT6.NUM(6,J)=I4 230 : IF(IPT7.ITYPEL.EQ.5)IPT6.NUM(7,J)=IPT7.NUM(4,J) 231 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 232 : 250 CONTINUE 233 : * CAS DES QUA4 ou des QUA5 234 : ELSEIF (IPT7.ITYPEL.EQ.8.OR.IPT7.ITYPEL.EQ.9) THEN 235 : INOU(ISOUS)=IPT6 236 : DO 260 J=1,NBELEM 237 : I1=IPT7.NUM(1,J) 238 : I2=IPT7.NUM(2,J) 239 : I3=IPT7.NUM(3,J) 240 : I4=IPT7.NUM(4,J) 240 : CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 241 : IPT6.NUM(1,J)=I1 242 : IPT6.NUM(2,J)=I5 243 : IPT6.NUM(3,J)=I2 243 : CALL DEMCH1(I2,I3,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 244 : IPT6.NUM(4,J)=I5 245 : IPT6.NUM(5,J)=I3 245 : CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 246 : IPT6.NUM(6,J)=I5 247 : IPT6.NUM(7,J)=I4 247 : CALL DEMCH1(I1,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 248 : IPT6.NUM(8,J)=I5 249 : IF(IPT7.ITYPEL.EQ.9)IPT6.NUM(9,J)=IPT7.NUM(5,J) 250 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 251 : 260 CONTINUE 252 : * CAS des RAC2 253 : ELSEIF (IPT7.ITYPEL.EQ.12) THEN 254 : INOU(ISOUS)=IPT6 255 : DO 270 J=1,NBELEM 256 : I1=IPT7.NUM(1,J) 257 : I2=IPT7.NUM(2,J) 258 : I3=IPT7.NUM(3,J) 259 : I4=IPT7.NUM(4,J) 259 : CALL DEMCH1(I1,I2,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 260 : IPT6.NUM(1,J)=I1 261 : IPT6.NUM(2,J)=I5 262 : IPT6.NUM(3,J)=I2 262 : CALL DEMCH1(I3,I4,I5,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 263 : IPT6.NUM(4,J)=I3 264 : IPT6.NUM(5,J)=I5 265 : IPT6.NUM(5,J)=I4 266 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 267 : 270 CONTINUE 268 : * CAS des lia3 269 : ELSEIF (IPT7.ITYPEL.EQ.18) THEN 270 : INOU(ISOUS)=IPT6 271 : DO 280 J=1,NBELEM 272 : I1=IPT7.NUM(1,J) 273 : I2=IPT7.NUM(2,J) 274 : I3=IPT7.NUM(3,J) 275 : I4=IPT7.NUM(4,J) 276 : I5=IPT7.NUM(5,J) 277 : I6=IPT7.NUM(6,J) 277 : CALL DEMCH1(I1,I2,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 278 : IPT6.NUM(1,J)=I1 279 : IPT6.NUM(2,J)=I7 280 : IPT6.NUM(3,J)=I2 280 : CALL DEMCH1(I2,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 281 : IPT6.NUM(4,J)=I7 282 : IPT6.NUM(5,J)=I3 282 : CALL DEMCH1(I1,I3,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 283 : IPT6.NUM(6,J)=I7 283 : CALL DEMCH1(I4,I5,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 284 : IPT6.NUM(7,J)=I4 285 : IPT6.NUM(8,J)=I7 286 : IPT6.NUM(9,J)=I5 286 : CALL DEMCH1(I5,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 287 : IPT6.NUM(10,J)=I7 288 : IPT6.NUM(11,J)=I5 288 : CALL DEMCH1(I4,I6,I7,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 289 : IPT6.NUM(12,J)=I7 290 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 291 : 280 CONTINUE 292 : * CAS des lia4 293 : ELSEIF (IPT7.ITYPEL.EQ.18) THEN 294 : INOU(ISOUS)=IPT6 295 : DO 290 J=1,NBELEM 296 : I1=IPT7.NUM(1,J) 297 : I2=IPT7.NUM(2,J) 298 : I3=IPT7.NUM(3,J) 299 : I4=IPT7.NUM(4,J) 300 : I5=IPT7.NUM(5,J) 301 : I6=IPT7.NUM(6,J) 302 : I7=IPT7.NUM(7,J) 303 : I8=IPT7.NUM(8,J) 303 : CALL DEMCH1(I1,I2,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 304 : IPT6.NUM(1,J)=I1 305 : IPT6.NUM(2,J)=I9 306 : IPT6.NUM(3,J)=I2 306 : CALL DEMCH1(I2,I3,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 307 : IPT6.NUM(4,J)=I9 308 : IPT6.NUM(5,J)=I3 308 : CALL DEMCH1(I3,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 309 : IPT6.NUM(6,J)=I9 310 : IPT6.NUM(7,J)=I4 310 : CALL DEMCH1(I1,I4,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 311 : IPT6.NUM(8,J)=I9 311 : CALL DEMCH1(I5,I6,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 312 : IPT6.NUM(9,J)=I5 313 : IPT6.NUM(10,J)=I9 314 : IPT6.NUM(11,J)=I6 314 : CALL DEMCH1(I6,I7,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 315 : IPT6.NUM(12,J)=I9 316 : IPT6.NUM(13,J)=I7 316 : CALL DEMCH1(I7,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 317 : IPT6.NUM(14,J)=I9 318 : IPT6.NUM(15,J)=I8 318 : CALL DEMCH1(I5,I8,I9,KONCOU,KONFIN,KONMIL,KONSUI,KONPOS) 319 : IPT6.NUM(16,J)=I9 320 : IPT6.ICOLOR(J)=IPT7.ICOLOR(J) 321 : 290 CONTINUE 322 : ENDIF 323 : SEGDES IPT7 324 : SEGDES IPT6 325 : 100 CONTINUE 326 : SEGSUP KONFIN,KONMIL,KONSUI,KONPOS 327 : * on fusionne les sous parties 328 : SEGDES MELEME 329 : II=INOU(/1) 330 : IRETOU=INOU(1) 331 : IF(II.EQ.1) GO TO 15 332 : DO 16 J=2,II 333 : INN=INOU(J) 334 : ltelq=.false. 334 : CALL FUSE( IRETOU,INN,IPT5,ltelq) 335 : IRETOU=IPT5 336 : 16 CONTINUE 337 : 15 CONTINUE 338 : MELEME=IRETOU 339 : END 340 : 341 : 342 : 343 : 344 : 345 : 346 : 347 :
© Cast3M 2003 - All rights reserved.
Disclaimer