1 : C CCUBIC SOURCE CHAT 05/01/12 21:51:11 5004 2 : SUBROUTINE CCUBIC 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C************************************************************************ 6 : C Ce sp transforme des elemnts quadratique d'un type pris 7 : C dans la liste ci-dessous 8 : C SEG3 TRI6 QUA8 CU20 PR15 TE10 PY13 9 : C 3 6 10 15 17 24 26 10 : C 11 : C en les éléments correspondant MACRO (iso p2 ou q2) de la liste 12 : C ci-dessous 13 : C 14 : C SEG3 TRI6 QUA9 CU27 PR18 TE15 PY14 15 : C 3 6 11 33 ?? 35 ?? 16 : C************************************************************************ 17 : -INC SMELEME 18 : -INC SMCOORD 19 : -INC CCOPTIO 20 : -INC SMLENTI 21 : SEGMENT TRAV 22 : INTEGER IFAC4(4,NBFTM) 23 : ENDSEGMENT 24 : SEGMENT TRAV1 25 : INTEGER NUMF4(9,NBFTM) 26 : ENDSEGMENT 27 : SEGMENT SITAB 28 : INTEGER ITAB(NPA,NBATM) 29 : ENDSEGMENT 30 : SEGMENT SITAC 31 : INTEGER ITAC(NBMAX,NNMAX) 32 : ENDSEGMENT 33 : SEGMENT SITAF 34 : INTEGER ITAF(NBFAX,MMMAX) 35 : ENDSEGMENT 36 : SEGMENT TRAV2 37 : INTEGER NUF(6,NBELT) 38 : ENDSEGMENT 39 : SEGMENT CARA 40 : INTEGER KM(6,NBSOU1) 41 : ENDSEGMENT 42 : 43 : 44 : DIMENSION IAR(3,35),IFR(4,20) 45 : DATA IAR /1,2,3,3,4,5,5,6,7,7,8,1, 46 : & 1,9,13,3,10,15,5,11,17,7,12,19, 47 : & 13,14,15,15,16,17,17,18,19,19,20,13, 48 : & 1,2,3,3,4,5,5,6,1,1,7,10,3,8,12,5,9,14, 49 : & 10,11,12,12,13,14,14,15,10, 50 : & 1,2,3,3,4,5,5,6,1,1,7,10,3,8,10,5,9,10, 51 : & 1,2,3,3,4,5,5,6,7,7,8,1,1,9,13,3,10,13, 52 : & 5,11,13,7,12,13/ 53 : 54 : DATA IFR /1,6,9,5, 2,7,10,6, 3,8,11,7, 4,5,12,8, 55 : & 1,2,3,4, 9,10,11,12, 56 : & 1,5,7,4, 2,6,8,5, 3,4,9,6, 1,2,3,0, 7,8,9,0, 57 : & 1,2,3,0, 1,5,4,0, 2,6,5,0, 3,6,4,0, 58 : & 1,2,3,4, 1,6,5,0, 2,7,6,0, 3,8,7,0, 4,5,8,0/ 59 : 60 : C Nb de pts par face par type elt 61 : DIMENSION KNPF(6,7) 62 : DATA KNPF/1,1,0,0,0,0, 63 : & 3,3,3,0,0,0, 64 : & 3,3,3,3,0,0, 65 : & 8,8,8,8,8,8, 66 : & 8,8,8,6,6,0, 67 : & 6,6,6,6,0,0, 68 : & 8,6,6,6,6,0/ 69 : 70 : C Nb d'arretes par face par type elt 71 : DIMENSION KNAF(6,7) 72 : DATA KNAF/0,0,0,0,0,0, 73 : & 0,0,0,0,0,0, 74 : & 0,0,0,0,0,0, 75 : & 4,4,4,4,4,4, 76 : & 4,4,4,3,3,0, 77 : & 3,3,3,3,0,0, 78 : & 4,3,3,3,3,0/ 79 : 80 : C? DIMENSION I12(35),J12(11) 81 : C? DATA I12 /1,2,3,4,5,6,7,8,10,12,14,16,19,20,21,22,23,24,25,26, 82 : C? & 1,2,3,4,5,6,8,10,12,15,16,17,18,19,20/ 83 : C? DATA J12 /11,13,15,17,9,27, 84 : C? & 9 ,11,13,7 ,21/ 85 : 86 : DIMENSION INF(8,20) 87 : C CU20 88 : DATA INF/1,2,3,10,15,14,13,9, 3,4,5,11,17,16,15,10, 89 : & 5,6,7,12,19,18,17,11, 7,8,1,9,13,20,19,12, 90 : & 1,2,3,4,5,6,7,8, 13,14,15,16,17,18,19,20, 91 : C PR15 92 : & 1,2,3,8 ,12,11,10,7, 3,4,5,9 ,14,13,12,8 , 93 : & 5,6,1,7,10,15,14,9 , 1,2,3,4,5,6,0,0, 94 : & 10,11,12,13,14,15,0,0, 95 : C TE15 96 : & 1,2,3,4,5,6,0,0, 1,2,3,8,10,7,0,0, 3,4,5,9,10,8,0,0, 97 : & 1,6,5,9,10,7,0,0, 98 : C PY15 99 : & 1,2,3,4,5,6,7,8, 1,2,3,10,13,9,0,0, 3,4,5,11,13,10,0,0, 100 : & 5,6,7,12,13,11,0,0, 7,8,1,9,13,12,0,0/ 101 : 102 : 103 : 104 : 105 : 106 : DIMENSION NUA(12),NUMA(4),XA(3,21),KTA(7,9) 107 : DATA KTA/3,6,10,15,17,24,26, 108 : & 3,6,11,33,00,35,00, 109 : C nb de faces 110 : & 2,3,4 ,6 ,5 ,4 ,5 , 111 : C nb d'arretes 112 : & 0,3,4 ,12,9 ,6 ,8, 113 : C Idec 114 : & 0,0,0 ,0 ,12,21,27, 115 : C Idc3 116 : & 0,0,0 ,0 ,6 ,11,15, 117 : C Nbnn 118 : & 3,6,9 ,27,18,15,14, 119 : C NP 120 : & 3,6,8 ,20,15,10,13, 121 : C IDF 122 : & 0,0,0 ,0 ,6 ,11,15/ 123 : 124 : C?Numero pt centre N18 125 : C? & 0,0,0 ,18,14,14,18/ 126 : C?Idc2 127 : C? & 0,0,0 ,0 ,20,35,45, 128 : 129 : C SEG3 TRI6 QUA8 CU20 PR15 TE10 PY13 130 : C 3 6 10 15 17 24 26 131 : C SEG3 TRI6 QUA9 CU27 PR18 TE15 PY14 132 : C 3 6 11 33 ?? 35 ?? 133 : 134 : 135 : 136 : C************************************************************* 137 : 137 : CALL LIROBJ('MAILLAGE',MELEME,1,IRET) 138 : IF(IRET.EQ.0)RETURN 139 : 140 : SEGACT MELEME 141 : NBSOU1=LISOUS(/1) 142 : IF(NBSOU1.EQ.0)NBSOU1=1 143 : 144 : SEGINI CARA 145 : 146 : NBELT=0 147 : DO 11 L=1,NBSOU1 148 : IPT1=MELEME 149 : IF(NBSOU1.NE.1)IPT1=LISOUS(L) 150 : SEGACT IPT1 151 : ITYP=IPT1.ITYPEL 152 : IK=0 153 : DO 111 I=1,7 154 : IF(ITYP.EQ.KTA(I,1))IK=I 155 : 111 CONTINUE 156 : 157 : IF(IK.EQ.0)THEN 157 : CALL ERREUR(29) 158 : RETURN 159 : ENDIF 160 : 161 : 162 : NP =IPT1.NUM(/1) 163 : NBELEM=IPT1.NUM(/2) 164 : IF(IK.EQ.3.OR.IK.EQ.4)THEN 165 : NBELT=NBELT+NBELEM 166 : ENDIF 167 : KM(1,L)=NBELEM 168 : KM(2,L)=IPT1 169 : KM(3,L)=IK 170 : C nb d'aretes par element 171 : KM(4,L)=KTA(IK,4) 172 : C nb de faces 173 : KM(5,L)=KTA(IK,3) 174 : SEGDES IPT1 175 : 11 CONTINUE 176 : 177 : NBPT=XCOOR(/1)/(IDIM+1) 178 : JG=NBPT 179 : SEGINI MLENTI,MLENT1 180 : 181 : NPA=3 182 : NBATM=5*NBELT+500 183 : SEGINI SITAB 184 : 185 : NBMAX=4+1 186 : NNMAX=3*NBELT+300 187 : NBFAX=4+1 188 : MMMAX=3*NBELT+300 189 : SEGINI SITAF,SITAC 190 : 191 : NBFTM=5*NBELT+500 192 : SEGINI TRAV,TRAV1,TRAV2 193 : 194 : SEGACT MELEME 195 : 196 : NBFT4=0 197 : NBAT=0 198 : NN=0 199 : MM=0 200 : 201 : NK=0 202 : DO 1 L=1,NBSOU1 203 : IK=KM(3,L) 204 : 205 : IPT1=MELEME 206 : IF(NBSOU1.NE.1)IPT1=LISOUS(L) 207 : SEGACT IPT1 208 : NBELEM=IPT1.NUM(/2) 209 : NP =IPT1.NUM(/1) 210 : C write(6,*)' ITYP,NBELEM=',ITYP,NBELEM 211 : 212 : IF(IK.EQ.1)GO TO 1 213 : IF(IK.EQ.2.OR.IK.EQ.3)THEN 214 : NK=NK+NBELEM 215 : GO TO 1 216 : ENDIF 217 : 218 : IDEC=KTA(IK,5) 219 : IDC3=KTA(IK,6) 220 : IDF =KTA(IK,9) 221 : NBA=KTA(IK,4) 222 : NBF=KTA(IK,3) 223 : C write(6,*)' NBA,NBF,NPF=',NBA,NBF 224 : 225 : DO 2 K=1,NBELEM 226 : NK=NK+1 227 : 228 : DO 5 NA=1,NBA 229 : N1=IPT1.NUM(IAR(1,NA+IDEC),K) 230 : N2=IPT1.NUM(IAR(3,NA+IDEC),K) 231 : IF(N1.GT.N2)THEN 232 : NM=N2 233 : N2=N1 234 : N1=NM 235 : ENDIF 236 : NM=IPT1.NUM(IAR(2,NA+IDEC),K) 237 : 238 : IF(LECT(N1).EQ.0)THEN 239 : C le sommet n'a pas encore été touché 240 : NBAT=NBAT+1 241 : IF(NBAT.GT.NBATM)THEN 242 : write(6,*)' Taille ITAB 2ème dime insuffisante NBATM=',NBATM 243 : NBATM=NBATM+NBELEM 244 : C write(6,*)' NBATM=',nbatm,' NPA=',npa,nbat 245 : SEGADJ SITAB 246 : ENDIF 247 : 248 : NN=NN+1 249 : 250 : IF(NN.GT.NNMAX)THEN 251 : write(6,*)' Taille ITAC 2eme dime insuffisante NN=',NN 252 : NNMAX=NNMAX+NBELEM 253 : SEGADJ SITAC 254 : ENDIF 255 : 256 : LECT(N1)=NN 257 : ITAC(1,NN)=1 258 : ITAC(1+1,NN)=NBAT 259 : C write(6,*)' NBAT=',nbat,' nn=',nn,' NB=',ITAC(1,NN),nbat 260 : NUA(NA)=NBAT 261 : ITAB(1,NBAT)=N1 262 : ITAB(2,NBAT)=NM 263 : ITAB(3,NBAT)=N2 264 : GO TO 5 265 : ENDIF 266 : 267 : C On cherche si l'arrete existe deja dans la table ITAC 268 : NN1=LECT(N1) 269 : NB=ITAC(1,NN1) 270 : DO 31 II=1,NB 271 : I=ITAC(II+1,NN1) 272 : IF(N2.EQ.ITAB(3,I).AND.NM.EQ.ITAB(2,I))THEN 273 : NUA(NA)=I 274 : GO TO 5 275 : ENDIF 276 : 31 CONTINUE 277 : 278 : IF(NB.LT.(NBMAX-1))THEN 279 : C l'arrete n existe pas dans la table ITAC qui n'est pas pleine 280 : C On peut donc considerer que l'arrete est nouvelle 281 : NBAT=NBAT+1 282 : ITAC(1,NN1)=NB+1 283 : ITAC(NB+2,NN1)=NBAT 284 : C write(6,*)' NBAT=',nbat,' nn1=',nn1,' NB=',ITAC(1,NN1),nbat 285 : NUA(NA)=NBAT 286 : ITAB(1,NBAT)=N1 287 : ITAB(2,NBAT)=NM 288 : ITAB(3,NBAT)=N2 289 : GO TO 5 290 : ENDIF 291 : 292 : write(6,*)' Taille ITAC 1ere dime insuffisante NB=',NB 293 : NBMAX=NBMAX+2 294 : SEGADJ SITAC 295 : C On fait une recherche parmis toutes les arretes existantes 296 : 297 : DO 3 I=1,NBAT 298 : IF(N2.EQ.ITAB(3,I).AND.NM.EQ.ITAB(2,I))THEN 299 : NUA(NA)=I 300 : GO TO 5 301 : ENDIF 302 : 3 CONTINUE 303 : 304 : NBAT=NBAT+1 305 : ITAC(1,NN1)=NB+1 306 : ITAC(NB+2,NN1)=NBAT 307 : NUA(NA)=NBAT 308 : ITAB(1,NBAT)=N1 309 : ITAB(2,NBAT)=NM 310 : ITAB(3,NBAT)=N2 311 : 312 : 5 CONTINUE 313 : 314 : DO 6 NF=1,NBF 315 : C nb de pts par faces 316 : NPF=KNPF(NF,IK) 317 : IF(NPF.NE.8)GO TO 6 318 : C nb d'arretes par faces 319 : NAF=KNAF(NF,IK) 320 : 321 : DO 61 NFA=1,NAF 322 : NUMA(NFA)=NUA(IFR(NFA,NF+IDF)) 323 : 61 CONTINUE 324 : 324 : CALL ORDOTA(NUMA,NAF) 325 : IF(MLENT1.LECT(NUMA(1)).EQ.0)THEN 326 : C l'arrete n'a pas encore été touché 327 : NBFT4=NBFT4+1 328 : 329 : IF(NBFT4.GT.NBFTM)THEN 330 : write(6,*)' Taille TRAV NBFT4 insuffisante NBFT4=',NBFT4 331 : NBFTM=NBFTM+NBELEM 332 : SEGADJ TRAV,TRAV1 333 : ENDIF 334 : 335 : NUMF4(9,NBFT4)=NPF 336 : DO 621 I=1,NPF 337 : NUMF4(I,NBFT4)=IPT1.NUM(INF(I,NF+IDC3),K) 338 : 621 CONTINUE 339 : MM=MM+1 340 : 341 : IF(MM.GT.MMMAX)THEN 342 : write(6,*)' Taille ITAF 2eme dime insuffisante MM=',MM 343 : MMMAX=MMMAX+NBELEM 344 : SEGADJ SITAF 345 : ENDIF 346 : 347 : MLENT1.LECT(NUMA(1))=MM 348 : ITAF(1,MM)=1 349 : ITAF(1+1,MM)=NBFT4 350 : C write(6,*)' NBFT4=',nbft4,' mm=',mm,' NB=',ITAF(1,mm) 351 : NUF(NF,NK)=NBFT4 351 : CALL RSETI(IFAC4(1,NBFT4),NUMA,NAF) 352 : GO TO 6 353 : ENDIF 354 : 355 : C On cherche si la face existe déja dans la table ITAF 356 : MM1=MLENT1.LECT(NUMA(1)) 357 : NB=ITAF(1,MM1) 358 : DO 631 II=1,NB 359 : I=ITAF(II+1,MM1) 360 : IF( NUMA(2).EQ.IFAC4(2,I).AND.NUMA(3).EQ.IFAC4(3,I) 361 : & .AND.NUMA(1).EQ.IFAC4(1,I))THEN 362 : NUF(NF,NK)=I 363 : GO TO 6 364 : ENDIF 365 : 631 CONTINUE 366 : 367 : IF(NB.LT.(NBFAX-1))THEN 368 : C la face n'existe pas dans la table ITAF qui n'est pas pleine 369 : C On peut donc considerer que la face est nouvelle 370 : NBFT4=NBFT4+1 371 : 372 : IF(NBFT4.GT.NBFTM)THEN 373 : write(6,*)' Taille TRAV NBFT4 insuffisante NBFT4=',NBFT4 374 : NBFTM=NBFTM+NBELEM 375 : write(6,*)' NBFTM=',NBFTM,NBELEM 376 : SEGADJ TRAV,TRAV1 377 : ENDIF 378 : 379 : NUMF4(9,NBFT4)=NPF 380 : DO 622 I=1,NPF 381 : NUMF4(I,NBFT4)=IPT1.NUM(INF(I,NF+IDC3),K) 382 : 622 CONTINUE 383 : ITAF(1,MM1)=NB+1 384 : ITAF(NB+2,MM1)=NBFT4 385 : C write(6,*)' NBFT4=',NBFT4,' mm1=',mm1,' NB=',ITAF(1,mm1) 386 : NUF(NF,NK)=NBFT4 386 : CALL RSETI(IFAC4(1,NBFT4),NUMA,NAF) 387 : GO TO 6 388 : ENDIF 389 : 390 : write(6,*)' Taille ITAF 1ere dime insuffisante NB=',NB 391 : NBFAX=NBFAX+2 392 : SEGADJ SITAF 393 : C On fait une recherche parmis toutes les faces existantes 394 : 395 : 396 : IF(NAF.EQ.4)THEN 397 : DO 7 I=1,NBFT4 398 : IF( NUMA(2).EQ.IFAC4(2,I).AND.NUMA(3).EQ.IFAC4(3,I) 399 : & .AND.NUMA(1).EQ.IFAC4(1,I))THEN 400 : NUF(NF,NK)=I 401 : GO TO 6 402 : ENDIF 403 : 7 CONTINUE 404 : ELSEIF(NAF.EQ.3)THEN 405 : DO 71 I=1,NBFT4 406 : IF( NUMA(2).EQ.IFAC4(2,I).AND.NUMA(3).EQ.IFAC4(3,I))THEN 407 : NUF(NF,NK)=I 408 : GO TO 6 409 : ENDIF 410 : 71 CONTINUE 411 : ENDIF 412 : 413 : 414 : 64 CONTINUE 415 : NBFT4=NBFT4+1 416 : 417 : IF(NBFT4.GT.NBFTM)THEN 418 : write(6,*)' Taille TRAV NBFT4 insuffisante NBFT4=',NBFT4 419 : NBFTM=NBFTM+NBELEM 420 : SEGADJ TRAV,TRAV1 421 : ENDIF 422 : 423 : ITAF(1,MM1)=NB+1 424 : ITAF(NB+2,MM1)=NBFT4 425 : NUMF4(9,NBFT4)=NPF 426 : DO 623 I=1,NPF 427 : NUMF4(I,NBFT4)=IPT1.NUM(INF(I,NF+IDC3),K) 428 : 623 CONTINUE 429 : NUF(NF,NK)=NBFT4 429 : CALL RSETI(IFAC4(1,NBFT4),NUMA,NAF) 430 : 431 : 6 CONTINUE 432 : 2 CONTINUE 433 : 1 CONTINUE 434 : 435 : C********************************************************** 436 : 437 : SEGSUP SITAB,SITAC,SITAF,MLENTI,MLENT1,TRAV 438 : 439 : C********************************************************** 440 : 441 : SEGACT MELEME 442 : 443 : NK=0 444 : DO 80 L=1,NBSOU1 445 : IK=KM(3,L) 446 : NBF=KTA(IK,3) 447 : IF(IK.EQ.1)GO TO 80 448 : 449 : IPT1=MELEME 450 : IF(NBSOU1.NE.1)IPT1=LISOUS(L) 451 : SEGACT IPT1 452 : 453 : NBELEM=KM(1,L) 454 : NBNN =KTA(IK,7) 455 : NP =KTA(IK,8) 456 : 457 : NBSOUS=0 458 : NBREF=0 459 : SEGINI IPT2 460 : KM(2,L)=IPT2 461 : IPT2.ITYPEL=KTA(IK,2) 462 : 463 : IF(IK.GE.4)THEN 464 : C CU27 & PR21 465 : IDC3=KTA(IK,6) 466 : 467 : DO 83 K=1,NBELEM 468 : NK=NK+1 469 : DO 8 I=1,NP 470 : IPT2.NUM(I,K)=IPT1.NUM(I,K) 471 : 8 CONTINUE 472 : DO 81 I=1,NBF 473 : IPT2.NUM(I+NP,K)=NBPT+NBELT+NUF(I,NK) 474 : 81 CONTINUE 475 : IPT2.NUM(NBNN,K)=NBPT+NK 476 : 83 CONTINUE 477 : 478 : ELSEIF(IK.EQ.2.OR.IK.EQ.3)THEN 479 : IDC=7 480 : IF(IK.EQ.3)IDC=9 481 : NP=NBNN-1 482 : DO 84 K=1,NBELEM 483 : NK=NK+1 484 : DO 88 I=1,NP 485 : IPT2.NUM(I,K)=IPT1.NUM(I,K) 486 : 88 CONTINUE 487 : IPT2.NUM(IDC,K)=NBPT+NK 488 : 84 CONTINUE 489 : 490 : ENDIF 491 : 492 : SEGDES IPT1,IPT2 493 : 80 CONTINUE 494 : 495 : C write(6,*)' NUF ' 496 : C DO 783 K=1,NBELT 497 : C write(6,1011)K,(NUF(i,k),i=1,6) 498 : C783 continue 499 : 500 : C do 784 k=1,nbft4 501 : C write(6,1011)K,(NUMF4(i,k),i=1,8) 502 : C784 continue 503 : 504 : C write(6,*)' NBPT=',nbpt 505 : C write(6,*)' NBAT=',nbat 506 : C write(6,*)' NBELT=',NBELT,' NBFT4=',nbft4 507 : 508 : NBPTS=NBPT+NBELT+NBFT4 509 : IF(NBPTS.GT.NBPT)SEGADJ MCOORD 510 : 511 : C************** On calcule les coordonnées des points *********** 512 : 513 : 514 : 515 : IF(NBFT4.NE.0)THEN 516 : 517 : DO 23 J=1,NBFT4 518 : 519 : NPF=NUMF4(9,J) 520 : DO 21 I=1,NPF 521 : N1=NUMF4(I,J) 522 : DO 21 M=1,IDIM 523 : XA(M,I)=XCOOR((N1-1)*(IDIM+1) +M) 524 : 21 CONTINUE 525 : 525 : CALL FFFACE(XA,NPF) 526 : 527 : N9=NBPT+NBELT+J 528 : DO 22 M=1,IDIM 529 : XCOOR((N9-1)*(IDIM+1) +M)=XA(M,NPF+1) 530 : 22 CONTINUE 531 : 23 CONTINUE 532 : ENDIF 533 : 534 : 535 : C write(6,*)' On calcule les coordonnées du pt centre ',NBELT 536 : IF(NBELT.NE.0)THEN 537 : SEGACT MELEME 538 : NK=0 539 : DO 90 L=1,NBSOU1 540 : 541 : IK=KM(3,L) 542 : IF(IK.EQ.1)GO TO 90 543 : IPT1=MELEME 544 : IF(NBSOU1.NE.1)IPT1=LISOUS(L) 545 : SEGACT IPT1 546 : 547 : NBELEM=KM(1,L) 548 : NBNN =KTA(IK,7) 549 : NP =KTA(IK,8) 550 : 551 : IPT2=KM(2,L) 552 : 553 : DO 24 K=1,NBELEM 554 : NK=NK+1 554 : CALL INITD(XA(1,21),IDIM,0.D0) 555 : DO 25 I=1,NP 556 : N1=IPT1.NUM(I,K) 557 : DO 25 M=1,IDIM 558 : XA(M,I)=XCOOR((N1-1)*(IDIM+1) +M) 559 : XA(M,21)=XA(M,21)+XA(M,I) 560 : 25 CONTINUE 561 : 562 : N18=NBPT+NK 563 : C write(6,*)' *** NK=',nk,NBELT,L 564 : DO 26 M=1,IDIM 565 : XCOOR((N18-1)*(IDIM+1) +M)=XA(M,21)/FLOAT(NP) 566 : 26 CONTINUE 567 : 24 CONTINUE 568 : 569 : 90 CONTINUE 570 : 571 : ENDIF 572 : 573 : 574 : C write(6,*)' NBPT=',nbpt 575 : C write(6,*)' NBAT=',nbat 576 : C do 116 l=1,nbat 577 : C write(6,1011)L,(itab(i,l),i=1,3) 578 : C116 continue 579 : 580 : C write(6,*)' LECT ' 581 : C write(6,1001)(lect(ii),ii=1,nbpt) 582 : 583 : C write(6,*)' ITAC NN=',NN 584 : C do 118 l=1,NN 585 : nb=itac(1,l) 586 : C write(6,1011)L,itac(1,l),(itac(i+1,l),i=1,nb) 587 : C118 continue 588 : 589 : C write(6,*)' NBFT4=',nbft4 590 : 591 : C do 117 l=1,nbft4 592 : C write(6,1011)L,(ifac4(i,l),i=1,4) 593 : C117 continue 594 : 595 : C write(6,*)' MLENT1.LECT ' 596 : C write(6,1001)(mlent1.lect(ii),ii=1,nbpt) 597 : 598 : C write(6,*)' ITAF MM=',MM 599 : C do 119 l=1,MM 600 : C nb=itaf(1,l) 601 : C write(6,1011)L,itaf(1,l),(itaf(i+1,l),i=1,nb) 602 : C119 continue 603 : 604 : SEGSUP TRAV1 605 : IF(NBSOU1.EQ.1)THEN 606 : IPT3=KM(2,1) 607 : ELSE 608 : NBSOUS=NBSOU1 609 : NBELEM=0 610 : NBNN=0 611 : NBREF=0 612 : SEGINI IPT3 613 : DO 785 L=1,NBSOU1 614 : IPT3.LISOUS(L)=KM(2,L) 615 : 785 CONTINUE 616 : ENDIF 617 : 618 : C? SEGACT IPT3 619 : C? nbref=IPT3.LISREF(/1) 620 : C? write(6,*)' nbref,meleme=',nbref,meleme 621 : C? IPT3.LISREF(1)=MELEME 622 : SEGDES IPT3 623 : 623 : CALL ECROBJ('MAILLAGE',IPT3) 624 : 625 : SEGSUP CARA,TRAV2 626 : 627 : RETURN 628 : 1011 FORMAT('L=',I3,4X,15(1X,I5)) 629 : 1001 FORMAT(20(1X,I5)) 630 : 1002 FORMAT(10(1X,1PE11.4)) 631 : END 632 : 633 :
© Cast3M 2003 - All rights reserved.
Disclaimer