1 : C MENVLP SOURCE MAGN 10/05/18 21:16:26 6675 2 : SUBROUTINE MENVLP(MELEMQ,MENVEL,MCHPOI,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : 6 : -INC CCOPTIO 7 : -INC SMLENTI 8 : -INC CCGEOME 9 : -INC SIZFFB 10 : POINTEUR IZF1.IZFFM,IZH2.IZHR 11 : -INC SMCOORD 12 : -INC SMCHPOI 13 : -INC SMELEME 14 : POINTEUR MENVEL.MELEME,MELEMP.MELEME,MELEM1.MELEME 15 : POINTEUR MELEMQ.MELEME 16 : POINTEUR IPT0.MELEME,IGEOM.MELEME 17 : CHARACTER*8 NOM0,TYPE 18 : 19 : DIMENSION JNF(6,7),KTA(7,3),ITAB(4) 20 : DIMENSION KNPF(6,7),KNF(9) 21 : 22 : DATA KTA/ 23 : C nb de faces par type d'élément 24 : & 2, 3, 4, 6, 5, 4, 5, 25 : C numero type elt pour conectivités 26 : & 3, 7,11,33,34,35,36, 27 : C Idc3 28 : & 0, 2,5 ,9 ,15 ,20,24/ 29 : 30 : 31 : C Numero des pts faces SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19 32 : 33 : DATA JNF/1,3,0,0,0,0, 34 : & 2,4,6,0,0,0, 2,4,6,8,0,0, 35 : & 25,26,21,22,23,24, 19,20,16,17,18,0, 36 : & 12,11,13,14,0,0, 14,15,16,17,18,0/ 37 : 38 : C Nombre de points par face SEG3 TRI7 QUA9 CU27 PR21 TE15 PY19 39 : 40 : DATA KNPF/1,1,0,0,0,0, 41 : & 3,3,3,0,0,0, 3,3,3,3,0,0, 42 : & 9,9,9,9,9,9, 7,7,9,9,9,0, 43 : & 7,7,7,7,0,0, 9,7,7,7,7,0/ 44 : 45 : DATA KNF/1,0,2,0,0,0,3,0,4/ 46 : 47 : 48 : DIMENSION INF(9,29) 49 : C SEG3 50 : DATA INF/ 51 : & 1,0,0,0,0,0,0,0,0, 3,0,0,0,0,0,0,0,0, 52 : C TRI7 53 : & 3,2,1,0,0,0,0,0,0, 5,4,3,0,0,0,0,0,0, 1,6,5,0,0,0,0,0,0, 54 : C QUA9 55 : & 3,2,1,0,0,0,0,0,0, 5,4,3,0,0,0,0,0,0, 7,6,5,0,0,0,0,0,0, 56 : & 1,8,7,0,0,0,0,0,0, 57 : C CU27 58 : & 1,8,7,6,5,4,3,2,25, 13,14,15,16,17,18,19,20,26, 59 : & 1,2,3,10,15,14,13,9,21, 3,4,5,11,17,16,15,10,22, 60 : & 5,6,7,12,19,18,17,11,23, 7,8,1,9,13,20,19,12,24, 61 : C PR21 62 : & 1,6,5,4,3,2,19,0,0, 10,11,12,13,14,15,20,0,0, 63 : & 1,2,3,8 ,12,11,10,7,16, 3,4,5,9 ,14,13,12,8 ,17, 64 : & 5,6,1,7,10,15,14,9 ,18, 65 : C TE15 66 : & 1,2,3,8,10,7,12,0,0, 1,6,5,4,3,2,11,0,0, 3,4,5,9,10,8,13,0,0, 67 : & 1,7,10,9,5,6,14,0,0, 68 : C PY19 69 : & 1,8,7,6,5,4,3,2,14, 1,2,3,10,13,9,15,0,0, 3,4,5,11,13,10,16,0,0, 70 : & 5,6,7,12,13,11,17,0,0, 7,8,1,9,13,12,18,0,0/ 71 : 72 : C write(6,*)'DEBUT MENVLP' 73 : IRET=1 74 : 75 : IAXI=0 76 : IF(IFOMOD.EQ.0)IAXI=2 77 : 78 : JG=XCOOR(/1)/(IDIM+1) 79 : SEGINI MLENTI 80 : 81 : NBFCE=0 82 : 83 : SEGACT MELEMQ 84 : 85 : DO 10 L=1,MAX(1,MELEMQ.LISOUS(/1)) 86 : IPT1=MELEMQ 87 : IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L) 88 : SEGACT IPT1 89 : NP=IPT1.NUM(/1) 90 : NBEL=IPT1.NUM(/2) 91 : 92 : NPFA=0 93 : IF(NP.EQ.3)NPFA=1 94 : IF(NP.EQ.7)NPFA=2 95 : IF(NP.EQ.9)NPFA=3 96 : IF(NP.EQ.27)NPFA=4 97 : IF(NP.EQ.21)NPFA=5 98 : IF(NP.EQ.15)NPFA=6 99 : IF(NP.EQ.19)NPFA=7 100 : 101 : C NBPFA nb de pts face dans un element diff nb de points par face 102 : NBPFA=KTA(NPFA,1) 103 : 104 : DO 1 K=1,NBEL 105 : 106 : DO 1 I=1,NBPFA 107 : J=JNF(I,NPFA) 108 : IFA=IPT1.NUM(J,K) 109 : NBFCE=NBFCE+1 110 : LECT(IFA)=LECT(IFA)+1 111 : 1 CONTINUE 112 : SEGDES IPT1 113 : 10 CONTINUE 114 : SEGDES MELEMQ 115 : 116 : NBFACE =0 117 : 118 : DO 2 K=1,LECT(/1) 119 : IF(LECT(K).NE.1)GO TO 2 120 : NBFACE=NBFACE+1 121 : 2 CONTINUE 122 : 123 : C Tracage orientation des faces 124 : NBSOUS=0 125 : NBREF=0 126 : NBNN=1 127 : NBELEM=NBFACE 128 : SEGINI IGEOM 129 : 130 : NSOUPO=1 131 : NAT=1 132 : NC=IDIM 133 : N=NBFACE 134 : SEGINI MCHPOI,MSOUPO,MPOVAL 135 : JATTRI(1)=2 136 : IFOPOI=IFOMOD 137 : MTYPOI=' ' 138 : MOCHDE=' ' 139 : IPCHP(1)=MSOUPO 140 : IGEOC=IGEOM 141 : IPOVAL=MPOVAL 142 : NOCOMP(1)='UX' 143 : NOCOMP(2)='UY' 144 : IF(IDIM.EQ.3)NOCOMP(3)='UZ' 145 : SEGDES MCHPOI,MSOUPO 146 : 147 : C write(6,*)'NBFACE=',NBFACE,' NBFCE=',NBFCE 148 : NBSOUS=0 149 : NBREF=0 150 : NBNN=1 151 : NBELEM=NBFACE 152 : SEGINI MELEM1 153 : MELEM1.ITYPEL=1 154 : I1=0 155 : DO 3 K=1,LECT(/1) 156 : IF(LECT(K).NE.1)GO TO 3 157 : I1=I1+1 158 : MELEM1.NUM(1,I1)=K 159 : 3 CONTINUE 160 : 161 : SEGSUP MLENTI 161 : CALL KRIPAD(MELEM1,MLENTI) 162 : 163 : NBSOUS=0 164 : NBREF=0 165 : NBNN=1 166 : NBN1=0 167 : NBELEM=NBFACE 168 : SEGINI IPT0 169 : IPT0.ITYPEL=1 170 : 171 : NBNN=3 172 : NBN3=0 173 : NBELEM=NBFACE 174 : SEGINI IPT3 175 : IPT3.ITYPEL=3 176 : 177 : NBNN=7 178 : NBN7=0 179 : NBELEM=NBFACE 180 : SEGINI IPT7 181 : IPT7.ITYPEL=7 182 : 183 : NBNN=9 184 : NBN9=0 185 : NBELEM=NBFACE 186 : SEGINI IPT9 187 : IPT9.ITYPEL=11 188 : 189 : NBN0=0 190 : 191 : SEGACT MELEMQ 192 : 193 : DO 51 L=1,MAX(1,MELEMQ.LISOUS(/1)) 194 : IPT1=MELEMQ 195 : IF(MELEMQ.LISOUS(/1).NE.0)IPT1=MELEMQ.LISOUS(L) 196 : SEGACT IPT1 197 : NP=IPT1.NUM(/1) 198 : NBEL=IPT1.NUM(/2) 199 : NOM0=NOMS(IPT1.ITYPEL)//' ' 199 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 200 : SEGACT IZFFM*MOD 201 : IZHR=KZHR(1) 202 : IZH2=KZHR(2) 203 : IZF1=KTP(1) 204 : SEGACT IZHR*MOD 205 : NES=GR(/1) 206 : NPG=GR(/3) 207 : C write(6,*)' NP,NBEL=',NP,NBEL 208 : NPFA=0 209 : IF(NP.EQ.3)NPFA=1 210 : IF(NP.EQ.7)NPFA=2 211 : IF(NP.EQ.9)NPFA=3 212 : IF(NP.EQ.27)NPFA=4 213 : IF(NP.EQ.21)NPFA=5 214 : IF(NP.EQ.15)NPFA=6 215 : IF(NP.EQ.19)NPFA=7 216 : C NBPFA nb de pts face dans un element diff nb de points par face 217 : NBPFA=KTA(NPFA,1) 218 : DO 52 K=1,NBEL 219 : DO 53 I=1,NBPFA 220 : IFA=IPT1.NUM(JNF(I,NPFA),K) 221 : IF(LECT(IFA).EQ.0)GO TO 53 222 : NBPPFA=KNPF(I,NPFA) 223 : IP=KNF(NBPPFA) 224 : C write(6,*)'IPT1=',IPT1,(IPT1.NUM(ii,K),ii=1,np),' IFA=',ifa 225 : 226 : NBN0=NBN0+1 227 : IGEOM.NUM(1,NBN0)=IFA 228 : GO TO(501,503,507,509),IP 229 : C POI1 230 : 501 CONTINUE 231 : NBN1=NBN1+1 232 : IDC3=KTA(NPFA,3) 233 : DO 511 J=1,NBPPFA 234 : J1=INF(J,I+IDC3) 235 : IPT0.NUM(J,NBN1)=IPT1.NUM(J1,K) 236 : 511 CONTINUE 237 : GO TO 53 238 : 239 : C SEG3 240 : 503 CONTINUE 241 : NBN3=NBN3+1 242 : IDC3=KTA(NPFA,3) 243 : DO 543 II=1,NP 244 : J1 = IPT1.NUM(II,K) 245 : DO 553 N=1,IDIM 246 : XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N) 247 : 553 CONTINUE 248 : 543 CONTINUE 248 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG, 249 : & NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 250 : 251 : VPOCHA(NBN0,1)=SGN 252 : 253 : IF(SGN.EQ.1.D0)THEN 254 : JDEB=1 255 : JFIN=NBPPFA 256 : IPAS=1 257 : ELSE 258 : JDEB=NBPPFA 259 : JFIN=1 260 : IPAS=-1 261 : ENDIF 262 : J0=0 263 : DO 513 J=JDEB,JFIN,IPAS 264 : J0=J0+1 265 : J1=INF(J,I+IDC3) 266 : IPT3.NUM(J0,NBN3)=IPT1.NUM(J1,K) 267 : 513 CONTINUE 268 : GO TO 53 269 : 270 : C TRI7 271 : 507 CONTINUE 272 : NBN7=NBN7+1 273 : IDC3=KTA(NPFA,3) 274 : DO 547 II=1,NP 275 : J1 = IPT1.NUM(II,K) 276 : DO 557 N=1,IDIM 277 : XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N) 278 : 557 CONTINUE 279 : 547 CONTINUE 279 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG, 280 : & NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 281 : 282 : VPOCHA(NBN0,1)=SGN 283 : 284 : IF(SGN.EQ.1.D0)THEN 285 : JDEB=2 286 : JFIN=NBPPFA-1 287 : IPAS=1 288 : ELSE 289 : JDEB=NBPPFA-1 290 : JFIN=2 291 : IPAS=-1 292 : ENDIF 293 : J0=1 294 : DO 517 J=JDEB,JFIN,IPAS 295 : J0=J0+1 296 : J1=INF(J,I+IDC3) 297 : IPT7.NUM(J0,NBN7)=IPT1.NUM(J1,K) 298 : 517 CONTINUE 299 : J1=INF(1,I+IDC3) 300 : IPT7.NUM(1,NBN7)=IPT1.NUM(J1,K) 301 : J1=INF(7,I+IDC3) 302 : IPT7.NUM(7,NBN7)=IPT1.NUM(J1,K) 303 : C write(6,*)(IPT7.NUM(J,NBN7),j=1,NBPPFA) 304 : GO TO 53 305 : 306 : C QUA9 307 : 509 CONTINUE 308 : NBN9=NBN9+1 309 : IDC3=KTA(NPFA,3) 310 : DO 549 II=1,NP 311 : J1 = IPT1.NUM(II,K) 312 : DO 559 N=1,IDIM 313 : XYZ(N,II) = XCOOR((J1-1)*(IDIM+1)+N) 314 : 559 CONTINUE 315 : 549 CONTINUE 315 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG, 316 : & NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN) 317 : 318 : VPOCHA(NBN0,1)=SGN 319 : 320 : IF(SGN.EQ.1.D0)THEN 321 : JDEB=2 322 : JFIN=NBPPFA-1 323 : IPAS=1 324 : ELSE 325 : JDEB=NBPPFA-1 326 : JFIN=2 327 : IPAS=-1 328 : ENDIF 329 : J0=1 330 : DO 519 J=JDEB,JFIN,IPAS 331 : J0=J0+1 332 : J1=INF(J,I+IDC3) 333 : IPT9.NUM(J0,NBN9)=IPT1.NUM(J1,K) 334 : 519 CONTINUE 335 : J1=INF(1,I+IDC3) 336 : IPT9.NUM(1,NBN9)=IPT1.NUM(J1,K) 337 : J1=INF(9,I+IDC3) 338 : IPT9.NUM(9,NBN9)=IPT1.NUM(J1,K) 339 : GO TO 53 340 : 341 : 53 CONTINUE 342 : 52 CONTINUE 343 : SEGDES IPT1 344 : SEGSUP IZFFM,IZHR,IZH2,IZF1 345 : 51 CONTINUE 346 : SEGDES MELEMQ 347 : 348 : NBS=0 348 : CALL INITI(ITAB,4,0) 349 : 350 : IF(NBN1.NE.0)THEN 351 : NBS=NBS+1 352 : NBNN=1 353 : NBELEM=NBN1 354 : SEGADJ IPT0 355 : ITAB(NBS)=IPT0 356 : MENVEL=IPT0 357 : ENDIF 358 : 359 : IF(NBN3.NE.0)THEN 360 : NBS=NBS+1 361 : NBNN=3 362 : NBELEM=NBN3 363 : SEGADJ IPT3 364 : ITAB(NBS)=IPT3 365 : MENVEL=IPT3 366 : ENDIF 367 : 368 : IF(NBN7.NE.0)THEN 369 : NBS=NBS+1 370 : NBNN=7 371 : NBELEM=NBN7 372 : SEGADJ IPT7 373 : ITAB(NBS)=IPT7 374 : MENVEL=IPT7 375 : ENDIF 376 : 377 : IF(NBN9.NE.0)THEN 378 : NBS=NBS+1 379 : NBNN=9 380 : NBELEM=NBN9 381 : SEGADJ IPT9 382 : ITAB(NBS)=IPT9 383 : MENVEL=IPT9 384 : ENDIF 385 : 386 : IF(NBS.NE.1)THEN 387 : NBSOUS=NBS 388 : NBREF=0 389 : NBNN=0 390 : NBELEM=0 391 : SEGINI MENVEL 392 : DO 60 L=1,NBS 393 : MENVEL.LISOUS(L)=ITAB(L) 394 : 60 CONTINUE 395 : ENDIF 396 : SEGSUP MLENTI,MELEM1 397 : 398 : C Creation du Chamelem d'orientation 398 : CALL KRIPAD(IGEOM,MLENTI) 399 : SEGACT MENVEL 400 : 401 : DO 11 L=1,MAX(1,MENVEL.LISOUS(/1)) 402 : IPT1=MENVEL 403 : IF(MENVEL.LISOUS(/1).NE.0)IPT1=MENVEL.LISOUS(L) 404 : SEGACT IPT1 405 : NP=IPT1.NUM(/1) 406 : NBEL=IPT1.NUM(/2) 407 : 408 : NOM0=NOMS(IPT1.ITYPEL)//' ' 408 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 409 : SEGACT IZFFM*MOD 410 : IZHR=KZHR(1) 411 : IZH2=KZHR(2) 412 : IZF1=KTP(1) 413 : SEGACT IZHR*MOD,IZF1*MOD 414 : NES=GR(/1) 415 : NPG=GR(/3) 416 : 417 : IFA=NP 418 : IF(NP.EQ.3)IFA=2 419 : 420 : DO 23 K=1,NBEL 421 : I1=LECT(IPT1.NUM(IFA,K)) 422 : IF(I1.EQ.0)GO TO 23 423 : SJ=VPOCHA(I1,1) 424 : 425 : DO 30 I=1,NP 426 : J1 = IPT1.NUM(I,K) 427 : DO 31 N=1,IDIM 428 : XYZ(N,I) = XCOOR((J1-1)*(IDIM+1)+N) 429 : 31 CONTINUE 430 : 30 CONTINUE 430 : CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG, 431 : & NES,IDIM,NP,NPG,IAXI,AIRE,AJ,ASGN) 432 : 433 : DO 33 N=1,IDIM 434 : C VPOCHA(I1,N)=AJ(N,IDIM,1)*SJ 435 : VPOCHA(I1,N)=AJ(N,IDIM,1) 436 : 33 CONTINUE 437 : 438 : 23 CONTINUE 439 : 440 : 21 CONTINUE 441 : SEGDES IPT1 442 : SEGSUP IZFFM,IZHR,IZH2,IZF1 443 : 11 CONTINUE 444 : SEGSUP MLENTI 445 : SEGDES IGEOM,MPOVAL,MENVEL 446 : C write(6,*)'FIN MENVLP' 447 : 448 : RETURN 449 : 1001 FORMAT(20(1X,I5)) 450 : 1002 FORMAT(10(1X,1PE11.4)) 451 : END 452 : 453 : 454 : 455 : 456 : 457 :
© Cast3M 2003 - All rights reserved.
Disclaimer