1 : C ELAS1 SOURCE AM 12/03/15 21:22:16 7321 2 : 3 : SUBROUTINE ELAS1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPSTRS,IRET) 4 : 5 : *_______________________________________________________________________ 6 : * 7 : * operateur elasticite 8 : * 9 : * entrees : 10 : * --------- 11 : * 12 : * ipmodl pointeur sur un mmodel 13 : * ipche1 pointeur sur un mchaml de contraintes ou de deformations 14 : * ipche2 pointeur sur un mchaml de materiau 15 : * ipche3 pointeur sur un mchaml de variables internes(facultatif) 16 : * 17 : * sortie : 18 : * -------- 19 : * 20 : * ipstrs pointeur sur un mchaml de contraintes ou de deformations 21 : * iret =1 ou 0 suivant succes ou pas 22 : * 23 : * passage aux nouveaux chamelem par jm campenon le 01/91 24 : *_______________________________________________________________________ 25 : * 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : * 29 : -INC CCREEL 30 : -INC CCOPTIO 31 : -INC CCHAMP 32 : -INC SMINTE 33 : -INC SMMODEL 34 : -INC SMELEME 35 : -INC SMCHAML 36 : -INC SMCOORD 37 : -INC SMLREEL 38 : * 39 : *_______________________________________________________________________ 40 : * la variable kerre regit les impressions d erreurs dans elas1 41 : * 42 : * kerre=0 tout ok 43 : * =49 matrice de hooke singuliere 44 : *_______________________________________________________________________ 45 : * 46 : SEGMENT IWRK1 47 : REAL*8 VALCAR(NCARRw),VALMAT(NMATT),VAR(NVART) 48 : REAL*8 SIGF(NSTRS),EPSI(NSTRS) 49 : REAL*8 DDHOOK(LHOOK,LHOOK),DDHOMU(LHOOK,LHOOK) 50 : REAL*8 COBMA(LHOOK) 51 : ENDSEGMENT 52 : * 53 : SEGMENT WPOUT 54 : REAL*8 SIG1(NSTRS),SIG2(NSTRS) 55 : ENDSEGMENT 56 : * 57 : SEGMENT IWRK2 58 : REAL*8 XE(3,NBNN),TXR(IDIM,IDIM) 59 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 60 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK) 61 : REAL*8 COBAUX(LHOOK) 62 : ENDSEGMENT 63 : * 64 : SEGMENT IWRK4 65 : REAL*8 VECO1(LHOOK),VECO2(LHOOK) 66 : ENDSEGMENT 67 : * 68 : SEGMENT NOTYPE 69 : CHARACTER*16 TYPE(NBTYPE) 70 : ENDSEGMENT 71 : * 72 : SEGMENT MPTVAL 73 : INTEGER IPOS(NS) ,NSOF(NS) 74 : INTEGER IVAL(NCOSOU) 75 : CHARACTER*16 TYVAL(NCOSOU) 76 : ENDSEGMENT 77 : * 78 : DIMENSION CRIGI(12),CMASS(12),S(20) 79 : CHARACTER*8 CMATE,PHAM 80 : CHARACTER*(NCONCH) CONM 81 : LOGICAL LSUPDE,LSUPCO,lsupma,lsupca,lsupre,lsupin,lsupva 82 : PARAMETER ( NINF=3 ) 83 : PARAMETER(DEUX=2.D0,UNDEMI=.5D0,SIX=6.D0) 84 : PARAMETER(X774=.774596669241483D0) 85 : INTEGER INFOS(NINF) 86 : * 87 : IRET=0 88 : KERRE=0 89 : * 90 : * Reduction des mchamls sur le modele 91 : * 91 : call reduaf(ipche1,ipmodl,ipch,0,ir,kerre) 91 : if (ir.ne.1) call erreur(kerre) 92 : if (ierr.ne.0) return 93 : ipche1=ipch 94 : * 94 : call reduaf(ipche2,ipmodl,ipch,0,ir,kerre) 94 : if (ir.ne.1) call erreur(kerre) 95 : if (ierr.ne.0) return 96 : ipche2=ipch 97 : * 98 : IF (IPCHE3.NE.0) THEN 98 : call reduaf(ipche3,ipmodl,ipch,0,ir,kerre) 98 : if (ir.ne.1) call erreur(kerre) 99 : if (ierr.ne.0) return 100 : ipche3=ipch 101 : ENDIF 102 : * 103 : * Verification du type de IPCHE1 ! 104 : * 105 : KCAS = 0 106 : MCHELM=IPCHE1 107 : SEGACT MCHELM 108 : IF (TITCHE.EQ.'CONTRAINTES') THEN 109 : KCAS=2 110 : ELSE IF(TITCHE.EQ.'DEFORMATIONS') THEN 111 : KCAS=1 112 : ENDIF 113 : IF (KCAS.EQ.0) THEN 114 : SEGDES,MCHELM 115 : MOTERR(1:8)='CONTRAIN' 116 : MOTERR(9:16)='DEFORMAT' 116 : CALL ERREUR(109) 117 : RETURN 118 : ENDIF 119 : * 120 : * Verification du lieu support des mchamls 121 : * 121 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1) 122 : IF (ISUP1.GT.1) RETURN 122 : CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2) 123 : IF (ISUP2.GT.1) RETURN 124 : IF (IPCHE3.NE.0) THEN 124 : CALL QUESUP(IPMODL,IPCHE3,5,0,ISUP3,IRET3) 125 : IF (ISUP3.GT.1) RETURN 126 : ENDIF 127 : * 128 : * activation du modele 129 : * 130 : MMODEL=IPMODL 131 : SEGACT MMODEL 132 : NSOUS=KMODEL(/1) 133 : KEL22 = 0 134 : DO ISOUS=1,NSOUS 135 : IMODEL=KMODEL(ISOUS) 136 : SEGACT,IMODEL 137 : IF (NEFMOD.EQ.22) KEL22 = KEL22 + 1 138 : ENDDO 139 : * 140 : * creation du mchelm 141 : * 142 : N1=NSOUS - KEL22 143 : N3=6 144 : IF (KCAS.EQ.1) THEN 145 : L1=11 146 : SEGINI MCHEL1 147 : MCHEL1.TITCHE='CONTRAINTES' 148 : ELSE IF (KCAS.EQ.2) THEN 149 : L1=12 150 : SEGINI MCHEL1 151 : MCHEL1.TITCHE='DEFORMATIONS' 152 : ENDIF 153 : MCHEL1.IFOCHE=IFOUR 154 : IPSTRS=MCHEL1 155 : * 156 : *_______________________________________________________________________ 157 : * 158 : * debut de la boucle sur les differentes sous zones 159 : *_______________________________________________________________________ 160 : * 161 : isouss=0 162 : DO 500 ISOUS=1,NSOUS 163 : * 164 : lsupma=.true. 165 : NMATR=0 166 : NMATF=0 167 : NCARA=0 168 : NCARF=0 169 : NVART=0 170 : MORES=0 171 : NRES=0 172 : IVAMAT=0 173 : IVACAR=0 174 : IVARI=0 175 : MOMATR=0 176 : MOCARA=0 177 : * 178 : * on recupere l'information generale 179 : * 180 : IMODEL=KMODEL(ISOUS) 181 : C* SEGACT IMODEL 182 : MELE=NEFMOD 183 : if( mele.eq.22) go to 500 184 : * 185 : * traitement du modele 186 : * 187 : isouss=isouss+1 188 : IPMAIL=IMAMOD 189 : CONM =CONMOD 190 : PHAM = conmod(17:24) 191 : MCHEL1.IMACHE(ISOUSs)=IPMAIL 192 : MCHEL1.CONCHE(ISOUSs)=CONMOD 193 : * 194 : MELEME=IPMAIL 195 : SEGACT MELEME 196 : NBNN=NUM(/1) 197 : NBELEM=NUM(/2) 198 : * 199 : * creation du tableau infos 200 : * 200 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 201 : IF (IRTD.EQ.0) THEN 202 : SEGSUP MCHEL1 203 : GOTO 9992 204 : ENDIF 205 : * 206 : * coque integree ou pas 207 : * 208 : IF(INFMOD(/1).NE.0) THEN 209 : NPINT=INFMOD(1) 210 : ELSE 211 : NPINT=0 212 : ENDIF 213 : * 214 : * information sur l'element fini 215 : * 215 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 216 : * IF (IERR.NE.0) THEN 217 : * SEGSUP MCHEL1 218 : * GOTO 9992 219 : * ENDIF 220 : MFR =INFELE(13) 221 : NBPGAU=INFELE(6) 222 : IF ((MELE.EQ.29.OR.MFR.EQ.13). 223 : 1 AND.NBPGAU.NE.1.AND.NBPGAU.NE.2) THEN 223 : CALL ERREUR(712) 224 : GOTO 9992 225 : ENDIF 226 : NSTRS=INFELE(16) 227 : LHOOK=INFELE(10) 228 : IPORE=INFELE(8) 229 : IPPORE=0 230 : NBNO=NBNN 231 : IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) THEN 232 : IPPORE=NBNN 233 : NBNO=IPORE 234 : ENDIF 235 : * 236 : * cas des dkt integres 237 : * 238 : IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4 239 : * 240 : LHOO2=LHOOK*LHOOK 241 : * MINTE=INFELE(11) 242 : minte=infmod(7) 243 : IPMINT=MINTE 244 : SEGACT,MINTE 245 : * 246 : * nature du materiau 247 : * 248 : C* NFOR=FORMOD(/2) 249 : C* NMAT=MATMOD(/2) 249 : C* CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 250 : CMATE = CMATEE 251 : MATE = IMATEE 252 : INAT = INATUU 253 : C* IF (CMATE.EQ.' ') THEN 253 : C* CALL ERREUR(251) 254 : C* SEGSUP MCHEL1 255 : C* GOTO 9992 256 : C* ENDIF 257 : * 258 : MCHEL1.INFCHE(ISOUSs,1)=0 259 : MCHEL1.INFCHE(ISOUSs,2)=0 260 : MCHEL1.INFCHE(ISOUSs,3)=NIFOUR 261 : MCHEL1.INFCHE(ISOUSs,4)=MINTE 262 : MCHEL1.INFCHE(ISOUSs,5)=0 263 : MCHEL1.INFCHE(ISOUSs,6)=5 264 : * 265 : * recherche du nom des composantes 266 : * 267 : lsupre=.false. 268 : lsupin=.false. 269 : IF(lnomid(5).ne.0) then 270 : nomid=lnomid(5) 271 : segact nomid 272 : nstdef=lesobl(/2) 273 : lsupde=.false. 274 : mosdef=nomid 275 : else 275 : CALL IDDEFO(IMODEL,IFOUR,MOSDEF,NSTDEF,NFADEF) 276 : lsupde=.true. 277 : endif 278 : if(lnomid(4).ne.0) then 279 : nomid=lnomid(4) 280 : segact nomid 281 : mostr=nomid 282 : nst=lesobl(/2) 283 : nfac=lesfac(/2) 284 : lsupco=.false. 285 : else 286 : lsupco=.true. 286 : CALL IDCONT(IMODEL,IFOUR,MOstr,Nst,NFAC) 287 : endif 288 : IF (KCAS.EQ.1) THEN 289 : MOSTRS=MOSDEF 290 : NSTR=NSTDEF 291 : lsupin=lsupde 292 : mores = mostr 293 : nres=nst 294 : lsupre=lsupco 295 : ELSE IF (KCAS.EQ.2) THEN 296 : lsupin=lsupco 297 : MOSTRS=MOSTR 298 : NSTR=NST 299 : MORES=MOSDEF 300 : NRES=NSTDEF 301 : lsupre=lsupde 302 : ENDIF 303 : * 304 : * verification de leur presence 305 : * 306 : NBTYPE=1 307 : SEGINI NOTYPE 308 : MOTYPE=NOTYPE 309 : TYPE(1)='REAL*8' 309 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 310 : SEGSUP NOTYPE 311 : IF (IERR.NE.0) THEN 312 : NRES=0 313 : GOTO 9990 314 : ENDIF 315 : * 315 : IF(ISUP1.EQ.1)CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE) 316 : * 317 : * recherche de la taille des melval a allouer 318 : * 319 : N1PTEL=NBPGAU 320 : N1EL =NBELEM 321 : NBPTEL=N1PTEL 322 : N2PTEL=0 323 : N2EL =0 324 : * 325 : * creation du mchaml de la sous zone 326 : * 327 : N2=NRES 328 : SEGINI MCHAM1 329 : MCHEL1.ICHAML(ISOUSs)=MCHAM1 330 : NS=1 331 : NCOSOU=NRES 332 : SEGINI MPTVAL 333 : IVARES=MPTVAL 334 : NOMID=MORES 335 : * write(6,*) ' KCAS ' , kcas, ' nomid ' , nomid 336 : SEGACT NOMID 337 : DO 1000 ICOMP=1,NRES 338 : MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP) 339 : MCHAM1.TYPCHE(ICOMP)='REAL*8' 340 : SEGINI MELVA1 341 : MCHAM1.IELVAL(ICOMP)=MELVA1 342 : IVAL(ICOMP)=MELVA1 343 : 1000 CONTINUE 344 : SEGDES NOMID 345 : SEGDES MCHAM1 346 : 347 : * 348 : * traitement des champs de materiau 349 : * 350 : NOMID=0 351 : NBROBL=0 352 : NBRFAC=0 353 : IF (FORMOD(1).EQ.'MECANIQUE') THEN 354 : C* IF (CMATE.EQ.'ISOTROPE') THEN 355 : IF (MATE.EQ.1) THEN 356 : IF(INAT.EQ.26.AND.IPCHE3.NE.0) THEN 357 : NBROBL=3 358 : NBRFAC=0 359 : SEGINI NOMID 360 : LESOBL(1)='YOUN' 361 : LESOBL(2)='NU ' 362 : LESOBL(3)='DC ' 363 : ELSEIF(INAT.EQ.62) THEN 364 : NBROBL=4 365 : NBRFAC=0 366 : SEGINI NOMID 367 : LESOBL(1)='YOUN' 368 : LESOBL(2)='NU ' 369 : LESOBL(3)='F' 370 : LESOBL(4)='FC' 371 : ELSE 372 : NBROBL=2 373 : NBRFAC=0 374 : SEGINI NOMID 375 : IF (MFR.EQ.35) THEN 376 : LESOBL(1)='KS ' 377 : LESOBL(2)='KN ' 378 : ELSE 379 : LESOBL(1)='YOUN' 380 : LESOBL(2)='NU ' 381 : ENDIF 382 : ENDIF 383 : C* ELSEIF (CMATE.EQ.'ORTHOTRO') THEN 384 : ELSEIF (MATE.EQ.2) THEN 385 : IF (MFR.EQ.75) THEN 386 : * 387 : * JOINT UNIDIMENSIONNEL JOI1 388 : * 389 : IF(IDIM.EQ.3)THEN 390 : NBROBL=12 391 : NBRFAC=0 392 : SEGINI NOMID 393 : LESOBL(1)='V1X ' 394 : LESOBL(2)='V1Y ' 395 : LESOBL(3)='V1Z ' 396 : LESOBL(4)='V2X ' 397 : LESOBL(5)='V2Y ' 398 : LESOBL(6)='V2Z ' 399 : LESOBL(7)='KN ' 400 : LESOBL(8)='KS1 ' 401 : LESOBL(9)='KS2' 402 : LESOBL(10)='QN ' 403 : LESOBL(11)='QS1 ' 404 : LESOBL(12)='QS2 ' 405 : * 406 : ELSE IF(IDIM.EQ.2)THEN 407 : NBROBL=5 408 : NBRFAC=0 409 : SEGINI NOMID 410 : LESOBL(1)='V1X ' 411 : LESOBL(2)='V1Y ' 412 : LESOBL(3)='KN ' 413 : LESOBL(4)='KS ' 414 : LESOBL(5)='QS' 415 : ENDIF 416 : * 417 : ELSE IF (MFR.EQ.3) THEN 418 : * coques minces 419 : NBROBL=6 420 : NBRFAC=0 421 : SEGINI NOMID 422 : LESOBL(1)='YG1 ' 423 : LESOBL(2)='YG2 ' 424 : LESOBL(3)='NU12' 425 : LESOBL(4)='G12 ' 426 : LESOBL(5)='V1X ' 427 : LESOBL(6)='V1Y ' 428 : ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN 429 : * coques avec cisaillement transverse 430 : NBROBL=8 431 : NBRFAC=0 432 : SEGINI NOMID 433 : LESOBL(1)='YG1 ' 434 : LESOBL(2)='YG2 ' 435 : LESOBL(3)='NU12' 436 : LESOBL(4)='G12 ' 437 : LESOBL(5)='G23 ' 438 : LESOBL(6)='G13 ' 439 : LESOBL(7)='V1X ' 440 : LESOBL(8)='V1Y ' 441 : ELSE IF (MFR.EQ.1.OR.MFR.EQ.31) THEN 442 : * elements massifs 443 : IF(IDIM.EQ.3)THEN 444 : * elements 3d 445 : NBROBL=15 446 : NBRFAC=0 447 : SEGINI NOMID 448 : LESOBL(1)='YG1 ' 449 : LESOBL(2)='YG2 ' 450 : LESOBL(3)='YG3 ' 451 : LESOBL(4)='NU12' 452 : LESOBL(5)='NU23' 453 : LESOBL(6)='NU13' 454 : LESOBL(7)='G12 ' 455 : LESOBL(8)='G23 ' 456 : LESOBL(9)='G13 ' 457 : LESOBL(10)='V1X ' 458 : LESOBL(11)='V1Y ' 459 : LESOBL(12)='V1Z ' 460 : LESOBL(13)='V2X ' 461 : LESOBL(14)='V2Y ' 462 : LESOBL(15)='V2Z ' 463 : ELSE IF (IDIM.EQ.2) THEN 464 : IF(IFOUR.EQ.-2) THEN 465 : * cont. plane 466 : NBROBL=9 467 : NBRFAC=0 468 : SEGINI NOMID 469 : LESOBL(1)='YG1 ' 470 : LESOBL(2)='YG2 ' 471 : LESOBL(3)='NU12 ' 472 : LESOBL(4)='G12' 473 : LESOBL(5)='V1X ' 474 : LESOBL(6)='V1Y ' 475 : LESOBL(7)='YG3 ' 476 : LESOBL(8)='NU23' 477 : LESOBL(9)='NU13' 478 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) 479 : $ THEN 480 : * deformation plane ,axisymetrie 481 : NBROBL=9 482 : NBRFAC=0 483 : SEGINI NOMID 484 : LESOBL(1)='YG1 ' 485 : LESOBL(2)='YG2 ' 486 : LESOBL(3)='YG3 ' 487 : LESOBL(4)='NU12' 488 : LESOBL(5)='NU23' 489 : LESOBL(6)='NU13' 490 : LESOBL(7)='G12 ' 491 : LESOBL(8)='V1X ' 492 : LESOBL(9)='V1Y ' 493 : ELSE IF (IFOUR.EQ.1) THEN 494 : * axisymetrie de fourier 495 : NBROBL=11 496 : NBRFAC=0 497 : SEGINI NOMID 498 : LESOBL(1)='YG1 ' 499 : LESOBL(2)='YG2 ' 500 : LESOBL(3)='YG3 ' 501 : LESOBL(4)='NU12' 502 : LESOBL(5)='NU23' 503 : LESOBL(6)='NU13' 504 : LESOBL(7)='G12 ' 505 : LESOBL(8)='G23 ' 506 : LESOBL(9)='G13 ' 507 : LESOBL(10)='V1X ' 508 : LESOBL(11)='V1Y ' 509 : ENDIF 510 : ELSE IF (IDIM.EQ.1) THEN 511 : NBROBL=6 512 : NBRFAC=0 513 : SEGINI,NOMID 514 : LESOBL(1)='YG1 ' 515 : LESOBL(2)='YG2 ' 516 : LESOBL(3)='YG3 ' 517 : LESOBL(4)='NU12' 518 : LESOBL(5)='NU23' 519 : LESOBL(6)='NU13' 520 : ENDIF 521 : ELSE IF (MFR.EQ.35) THEN 522 : * elements joints 523 : IF (IFOUR.EQ.2) THEN 524 : NBROBL=5 525 : NBRFAC=0 526 : SEGINI NOMID 527 : LESOBL(1)='KS1 ' 528 : LESOBL(2)='KS2 ' 529 : LESOBL(3)='KN ' 530 : LESOBL(4)='V1X ' 531 : LESOBL(5)='V1Y ' 532 : ENDIF 533 : ENDIF 534 : C* ELSEIF (CMATE.EQ.'ANISOTRO') THEN 535 : ELSEIF (MATE.EQ.3) THEN 536 : * 537 : IF(MFR.EQ.75)THEN 538 : * 539 : * JOINT UNIDIMESIONNEL JOI1 540 : * 541 : IF(IDIM.EQ.3)THEN 542 : NBROBL=27 543 : NBRFAC=0 544 : SEGINI NOMID 545 : LESOBL(1)='V1X ' 546 : LESOBL(2)='V1Y ' 547 : LESOBL(3)='V1Z ' 548 : LESOBL(4)='V2X ' 549 : LESOBL(5)='V2Y ' 550 : LESOBL(6)='V2Z ' 551 : LESOBL(7)='D11 ' 552 : LESOBL(8)='D22 ' 553 : LESOBL(9)='D33 ' 554 : LESOBL(10)='D44 ' 555 : LESOBL(11)='D55 ' 556 : LESOBL(12)='D66 ' 557 : LESOBL(13)='D21 ' 558 : LESOBL(14)='D31 ' 559 : LESOBL(15)='D32 ' 560 : LESOBL(16)='D41 ' 561 : LESOBL(17)='D42 ' 562 : LESOBL(18)='D43 ' 563 : LESOBL(19)='D51 ' 564 : LESOBL(20)='D52 ' 565 : LESOBL(21)='D53 ' 566 : LESOBL(22)='D54 ' 567 : LESOBL(23)='D61 ' 568 : LESOBL(24)='D62 ' 569 : LESOBL(25)='D63 ' 570 : LESOBL(26)='D64 ' 571 : LESOBL(27)='D65 ' 572 : ELSE IF(IDIM.EQ.2)THEN 573 : NBROBL=8 574 : NBRFAC=0 575 : SEGINI NOMID 576 : LESOBL(1)='V1X ' 577 : LESOBL(2)='V1Y ' 578 : LESOBL(3)='D11 ' 579 : LESOBL(4)='D22 ' 580 : LESOBL(5)='D33 ' 581 : LESOBL(6)='D21 ' 582 : LESOBL(7)='D31 ' 583 : LESOBL(8)='D32 ' 584 : ENDIF 585 : * 586 : ELSE IF (MFR.EQ.1.OR.MFR.EQ.31) THEN 587 : * elements massifs 588 : IF(IDIM.EQ.3)THEN 589 : * elements 3d 590 : IF (IFOUR.EQ.2) THEN 591 : NBROBL=27 592 : NBRFAC=0 593 : SEGINI NOMID 594 : LESOBL(1)='D11 ' 595 : LESOBL(2)='D21 ' 596 : LESOBL(3)='D22 ' 597 : LESOBL(4)='D31 ' 598 : LESOBL(5)='D32 ' 599 : LESOBL(6)='D33 ' 600 : LESOBL(7)='D41 ' 601 : LESOBL(8)='D42 ' 602 : LESOBL(9)='D43 ' 603 : LESOBL(10)='D44 ' 604 : LESOBL(11)='D51 ' 605 : LESOBL(12)='D52 ' 606 : LESOBL(13)='D53 ' 607 : LESOBL(14)='D54 ' 608 : LESOBL(15)='D55 ' 609 : LESOBL(16)='D61 ' 610 : LESOBL(17)='D62 ' 611 : LESOBL(18)='D63 ' 612 : LESOBL(19)='D64 ' 613 : LESOBL(20)='D65 ' 614 : LESOBL(21)='D66 ' 615 : LESOBL(22)='V1X ' 616 : LESOBL(23)='V1Y ' 617 : LESOBL(24)='V1Z ' 618 : LESOBL(25)='V2X ' 619 : LESOBL(26)='V2Y ' 620 : LESOBL(27)='V2Z ' 621 : ENDIF 622 : ELSE IF (IDIM.EQ.2) THEN 623 : IF (IFOUR.EQ.-2) THEN 624 : * contrainte plane 625 : NBROBL=8 626 : NBRFAC=4 627 : SEGINI NOMID 628 : LESOBL(1)='D11 ' 629 : LESOBL(2)='D21 ' 630 : LESOBL(3)='D22 ' 631 : LESOBL(4)='D41 ' 632 : LESOBL(5)='D42 ' 633 : LESOBL(6)='D44 ' 634 : LESOBL(7)='V1X ' 635 : LESOBL(8)='V1Y ' 636 : LESOBL(9)='D31 ' 637 : LESOBL(10)='D32 ' 638 : LESOBL(11)='D33 ' 639 : LESOBL(12)='D43 ' 640 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) 641 : $ THEN 642 : * deformation plane ,axisymetrie 643 : NBROBL=12 644 : NBRFAC=0 645 : SEGINI NOMID 646 : LESOBL(1)='D11 ' 647 : LESOBL(2)='D21 ' 648 : LESOBL(3)='D22 ' 649 : LESOBL(4)='D31 ' 650 : LESOBL(5)='D32 ' 651 : LESOBL(6)='D33 ' 652 : LESOBL(7)='D41 ' 653 : LESOBL(8)='D42 ' 654 : LESOBL(9)='D43 ' 655 : LESOBL(10)='D44 ' 656 : LESOBL(11)='V1X ' 657 : LESOBL(12)='V1Y ' 658 : ELSE IF (IFOUR.EQ.1) THEN 659 : * axisymetrie de fourier 660 : NBROBL=15 661 : NBRFAC=0 662 : SEGINI NOMID 663 : LESOBL(1)='D11 ' 664 : LESOBL(2)='D21 ' 665 : LESOBL(3)='D22 ' 666 : LESOBL(4)='D31 ' 667 : LESOBL(5)='D32 ' 668 : LESOBL(6)='D33 ' 669 : LESOBL(7)='D41 ' 670 : LESOBL(8)='D42 ' 671 : LESOBL(9)='D43 ' 672 : LESOBL(10)='D44 ' 673 : LESOBL(11)='D55 ' 674 : LESOBL(12)='D65 ' 675 : LESOBL(13)='D66 ' 676 : LESOBL(14)='V1X ' 677 : LESOBL(15)='V1Y ' 678 : ENDIF 679 : ENDIF 680 : ENDIF 681 : C* ELSEIF (CMATE.EQ.'UNIDIREC') THEN 682 : ELSEIF (MATE.EQ.4) THEN 683 : IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN 684 : NBROBL=7 685 : NBRFAC=0 686 : SEGINI NOMID 687 : LESOBL(1)='YOUN' 688 : LESOBL(2)='V1X ' 689 : LESOBL(3)='V1Y ' 690 : LESOBL(4)='V1Z ' 691 : LESOBL(5)='V2X ' 692 : LESOBL(6)='V2Y ' 693 : LESOBL(7)='V2Z ' 694 : ELSE 695 : NBROBL=3 696 : NBRFAC=0 697 : SEGINI NOMID 698 : MOMATR=NOMID 699 : LESOBL(1)='YOUN' 700 : LESOBL(2)='V1X ' 701 : LESOBL(3)='V1Y ' 702 : ENDIF 703 : 704 : C* ELSEIF (CMATE.EQ.'ZONE_COH') THEN 705 : ELSEIF (MATE.EQ.12) THEN 706 : NBROBL=0 707 : NBRFAC=0 708 : IF (MFR.EQ.77) THEN 709 : NBROBL=2 710 : SEGINI NOMID 711 : MOMATR=NOMID 712 : LESOBL(1)='KS ' 713 : LESOBL(2)='KN ' 714 : ENDIF 715 : * 716 : ELSE 717 : if(lnomid(6).ne.0) then 718 : nomid=lnomid(6) 719 : segact nomid 720 : nbrobl=lesobl(/2) 721 : nbrfac=lesfac(/2) 722 : lsupma=.false. 723 : else 723 : CALL IDMATR(MFR,IMODEL,MOMATR,NBROBL,NBRFAC) 724 : nomid=momatr 725 : endif 726 : ENDIF 727 : ELSE 728 : if(lnomid(6).ne.0) then 729 : nomid=lnomid(6) 730 : segact nomid 731 : nbrobl=lesobl(/2) 732 : nbrfac=lesfac(/2) 733 : lsupma=.false. 734 : else 734 : CALL IDMATR(MFR,IMODEL,MOMATR,NBROBL,NBRFAC) 735 : nomid=momatr 736 : endif 737 : ENDIF 738 : MOMATR=NOMID 739 : NMATR=NBROBL 740 : NMATF=NBRFAC 741 : NMATT=NMATR+NMATF 742 : * 743 : IF (MOMATR.EQ.0) THEN 743 : CALL ERREUR(5) 744 : GOTO 9990 745 : ENDIF 746 : 747 : C* IF (CMATE.EQ.'SECTION') THEN 748 : IF (MATE.EQ.11) THEN 749 : NBTYPE=3 750 : SEGINI NOTYPE 751 : TYPE(1)='POINTEURMMODEL' 752 : TYPE(2)='POINTEURMCHAML' 753 : TYPE(3)='POINTEURLISTREEL' 754 : ELSE 755 : NBTYPE=1 756 : SEGINI NOTYPE 757 : TYPE(1)='REAL*8' 758 : ENDIF 759 : MOTYPE=NOTYPE 760 : * 760 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) 761 : SEGSUP NOTYPE 762 : IF (IERR.NE.0) GOTO 9990 763 : * 764 : IF(ISUP2.EQ.1)THEN 764 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 765 : ENDIF 766 : * 767 : * traitement des champs caracteristiques 768 : * 769 : NOMID =0 770 : NBROBL=0 771 : NBRFAC=0 772 : * 773 : * epaisseur et excentrement dans le cas des coques 774 : * 775 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 776 : NBROBL=1 777 : NBRFAC=1 778 : SEGINI NOMID 779 : LESOBL(1)='EPAI' 780 : LESFAC(1)='EXCE' 781 : * 782 : * section pour les barres 783 : * 784 : ELSE IF (MFR.EQ.27) THEN 785 : NBROBL=1 786 : SEGINI NOMID 787 : LESOBL(1)='SECT' 788 : * 789 : * section, excentrements et orientation pour les barres excentrees 790 : * 791 : ELSE IF (MFR.EQ.49) THEN 792 : NBROBL=6 793 : SEGINI NOMID 794 : LESOBL(1)='SECT' 795 : LESOBL(2)='EXCZ' 796 : LESOBL(3)='EXCY' 797 : LESOBL(4)='VX ' 798 : LESOBL(5)='VY ' 799 : LESOBL(6)='VZ ' 800 : * 801 : * raideurs locales et orientation pour l'element LIA2 802 : * de liaison a 2 noeuds 803 : * 804 : ELSE IF (MFR.EQ.51) THEN 805 : NBROBL=9 806 : SEGINI NOMID 807 : LESOBL(1)='RLUX' 808 : LESOBL(2)='RLUY' 809 : LESOBL(3)='RLUZ' 810 : LESOBL(4)='RLRX' 811 : LESOBL(5)='RLRY' 812 : LESOBL(6)='RLRZ' 813 : LESOBL(7)='VX ' 814 : LESOBL(8)='VY ' 815 : LESOBL(9)='VZ ' 816 : * 817 : * caracteristiques pour les poutres 818 : * 819 : ELSE IF (MFR.EQ.7 ) THEN 820 : C* IF (CMATE.NE.'SECTION') THEN 821 : IF (MATE.NE.11) THEN 822 : * 823 : * CAS 2D 824 : * 825 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 826 : NBRFAC=1 827 : NBROBL=2 828 : SEGINI NOMID 829 : LESOBL(1)= 'SECT' 830 : LESOBL(2)= 'INRZ' 831 : LESFAC(1)= 'SECY' 832 : * 833 : ELSE 834 : NBROBL=4 835 : NBRFAC=2 836 : SEGINI NOMID 837 : LESOBL(1)='TORS' 838 : LESOBL(2)='INRY' 839 : LESOBL(3)='INRZ' 840 : LESOBL(4)='SECT' 841 : LESFAC(1)='SECY' 842 : LESFAC(2)='SECZ' 843 : ENDIF 844 : ENDIF 845 : * 846 : * caracteristiques pour les tuyaux 847 : * 848 : ELSE IF (MFR.EQ.13) THEN 849 : NBROBL=2 850 : NBRFAC=3 851 : SEGINI NOMID 852 : LESOBL(1)='EPAI' 853 : LESOBL(2)='RAYO' 854 : LESFAC(1)='RACO' 855 : LESFAC(2)='PRES' 856 : LESFAC(3)='CISA' 857 : * 858 : * caracteristiques pour les linespring 859 : * 860 : ELSE IF (MFR.EQ.15) THEN 861 : NBROBL=5 862 : SEGINI NOMID 863 : LESOBL(1)='EPAI' 864 : LESOBL(2)='FISS' 865 : LESOBL(3)='VX ' 866 : LESOBL(4)='VY ' 867 : LESOBL(5)='VZ ' 868 : * 869 : * caracteristiques pour les tuyaux fissures 870 : * 871 : ELSE IF (MFR.EQ.17) THEN 872 : NBROBL=9 873 : SEGINI NOMID 874 : LESOBL(1)='RAYO' 875 : LESOBL(2)='EPAI' 876 : LESOBL(3)='VX ' 877 : LESOBL(4)='VY ' 878 : LESOBL(5)='VZ ' 879 : LESOBL(6)='VXF ' 880 : LESOBL(7)='VYF ' 881 : LESOBL(8)='VZF ' 882 : LESOBL(9)='ANGL' 883 : * 884 : * caracteristiques des elements homogeneises 885 : * 886 : ELSE IF (MFR.EQ.37) THEN 887 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN 888 : NBROBL=4 889 : SEGINI NOMID 890 : LESOBL(1)='SCEL' 891 : LESOBL(2)='SFLU' 892 : LESOBL(3)='EPS ' 893 : LESOBL(4)='XINE' 894 : ELSE 895 : NBROBL=3 896 : SEGINI NOMID 897 : LESOBL(1)='SCEL' 898 : LESOBL(2)='SFLU' 899 : LESOBL(3)='EPS ' 900 : ENDIF 901 : ENDIF 902 : MOCARA=NOMID 903 : NCARA=NBROBL 904 : NCARF=NBRFAC 905 : ncarr= NCARA+NCARF 906 : NCARRw=NCARA+NCARF 907 : if( MFR.EQ.13) ncarrw=ncarrw + 10 908 : IF (MOCARA.NE.0) THEN 909 : NBTYPE=1 910 : SEGINI NOTYPE 911 : TYPE(1)='REAL*8' 912 : MOTYPE=NOTYPE 912 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3 913 : $ ,IVACAR) 914 : SEGSUP NOTYPE 915 : IF (IERR.NE.0) GOTO 9990 916 : 917 : IF (ISUP2.EQ.1) THEN 917 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 918 : ENDIF 919 : ENDIF 920 : * 921 : c____________________________________________________________________ 922 : c 923 : * traitement des champs de variables internes * 924 : c____________________________________________________________________ 925 : c 926 : lsupva=.true. 927 : IF(INAT.EQ.62.AND .IPCHE3.EQ.0) NVART = 3 928 : IF (IPCHE3.NE.0) THEN 929 : if(lnomid(10).ne.0) then 930 : nomid=lnomid(10) 931 : segact nomid 932 : movari=nomid 933 : nvari=lesobl(/2) 934 : nvarf=lesfac(/2) 935 : lsupva=.false. 936 : else 936 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) 937 : endif 938 : IF (MOVARI.EQ.0) THEN 939 : MOTERR(1:4)='VARI' 940 : MOTERR(5:8)=NOMTP(MELE) 940 : CALL ERREUR(76) 941 : GOTO 9990 942 : ENDIF 943 : NVART=NVARI+NVARF 944 : * 945 : NBTYPE=1 946 : SEGINI NOTYPE 947 : TYPE(1)='REAL*8' 948 : MOTYPE=NOTYPE 948 : CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOVARI,MOTYPE,1, 949 : 1 INFOS,3,IVARI) 950 : SEGSUP NOTYPE 951 : IF (IERR.NE.0) GOTO 9990 952 : * 953 : IF (ISUP3.EQ.1) THEN 953 : CALL VALCHE(IVARI,NVART,IPMIN1,IPPORE) 954 : ENDIF 955 : ENDIF 956 : c____________________________________________________________________ 957 : * 958 : * recherche des dimensions qui correspondraient 959 : * à un MELVAL de HOOKE 960 : c____________________________________________________________________ 961 : N2PTEL=0 962 : N2EL=0 963 : MPTVAL=IVAMAT 964 : DO 1500 IO=1,NMATT 965 : IF(IVAL(IO).NE.0)THEN 966 : MELVAL=IVAL(IO) 967 : C* IF (CMATE.EQ.'SECTION') THEN 968 : IF (MATE.EQ.11) THEN 969 : N2PTEL=MAX(N2PTEL,IELCHE(/1)) 970 : N2EL =MAX(N2EL ,IELCHE(/2)) 971 : ELSE 972 : N2PTEL=MAX(N2PTEL,VELCHE(/1)) 973 : N2EL =MAX(N2EL ,VELCHE(/2)) 974 : ENDIF 975 : ENDIF 976 : 1500 CONTINUE 977 : MPTVAL=IVACAR 978 : DO 41 IO=1,NCARR 979 : IF(IVAL(IO).NE.0)THEN 980 : MELVAL=IVAL(IO) 981 : C* IF (CMATE.EQ.'SECTION') THEN 982 : IF (MATE.EQ.11) THEN 983 : N2PTEL=MAX(N2PTEL,IELCHE(/1)) 984 : N2EL =MAX(N2EL ,IELCHE(/2)) 985 : ELSE 986 : N2PTEL=MAX(N2PTEL,VELCHE(/1)) 987 : N2EL =MAX(N2EL ,VELCHE(/2)) 988 : ENDIF 989 : ENDIF 990 : 41 CONTINUE 991 : IF (IPCHE3.NE.0) THEN 992 : MPTVAL=IVARI 993 : DO 42 IO=1,NVART 994 : IF(IVAL(IO).NE.0)THEN 995 : MELVAL=IVAL(IO) 996 : C* IF (CMATE.EQ.'SECTION') THEN 997 : IF (MATE.EQ.11) THEN 998 : N2PTEL=MAX(N2PTEL,IELCHE(/1)) 999 : N2EL =MAX(N2EL ,IELCHE(/2)) 1000 : ELSE 1001 : N2PTEL=MAX(N2PTEL,VELCHE(/1)) 1002 : N2EL =MAX(N2EL ,VELCHE(/2)) 1003 : ENDIF 1004 : ENDIF 1005 : 42 CONTINUE 1006 : ENDIF 1007 : IF (N2PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN 1008 : N2PTEL=1 1009 : ELSE 1010 : N2PTEL=NBPGAU 1011 : ENDIF 1012 : * 1013 : * INITIALISATION DES TABLEAUX DE TRAVAIL 1014 : * 1015 : NMAT1=NMATT 1016 : * cette sequence est presente car la troisieme composante 1017 : * (eventuellement) obligatoire est la septieme composante du materiau 1018 : IF(INAT.EQ.26) NMATT=NMATT+4 1019 : SEGINI IWRK1 1020 : IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) SEGINI IWRK4 1021 : * 1022 : IF(MFR.EQ.15) THEN 1023 : IF(NBPGAU.EQ.1) THEN 1024 : S(1)= 0.D0 1025 : ELSE IF(NBPGAU.EQ.3) THEN 1026 : S(1)=-X774 1027 : S(2)= 0.D0 1028 : S(3)= X774 1029 : ENDIF 1030 : ENDIF 1031 : * 1032 : IWRK2 = 0 1033 : C* IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 1034 : C* & CMATE.EQ.'UNIDIREC') .OR. 1035 : IF ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .OR. 1036 : & ((MELE.EQ.29.OR.MFR.EQ.13).AND.NBPGAU.EQ.2)) THEN 1037 : SEGINI IWRK2 1038 : ENDIF 1039 : * 1040 : * traitement special pour milieu non isotrope 1041 : * 1042 : IPMIN2 = 0 1043 : IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN 1044 : C* IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 1045 : C* & CMATE.EQ.'UNIDIREC') THEN 1046 : IF (MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) THEN 1047 : IELE=NUMGEO(MELE) 1047 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPMIN2,IRT1) 1048 : MINTE2=IPMIN2 1049 : SEGACT MINTE2 1050 : ENDIF 1051 : ENDIF 1052 : * 1053 : * boucle sur les elements 1054 : * 1055 : DO 2000 IB=1,NBELEM 1056 : * 1057 : * 1058 : IF (IWRK2.NE.0) THEN 1059 : C* IF ( ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 1060 : C* & CMATE.EQ.'UNIDIREC').AND. 1061 : C** IF ( ((MATE.EQ.2.OR.MATE.EQ.3.OR.MATE.EQ.4) .OR. 1062 : C* & (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)) .OR. 1063 : C* & ((MELE.EQ.29.OR.MFR.EQ.13).AND.NBPGAU.EQ.2) ) THEN 1064 : 1064 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 1065 : * 1066 : IF (IPMIN2.NE.0) THEN 1067 : C* IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN 1068 : * 1069 : * traitement special pour milieu non isotrope 1070 : * 1071 : NBSH=MINTE2.SHPTOT(/2) 1071 : CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR) 1072 : if (nbsh.eq.-1) then 1072 : call erreur(525) 1073 : return 1074 : endif 1075 : ENDIF 1076 : ENDIF 1077 : * 1078 : * boucle sur les points de gauss 1079 : * 1080 : DO 3000 IGAU=1,NBPTEL 1081 : 1082 : IRECAL=1 1083 : * 1084 : * si N2PTEL et N2EL sont égaux à 1 => champ uniforme dans le maillage 1085 : * => on ne calcule qu'une fois la matrice de HOOKE 1086 : * 1087 : IF(N2PTEL.EQ.1.AND.N2EL.EQ.1) THEN 1088 : IF(IB.GT.1.OR.IGAU.GT.1) THEN 1089 : IRECAL=0 1090 : ENDIF 1091 : ENDIF 1092 : * 1093 : * si N2PTEL est égal à 1 mais pas N2EL => champ uniforme dans l'élément 1094 : * => on ne calcule qu'une fois la matrice de HOOKE par élément 1095 : * 1096 : IF(N2PTEL.EQ.1.AND.N2EL.NE.1) THEN 1097 : IF(IGAU.GT.1) THEN 1098 : IRECAL=0 1099 : ENDIF 1100 : ENDIF 1101 : c 1102 : c sinon on RECALCULE ( EXTRAIT DE HOOK2D ) 1103 : c 1104 : IF(IRECAL.EQ.1) THEN 1105 : C 1106 : MPTVAL=IVAMAT 1107 : DO 1005 IM=1,NMAT1 1108 : IF (IVAL(IM).NE.0) THEN 1109 : MELVAL=IVAL(IM) 1110 : IBMN=MIN(IB ,VELCHE(/2)) 1111 : IGMN=MIN(IGAU,VELCHE(/1)) 1112 : VALMAT(IM)=VELCHE(IGMN,IBMN) 1113 : ELSE 1114 : VALMAT(IM)=0.D0 1115 : ENDIF 1116 : 1005 CONTINUE 1117 : * 1118 : * cette sequence est presente car la troisieme composante 1119 : * (eventuellement) obligatoire est la septieme composante du materiau 1120 : IF(INAT.EQ.26) THEN 1121 : VALMAT(7)=VALMAT(3) 1122 : DO 1006 ICOMP=3,6 1123 : VALMAT(ICOMP)=0.D0 1124 : 1006 CONTINUE 1125 : ENDIF 1126 : C 1127 : IF(INAT.EQ.26.OR.INAT.EQ.29.OR. 1128 : . INAT.EQ.62.OR.INAT.EQ.64.OR.INAT.EQ.65) THEN 1129 : MPTVAL=IVARI 1130 : DO 1007 IM=1,NVART 1131 : IF (MPTVAL.NE.0) THEN 1132 : MELVAL=IVAL(IM) 1133 : IBMN=MIN(IB ,VELCHE(/2)) 1134 : IGMN=MIN(IGAU,VELCHE(/1)) 1135 : VAR(IM)=VELCHE(IGMN,IBMN) 1136 : ELSE 1137 : VAR(IM)=0.D0 1138 : ENDIF 1139 : 1007 CONTINUE 1140 : ENDIF 1141 : C 1142 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.15. 1143 : 1 OR.MFR.EQ.17) THEN 1144 : C 1145 : C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB 1146 : C 1147 : C* IF(CMATE.EQ.'SECTION') THEN 1148 : IF(MATE.EQ.11) THEN 1149 : C 1150 : MPTVAL=IVAMAT 1151 : MELVAL=IVAL(1) 1152 : IBMN=MIN(IB ,IELCHE(/2)) 1153 : IGMN=MIN(IGAU,IELCHE(/1)) 1154 : IPMODL=IELCHE(IGMN,IBMN) 1155 : MELVAL=IVAL(2) 1156 : IBMN=MIN(IB ,IELCHE(/2)) 1157 : IGMN=MIN(IGAU,IELCHE(/1)) 1158 : IPCAR=IELCHE(IGMN,IBMN) 1158 : CALL FRIGIE(IPMODL,IPCAR,CRIGI,CMASS) 1159 : C 1160 : ELSEIF (MFR.EQ.15) THEN 1161 : C 1162 : IE=1 1163 : DO 7030 IC=1,3,2 1164 : MPTVAL=IVACAR 1165 : DO 7030 ICOMP=1,NCARR 1166 : MELVAL=IVAL(ICOMP) 1167 : IF (MELVAL.NE.0) THEN 1168 : IGMN=MIN(IC,VELCHE(/1)) 1169 : IBMN=MIN(IB,VELCHE(/2)) 1170 : VALCAR(IE)=VELCHE(IGMN,IBMN) 1171 : ELSE 1172 : VALCAR(IE)=0.D0 1173 : ENDIF 1174 : IE=IE+1 1175 : 7030 CONTINUE 1176 : C 1177 : ELSE 1178 : C 1179 : DO 1010 ICOMP=1,NCARR 1180 : MPTVAL=IVACAR 1181 : MELVAL=IVAL(ICOMP) 1182 : IF (MELVAL.NE.0) THEN 1183 : IBMN=MIN(IB ,VELCHE(/2)) 1184 : IGMN=MIN(IGAU,VELCHE(/1)) 1185 : VALCAR(ICOMP)=VELCHE(IGMN,IBMN) 1186 : ELSE 1187 : VALCAR(ICOMP)=0.D0 1188 : ENDIF 1189 : 1010 CONTINUE 1190 : ENDIF 1191 : ENDIF 1192 : C 1193 : IF(MFR.EQ.27.OR.MFR.EQ.49) THEN 1194 : C 1195 : C ON CHERCHE LA SECTION DE L'ELEMENT IB 1196 : C 1197 : MPTVAL=IVACAR 1198 : MELVAL=IVAL(1) 1199 : IF (MELVAL.NE.0) THEN 1200 : IBMN=MIN(IB ,VELCHE(/2)) 1201 : IGMN=MIN(IGAU,VELCHE(/1)) 1202 : SECT=VELCHE(IGMN,IBMN) 1203 : ELSE 1204 : SECT=0.D0 1205 : ENDIF 1206 : ENDIF 1207 : C 1208 : C Prise en compte de l'epaisseur et de l'excentrement 1209 : C dans le cas des coques minces avec ou sans cisaillement 1210 : C transverse 1211 : C 1212 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN 1213 : C* IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR. 1214 : C* 1 CMATE.EQ.'UNIDIREC') THEN 1215 : IF (MATE.EQ.1.OR.MATE.EQ.2.OR.MATE.EQ.4) THEN 1216 : MPTVAL=IVACAR 1217 : MELVAL=IVAL(1) 1218 : IF (MELVAL.NE.0) THEN 1219 : IBMN=MIN(IB ,VELCHE(/2)) 1220 : IGMN=MIN(IGAU,VELCHE(/1)) 1221 : EPAIST=VELCHE(IGMN,IBMN) 1222 : ELSE 1222 : CALL ERREUR(527) 1223 : GOTO 9990 1224 : ENDIF 1225 : C 1226 : LASURF=0 1227 : EXCEN = 0.D0 1228 : ENDIF 1229 : ENDIF 1230 : 1231 : C ______________________________________________________________________ 1232 : C 1233 : C TRAITEMENT SUIVANT TYPE DE MATERIAU 1234 : C_______________________________________________________________________ 1235 : IRETOU = 1 1236 : C* IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ZONE_COH') THEN 1237 : IF (MATE.EQ.1.OR.MATE.EQ.12) THEN 1237 : CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,EXCEN,EPAIST, 1238 : + INAT,MELE,NPINT,IFOUR,KCAS,N2PTEL,N2EL, 1239 : + S,SECT,LHOOK,DDHOMU,DDHOOK, 1240 : + COBMA,XMOB,IRETOU) 1241 : C 1242 : C* ELSE IF (CMATE.EQ.'ORTHOTRO') THEN 1243 : ELSE IF (MATE.EQ.2) THEN 1243 : CALL HOOKOR(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST, 1244 : + MELE,NPINT,IFOUR,KCAS,N2PTEL,N2EL,SECT,LHOOK, 1245 : + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK, 1246 : + COBMA,XMOB,IRETOU) 1247 : C 1248 : C* ELSE IF (CMATE.EQ.'ANISOTRO') THEN 1249 : ELSE IF (MATE.EQ.3) THEN 1249 : CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOUR,KCAS,N2PTEL,N2EL, 1250 : + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK, 1251 : + MELE,COBMA,XMOB,IRETOU) 1252 : C 1253 : C* ELSE IF (CMATE.EQ.'UNIDIREC') THEN 1254 : ELSE IF (MATE.EQ.4) THEN 1254 : CALL HOOKUN(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST, 1255 : + MELE,NPINT,IFOUR,KCAS,N2PTEL,N2EL,SECT,LHOOK, 1256 : + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK, 1257 : + COBMA,XMOB,IRETOU) 1258 : C 1259 : ELSE IF (CMATE.EQ.'HOMOGENE') THEN 1260 : C* ELSE IF (MATE.EQ.9) THEN 1260 : CALL HOOKHO(VALMAT,IB,IGAU,MFR,N2PTEL,N2EL,SECT, 1261 : + LHOOK,DDHOOK,IRETOU) 1262 : C 1263 : C* ELSE IF (CMATE.EQ.'SECTION') THEN 1264 : ELSE IF (MATE.EQ.11) THEN 1264 : CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOUR, 1265 : + N2PTEL,N2EL,SECT,LHOOK,DDHOOK,IRETOU) 1266 : C 1267 : ENDIF 1268 : C 1269 : IF (IRETOU.EQ.0) THEN 1270 : IF (MFR.EQ.3.AND.NPINT.NE.0) THEN 1270 : CALL ERREUR(251) 1271 : ELSE 1272 : MOTERR(1:8)=NOMFR(MFR/2+1) 1272 : CALL ERREUR(193) 1273 : ENDIF 1274 : GOTO 2000 1275 : ENDIF 1276 : * 1277 : * inversion si besoin 1278 : * 1279 : IF(KCAS.EQ.2.AND.INAT.NE.26.AND.INAT.NE.29. 1280 : & AND.INAT.NE.65) THEN 1280 : CALL INVALM(DDHOOK,LHOOK,LHOOK,KERRE,0.D0) 1281 : IF(KERRE.NE.0) THEN 1281 : CALL ERREUR(713) 1282 : GO TO 9992 1283 : ENDIF 1284 : ENDIF 1285 : * 1286 : * fin du test irecal 1287 : ENDIF 1288 : * 1289 : * ------ fin de détermination de la matrice de hooke 1290 : * 1291 : * 1292 : * on remplit ici les differentes quantites necessaires 1293 : * 1294 : * deformations 1295 : * 1296 : MPTVAL=IVASTR 1297 : IF (KCAS.EQ.2) THEN 1298 : DO 4000 ICOMP=1,NSTR 1299 : MELVAL=IVAL(ICOMP) 1300 : IGMN=MIN(IGAU,VELCHE(/1)) 1301 : IBMN=MIN(IB ,VELCHE(/2)) 1302 : SIGF(ICOMP)=VELCHE(IGMN,IBMN) 1303 : 4000 CONTINUE 1304 : ELSE IF(KCAS.EQ.1) THEN 1305 : DO 4001 ICOMP=1,NSTR 1306 : MELVAL=IVAL(ICOMP) 1307 : IGMN=MIN(IGAU,VELCHE(/1)) 1308 : IBMN=MIN(IB ,VELCHE(/2)) 1309 : EPSI(ICOMP)=VELCHE(IGMN,IBMN) 1310 : 4001 CONTINUE 1311 : ENDIF 1312 : * 1313 : * cas des milieux poreux 1314 : * 1315 : IF(MFR.EQ.33) THEN 1316 : * 1317 : IF(XMOB.EQ.0.D0) THEN 1318 : ***** INTERR(1)=IB 1318 : ***** CALL ERREUR(537) 1319 : UNSURM=0.D0 1320 : ELSE 1321 : UNSURM=1.D0/XMOB 1322 : ENDIF 1323 : * 1324 : * calcul des contraintes ou des deformations 1325 : * 1326 : IF(KCAS.EQ.1) THEN 1327 : * 1328 : DO 4500 I=1,LHOOK 1329 : SIGF(I)=-COBMA(I)*EPSI(NSTRS) 1330 : DO 45001 J=1,LHOOK 1331 : SIGF(I)=SIGF(I)+DDHOOK(I,J)*EPSI(J) 1332 : 45001 CONTINUE 1333 : 4500 CONTINUE 1334 : * 1335 : SIGF(NSTRS)=EPSI(NSTRS)*UNSURM 1336 : DO 4502 I=1,LHOOK 1337 : SIGF(NSTRS)=SIGF(NSTRS)+COBMA(I)*EPSI(I) 1338 : 4502 CONTINUE 1339 : * 1340 : * 1341 : ELSE IF (KCAS.EQ.2) THEN 1342 : * 1342 : CALL ZERO(VECO1,LHOOK,1) 1342 : CALL ZERO(VECO2,LHOOK,1) 1343 : FAC1 = 0.D0 1344 : FAC2 = 0.D0 1345 : DO 5003 I=1,LHOOK 1346 : DO 5004 J=1,LHOOK 1347 : VECO1(I)=VECO1(I)+DDHOOK(I,J)*SIGF(J) 1348 : VECO2(I)=VECO2(I)+DDHOOK(I,J)*COBMA(J) 1349 : 5004 CONTINUE 1350 : FAC1 = FAC1 + COBMA(I)*VECO1(I) 1351 : FAC2 = FAC2 + COBMA(I)*VECO2(I) 1352 : 5003 CONTINUE 1353 : 1354 : EPSI(NSTRS)=(SIGF(NSTRS)-FAC1)/(UNSURM+FAC2) 1355 : 1356 : DO 5000 I=1,LHOOK 1357 : EPSI(I)=0.D0 1358 : DO 50001 J=1,LHOOK 1359 : EPSI(I)=EPSI(I)+DDHOOK(I,J)* 1360 : . (SIGF(J)+ COBMA(J)*EPSI(NSTRS)) 1361 : 50001 CONTINUE 1362 : 5000 CONTINUE 1363 : ENDIF 1364 : * 1365 : * autres cas 1366 : * 1367 : ELSE 1368 : * 1369 : IF(KCAS.EQ.1) THEN 1370 : DO 5500 I=1,LHOOK 1371 : SIGF(I)=0.D0 1372 : DO 55001 J=1,LHOOK 1373 : SIGF(I)=SIGF(I)+DDHOOK(I,J)*EPSI(J) 1374 : 55001 CONTINUE 1375 : 5500 CONTINUE 1376 : ELSE IF (KCAS.EQ.2) THEN 1377 : DO 6000 I=1,LHOOK 1378 : EPSI(I)=0.D0 1379 : DO 60001 J=1,LHOOK 1380 : EPSI(I)=EPSI(I)+DDHOOK(I,J)*SIGF(J) 1381 : 60001 CONTINUE 1382 : 6000 CONTINUE 1383 : ENDIF 1384 : * 1385 : * cas des tuyaux fissures 1386 : * 1387 : IF (MFR.EQ.17.AND.KCAS.EQ.1) THEN 1388 : * 1389 : MPTVAL=IVAMAT 1390 : MELVAL=IVAL(1) 1391 : IBMN=MIN(IB,VELCHE(/2)) 1392 : IGMN=MIN(IGAU,VELCHE(/1)) 1393 : YOU=VELCHE(IGMN,IBMN) 1394 : * 1395 : RAYO=VALCAR(1) 1396 : EPAI=VALCAR(2) 1397 : TETA1=VALCAR(9)*UNDEMI 1398 : c conversion de teta1 en radian 1399 : TETA = (TETA1 * XPI)/180.D0 1400 : TESPI = TETA/XPI 1401 : c on met dans 'raymo' le rayon moyen du tuyau. 1402 : RAYMO =RAYO - (EPAI/DEUX) 1403 : c calcul de a coefiicient zahor 1404 : RSURT=RAYMO / EPAI 1405 : IF(RSURT.LE.10.D0.AND.RSURT.GE.4.9D0) THEN 1406 : AXX = ( .125D0*RSURT - .25D0 ) **.25D0 1407 : ELSE IF(RSURT.GT.10.D0.AND.RSURT.LE.35.D0) THEN 1408 : AXX = ( .4D0*RSURT - 3.D0 ) **.25D0 1409 : ELSE 1410 : KERRE=4 1411 : ENDIF 1411 : CALL TUFIFP(TESPI,AXX,FP,FM,FMP,FOP,FOM) 1412 : c 1413 : c facteur d intensite des contraintes 1414 : c 1415 : IF(TETA1.LE.(0.5D0))THEN 1416 : SIGF(7)=0.D0 1417 : SIGF(8)=0.D0 1418 : GOTO 6500 1419 : ENDIF 1420 : SQQ= XPI * RAYMO * TETA 1421 : SQQ= SQRT(SQQ) 1422 : XEX= SQQ * FOP/(DEUX * XPI * RAYMO *EPAI) 1423 : XFL= SQQ * FOM/(XPI * RAYMO * RAYMO *EPAI) 1424 : SIGF(7)=XEX * SIGF(1) - XFL * SIGF(6) 1425 : c 1426 : c calcul des aires de breche note technique dre/stre/lma 85/695 1427 : c 1428 : SIGM=SIGF(1)/( DEUX * XPI * RAYMO * EPAI ) 1429 : SIG=SIGF(6)/( XPI * RAYMO * RAYMO * EPAI ) 1430 : XIM= XPI * RAYMO * RAYMO * DEUX * TETA * TETA * FP 1431 : $ /YOU 1432 : XIF= XIM * ( .75D0 +(.25D0 * COS ( TETA ))) 1433 : SIGF(8)=XIM * SIGM - XIF * SIG 1434 : * 1435 : ELSEIF (MFR.EQ.17.AND.KCAS.EQ.2) THEN 1436 : EPSI(7)=0.D0 1437 : EPSI(8)=0.D0 1438 : * 1439 : ENDIF 1440 : * 1441 : * cas des lisp et lism 1442 : * 1443 : IF (MFR.EQ.15.AND.KCAS.EQ.1) THEN 1444 : EPA1=VALCAR(1) 1445 : EPA2=VALCAR(6) 1446 : FISS1=VALCAR(2) 1447 : FISS2=VALCAR(7) 1448 : FISS1 = (FISS1*(UNDEMI +UNDEMI/X774))+ 1449 : + (FISS2*(UNDEMI-UNDEMI/X774)) 1450 : FISS2 = (FISS1*(UNDEMI -UNDEMI/X774))+ 1451 : + (FISS2*(UNDEMI+UNDEMI/X774)) 1452 : W=(EPA1+EPA2)*UNDEMI 1453 : H1=UNDEMI-UNDEMI*S(IGAU) 1454 : H2=UNDEMI+UNDEMI*S(IGAU) 1455 : A= H1*FISS1+H2*FISS2 1456 : ASURW=(H1*FISS1+H2*FISS2)/W 1456 : CALL LISPFI(ASURW,FM,FF) 1457 : X1=SIGF(1)/W 1458 : X4=SIGF(4)*SIX/(W*W) 1459 : XXX=XPI*A 1460 : XXX=SQRT(XXX) 1461 : XKIE=(X1*FM+X4*FF)*XXX 1462 : SIGF(6)= XKIE 1463 : * 1464 : ENDIF 1465 : ENDIF 1466 : * 1467 : 6500 CONTINUE 1468 : 1469 : IF(KERRE.EQ.0) THEN 1470 : c 1471 : c remplissage du segment contenant les contraintes a la fin 1472 : c 1473 : MPTVAL=IVARES 1474 : IF (KCAS.EQ.2) THEN 1475 : DO 7000 ICOMP=1,NRES 1476 : MELVA1=IVAL(ICOMP) 1477 : MELVA1.VELCHE(IGAU,IB)=EPSI(ICOMP) 1478 : 7000 CONTINUE 1479 : ELSE IF (KCAS.EQ.1) THEN 1480 : DO 7001 ICOMP=1,NRES 1481 : MELVA1=IVAL(ICOMP) 1482 : MELVA1.VELCHE(IGAU,IB)=SIGF(ICOMP) 1483 : 7001 CONTINUE 1484 : ENDIF 1485 : ELSE 1486 : * 1487 : * impression de quelques messages d erreurs 1488 : * 1489 : INTERR(1)=IB 1490 : INTERR(2)=IGAU 1491 : MOTERR(1:4)=NOMTP(MELE) 1492 : IF(KERRE.EQ.1) THEN 1492 : CALL ERREUR(301) 1493 : ELSE IF(KERRE.EQ.2) THEN 1493 : CALL ERREUR(300) 1494 : ELSE IF(KERRE.EQ.3) THEN 1495 : MOTERR(1:8)='ELASTI' 1495 : CALL ERREUR(146) 1496 : ELSE IF(KERRE.EQ.4) THEN 1496 : CALL ERREUR(266) 1497 : ELSE IF(KERRE.EQ.49) THEN 1497 : CALL ERREUR(359) 1498 : ENDIF 1499 : SEGSUP IWRK1 1500 : IF (IWRK2.NE.0) SEGSUP IWRK2 1501 : IF(MFR.EQ.33) SEGSUP IWRK4 1502 : GOTO 9990 1503 : ENDIF 1504 : * 1505 : 3000 CONTINUE 1506 : c 1507 : c cas des elements pout : calcul des efforts tranchants 1508 : c 1509 : IF ((MELE.EQ.29.OR.MFR.EQ.13).AND.NBPGAU.EQ.2) THEN 1510 : MPTVAL=IVARES 1511 : SEGINI WPOUT 1512 : IGAU=1 1513 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 1514 : r_x = XE(1,2) - XE(1,1) 1515 : r_y = XE(2,2) - XE(2,1) 1516 : XL=SQRT(r_x*r_x + r_y*r_y) 1517 : XL=1.D00/XL 1518 : DO 3200 ICOMP=1,NRES 1519 : MELVA1=IVAL(ICOMP) 1520 : SIG1(ICOMP)=MELVA1.VELCHE(IGAU,IB) 1521 : SIG2(ICOMP)=MELVA1.VELCHE(IGAU+1,IB) 1522 : 3200 CONTINUE 1523 : r_z = (SIG1(1)+SIG2(1))*0.5D0 1524 : MELVA1=IVAL(1) 1525 : MELVA1.VELCHE(IGAU,IB)=r_z 1526 : MELVA1.VELCHE(IGAU+1,IB)=r_z 1527 : r_z = (SIG1(3)-SIG2(3))*XL 1528 : MELVA1=IVAL(2) 1529 : MELVA1.VELCHE(IGAU,IB)=r_z 1530 : MELVA1.VELCHE(IGAU+1,IB)=r_z 1531 : ELSE 1532 : r_x = XE(1,2) - XE(1,1) 1533 : r_y = XE(2,2) - XE(2,1) 1534 : r_z = XE(3,2) - XE(3,1) 1535 : XL=SQRT(r_x*r_x + r_y*r_y + r_z*r_z) 1536 : XL=1.D0/XL 1537 : DO 3202 ICOMP=1,NRES 1538 : MELVA1=IVAL(ICOMP) 1539 : SIG1(ICOMP)=MELVA1.VELCHE(IGAU,IB) 1540 : SIG2(ICOMP)=MELVA1.VELCHE(IGAU+1,IB) 1541 : 3202 CONTINUE 1542 : r_z = (SIG1(1)+SIG2(1))*0.5D0 1543 : MELVA1=IVAL(1) 1544 : MELVA1.VELCHE(IGAU,IB)=r_z 1545 : MELVA1.VELCHE(IGAU+1,IB)=r_z 1546 : r_z = (SIG1(6)-SIG2(6))*XL 1547 : MELVA1=IVAL(2) 1548 : MELVA1.VELCHE(IGAU,IB)=r_z 1549 : MELVA1.VELCHE(IGAU+1,IB)=r_z 1550 : r_z = (SIG2(5)-SIG1(5))*XL 1551 : MELVA1=IVAL(3) 1552 : MELVA1.VELCHE(IGAU,IB)=r_z 1553 : MELVA1.VELCHE(IGAU+1,IB)=r_z 1554 : ENDIF 1555 : SEGSUP WPOUT 1556 : ENDIF 1557 : c 1558 : 2000 CONTINUE 1559 : * 1560 : SEGSUP IWRK1 1561 : IF (IWRK2.NE.0) SEGSUP IWRK2 1562 : IF (IPMIN2.NE.0) SEGDES MINTE2 1563 : IF(MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59) SEGSUP IWRK4 1564 : SEGDES MELEME 1565 : SEGDES,MINTE 1566 : * 1567 : IF (ISUP2.EQ.1) THEN 1567 : CALL DTMVAL(IVAMAT,3) 1567 : CALL DTMVAL(IVACAR,3) 1568 : ELSE 1568 : CALL DTMVAL(IVAMAT,1) 1568 : CALL DTMVAL(IVACAR,1) 1569 : ENDIF 1570 : * 1571 : IF(IPCHE3.NE.0) THEN 1572 : IF (ISUP3.EQ.1) THEN 1572 : CALL DTMVAL(IVARI,3) 1573 : ELSE 1573 : CALL DTMVAL(IVARI,1) 1574 : ENDIF 1575 : NOMID=MOVARI 1576 : if(lsupva)SEGSUP NOMID 1577 : ENDIF 1578 : * 1579 : IF (ISUP1.EQ.1) THEN 1579 : CALL DTMVAL(IVASTR,3) 1580 : ELSE 1580 : CALL DTMVAL(IVASTR,1) 1581 : ENDIF 1582 : * 1582 : CALL DTMVAL(IVARES,1) 1583 : * 1584 : NOMID=MOMATR 1585 : if(lsupma)SEGSUP NOMID 1586 : NOMID=MOCARA 1587 : IF (MOCARA.NE.0) SEGSUP NOMID 1588 : NOMID=MOSTRS 1589 : if(lsupin)SEGSUP NOMID 1590 : NOMID=MORES 1591 : if(lsupre)SEGSUP NOMID 1592 : IF (IERR.NE.0) GOTO 9992 1593 : * 1594 : 500 CONTINUE 1595 : 1596 : SEGDES MCHEL1 1597 : IRET = 1 1598 : GOTO 9992 1599 : * 1600 : 9990 CONTINUE 1601 : * 1602 : * erreur dans une sous zone, desactivation et retour 1603 : * 1604 : IF (ISUP1.EQ.1) THEN 1604 : CALL DTMVAL(IVASTR,3) 1605 : ELSE 1605 : CALL DTMVAL(IVASTR,1) 1606 : ENDIF 1607 : NOMID=MOSTRS 1608 : if(lsupin)SEGSUP NOMID 1609 : * 1609 : CALL DTMVAL(IVARES,3) 1610 : NOMID=MORES 1611 : if(lsupre)SEGSUP NOMID 1612 : * 1613 : IF (ISUP2.EQ.1) THEN 1613 : CALL DTMVAL(IVAMAT,3) 1613 : CALL DTMVAL(IVACAR,3) 1614 : ELSE 1614 : CALL DTMVAL(IVAMAT,1) 1614 : CALL DTMVAL(IVACAR,1) 1615 : ENDIF 1616 : IF (MOMATR.NE.0) THEN 1617 : NOMID=MOMATR 1618 : if(lsupma)SEGSUP NOMID 1619 : ENDIF 1620 : IF (MOCARA.NE.0) THEN 1621 : NOMID=MOCARA 1622 : SEGSUP NOMID 1623 : ENDIF 1624 : * 1625 : IF(IPCHE3.NE.0) THEN 1626 : IF (ISUP3.EQ.1) THEN 1626 : CALL DTMVAL(IVARI,3) 1627 : ELSE 1627 : CALL DTMVAL(IVARI,1) 1628 : ENDIF 1629 : NOMID=MOVARI 1630 : if(lsupva)SEGSUP NOMID 1631 : ENDIF 1632 : * 1633 : SEGSUP MCHAM1 1634 : SEGSUP MCHEL1 1635 : IRET=0 1636 : 1637 : 9992 CONTINUE 1638 : DO ISOUS=1,NSOUS 1639 : IMODEL=KMODEL(ISOUS) 1640 : SEGDES,IMODEL 1641 : ENDDO 1642 : SEGDES,MMODEL 1643 : 1644 : RETURN 1645 : END 1646 : 1647 : 1648 : 1649 : 1650 : 1651 :
© Cast3M 2003 - All rights reserved.
Disclaimer