1 : C COMVAL SOURCE PV 12/04/11 21:15:03 7351 2 : SUBROUTINE COMVAL(iqmod,indeso,ililuc,iwrk52,iwrk53,ib,igau, 3 : & necou,iecou,xecou,iwr522) 4 : *- 5 : * remplit les tableaux de travail pour la loi au point d integration 6 : *- 7 : ********************************************************************** 8 : * SORTIES 9 : ********************************************************************** 10 : * SECT : section de l'élément IB (éventuel) 11 : * EPAIST : épaisseur et excentrement ( éventuel) 12 : * 13 : ********************************************************************** 14 : * 15 : IMPLICIT INTEGER(I-N) 16 : IMPLICIT REAL*8(A-H,O-Z) 17 : * 18 : -INC CCOPTIO 19 : -INC CCGEOME 20 : -INC SMCHAML 21 : -INC SMELEME 22 : -INC SMCOORD 23 : -INC SMMODEL 24 : -INC SMINTE 25 : -INC CCHAMP 26 : -INC SMEVOLL 27 : -INC SMNUAGE 28 : * segment deroulant le mcheml 29 : -INC DECHE 30 : * 31 : * Segment NECOU utilisé dans ECOINC 32 : * 33 : SEGMENT NECOU 34 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 35 : . ITYP,IFOURB,IFLUAG, 36 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 37 : . JFLUAG,KFLUAG,LFLUAG, 38 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 39 : ENDSEGMENT 40 : * 41 : * Segment IECOU : sert de fourre-tout pour les initialisations 42 : * d'entiers 43 : * 44 : SEGMENT IECOU 45 : INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, 46 : . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, 47 : . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, 48 : . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, 49 : . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, 50 : . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, 51 : . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 52 : ENDSEGMENT 53 : * 54 : * Segment XECOU : sert de fourre-tout pour les initialisations 55 : * de réels 56 : * 57 : SEGMENT XECOU 58 : REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 59 : ENDSEGMENT 60 : * 61 : melval=0 62 : imodel = iqmod 63 : liluc = ililuc 64 : nbluc1 = liluc(/1) 65 : wrk52 = iwrk52 66 : c segact wrk52*mod 67 : wrk53 = iwrk53 68 : c segact wrk53*mod 69 : wrk522=iwr522 70 : * write(6,*) ' entree dans comval wrk522',wrk522 71 : *------------------------------------------------- 72 : * initialisations particulieres 73 : N2EL = 0 74 : N2PTEL=0 75 : * tuyaux (attention ajout de caracteristiques facultatives telles que DENS) 76 : IF (mfrbi.eq.13) THEN 77 : do ic = 1,5 78 : xcarb(ic) = 0.d0 79 : enddo 80 : do ic=6,10 81 : xcarb(ic) = -1.d0 82 : enddo 83 : do ic=11,xcarb(/1) 84 : xcarb(ic) = 0.d0 85 : enddo 86 : ENDIF 87 : IF( ib+igau.ne.2) then 88 : if( mkkalz.EQ.1)then 89 : do 701 ma=1,mkkal0(/1) 90 : if(mkkal0(ma).eq.0) go to 701 91 : deche =mkkal0(ma) 92 : melval=ieldec 93 : if (typdec.eq.'REAL*8') then 94 : IBMN=MIN(IB,VELCHE(/2)) 95 : IGMN=MIN(IGAU,VELCHE(/1)) 96 : scal0(ma)=VELCHE(IGMN,IBMN) 97 : else 98 : IBMN=MIN(IB,IELCHE(/2)) 99 : IGMN=MIN(IGAU,IELCHE(/1)) 100 : scal0(ma)=DBLE(IELCHE(IGMN,IBMN)) 101 : endif 102 : 701 continue 103 : do 7011 ma=1,mkklaf(/1) 104 : if(mkklaf(ma).eq.0) go to 7011 105 : deche =mkklaf(ma) 106 : melval=ieldec 107 : if (typdec.eq.'REAL*8') then 108 : IBMN=MIN(IB,VELCHE(/2)) 109 : IGMN=MIN(IGAU,VELCHE(/1)) 110 : scalf(ma)=VELCHE(IGMN,IBMN) 111 : else 112 : IBMN=MIN(IB,IELCHE(/2)) 113 : IGMN=MIN(IGAU,IELCHE(/1)) 114 : scalf(ma)=DBLE(IELCHE(IGMN,IBMN)) 115 : endif 116 : 7011 continue 117 : endif 118 : if(mkktp0.ne.0) then 119 : deche = mkktp0 120 : melval=ieldec 121 : IBMN=MIN(IB,VELCHE(/2)) 122 : IGMN=MIN(IGAU,VELCHE(/1)) 123 : temp0=VELCHE(IGMN,IBMN) 124 : endif 125 : if(mkktpf.ne.0) then 126 : deche = mkktpf 127 : melval=ieldec 128 : IBMN=MIN(IB,VELCHE(/2)) 129 : IGMN=MIN(IGAU,VELCHE(/1)) 130 : tempf=VELCHE(IGMN,IBMN) 131 : endif 132 : if( mkkplz.EQ.1)then 133 : do 706 ma=1,mkkpl0(/1) 134 : if(mkkpl0(ma).eq.0) go to 706 135 : deche =mkkpl0(ma) 136 : melval=ieldec 137 : if (typdec.eq.'REAL*8') then 138 : IBMN=MIN(IB,VELCHE(/2)) 139 : IGMN=MIN(IGAU,VELCHE(/1)) 140 : depl0(ma)=VELCHE(IGMN,IBMN) 141 : else 142 : IBMN=MIN(IB,IELCHE(/2)) 143 : IGMN=MIN(IGAU,IELCHE(/1)) 144 : depl0(ma)=DBLE(IELCHE(IGMN,IBMN)) 145 : endif 146 : 706 continue 147 : do 7061 ma=1,mkkplf(/1) 148 : if(mkkplf(ma).eq.0) go to 7061 149 : deche =mkkplf(ma) 150 : melval=ieldec 151 : if (typdec.eq.'REAL*8') then 152 : IBMN=MIN(IB,VELCHE(/2)) 153 : IGMN=MIN(IGAU,VELCHE(/1)) 154 : deplf(ma)=VELCHE(IGMN,IBMN) 155 : else 156 : IBMN=MIN(IB,IELCHE(/2)) 157 : IGMN=MIN(IGAU,IELCHE(/1)) 158 : deplf(ma)=DBLE(IELCHE(IGMN,IBMN)) 159 : endif 160 : 7061 continue 161 : endif 162 : if(mkkrcz.eq.1) then 163 : do 707 ma=1,mkkrc0(/1) 164 : if(mkkrc0(ma).eq.0) go to 707 165 : deche =mkkrc0(ma) 166 : melval=ieldec 167 : if (typdec.eq.'REAL*8') then 168 : IBMN=MIN(IB,VELCHE(/2)) 169 : IGMN=MIN(IGAU,VELCHE(/1)) 170 : forc0(ma)=VELCHE(IGMN,IBMN) 171 : else 172 : IBMN=MIN(IB,IELCHE(/2)) 173 : IGMN=MIN(IGAU,IELCHE(/1)) 174 : forc0(ma)=DBLE(IELCHE(IGMN,IBMN)) 175 : endif 176 : 707 continue 177 : do 7071 ma=1,mkkrcf(/1) 178 : if(mkkrcf(ma).eq.0) go to 7071 179 : deche =mkkrcf(ma) 180 : melval=ieldec 181 : if (typdec.eq.'REAL*8') then 182 : IBMN=MIN(IB,VELCHE(/2)) 183 : IGMN=MIN(IGAU,VELCHE(/1)) 184 : forcf(ma)=VELCHE(IGMN,IBMN) 185 : else 186 : IBMN=MIN(IB,IELCHE(/2)) 187 : IGMN=MIN(IGAU,IELCHE(/1)) 188 : forcf(ma)=DBLE(IELCHE(IGMN,IBMN)) 189 : endif 190 : 7071 continue 191 : endif 192 : if(mkkadz.eq.1) then 193 : do 710 ma=1,mkkad0(/1) 194 : if(mkkad0(ma).eq.0) go to 710 195 : deche =mkkad0(ma) 196 : melval=ieldec 197 : if (typdec.eq.'REAL*8') then 198 : IBMN=MIN(IB,VELCHE(/2)) 199 : IGMN=MIN(IGAU,VELCHE(/1)) 200 : grad0(ma)=VELCHE(IGMN,IBMN) 201 : else 202 : IBMN=MIN(IB,IELCHE(/2)) 203 : IGMN=MIN(IGAU,IELCHE(/1)) 204 : grad0(ma)=DBLE(IELCHE(IGMN,IBMN)) 205 : endif 206 : 710 continue 207 : do 7101 ma=1,mkkadf(/1) 208 : if(mkkadf(ma).eq.0) go to 7101 209 : deche =mkkadf(ma) 210 : melval=ieldec 211 : if (typdec.eq.'REAL*8') then 212 : IBMN=MIN(IB,VELCHE(/2)) 213 : IGMN=MIN(IGAU,VELCHE(/1)) 214 : gradf(ma)=VELCHE(IGMN,IBMN) 215 : else 216 : IBMN=MIN(IB,IELCHE(/2)) 217 : IGMN=MIN(IGAU,IELCHE(/1)) 218 : gradf(ma)=DBLE(IELCHE(IGMN,IBMN)) 219 : endif 220 : 7101 continue 221 : endif 222 : if(mkkigz.eq.1) then 223 : do 711 ma=1,mkkig0(/1) 224 : if(mkkig0(ma).eq.0) go to 711 225 : deche =mkkig0(ma) 226 : melval=ieldec 227 : if (typdec.eq.'REAL*8') then 228 : IBMN=MIN(IB,VELCHE(/2)) 229 : IGMN=MIN(IGAU,VELCHE(/1)) 230 : sig0(ma)=VELCHE(IGMN,IBMN) 231 : else 232 : IBMN=MIN(IB,IELCHE(/2)) 233 : IGMN=MIN(IGAU,IELCHE(/1)) 234 : sig0(ma)=DBLE(IELCHE(IGMN,IBMN)) 235 : endif 236 : 711 continue 237 : do 7111 ma=1,mkkigf(/1) 238 : if(mkkigf(ma).eq.0) go to 7111 239 : deche =mkkigf(ma) 240 : melval=ieldec 241 : if (typdec.eq.'REAL*8') then 242 : IBMN=MIN(IB,VELCHE(/2)) 243 : IGMN=MIN(IGAU,VELCHE(/1)) 244 : sigf(ma)=VELCHE(IGMN,IBMN) 245 : else 246 : IBMN=MIN(IB,IELCHE(/2)) 247 : IGMN=MIN(IGAU,IELCHE(/1)) 248 : sigf(ma)=DBLE(IELCHE(IGMN,IBMN)) 249 : endif 250 : 7111 continue 251 : endif 252 : if(mkkstz.eq.1) then 253 : do 712 ma=1,mkkst0(/1) 254 : if(mkkst0(ma).eq.0) go to 712 255 : deche =mkkst0(ma) 256 : melval=ieldec 257 : if (typdec.eq.'REAL*8') then 258 : IBMN=MIN(IB,VELCHE(/2)) 259 : IGMN=MIN(IGAU,VELCHE(/1)) 260 : epst0(ma)=VELCHE(IGMN,IBMN) 261 : else 262 : IBMN=MIN(IB,IELCHE(/2)) 263 : IGMN=MIN(IGAU,IELCHE(/1)) 264 : epst0(ma)=DBLE(IELCHE(IGMN,IBMN)) 265 : endif 266 : 712 continue 267 : do 7121 ma=1,mkkstf(/1) 268 : if(mkkstf(ma).eq.0) go to 7121 269 : deche =mkkstf(ma) 270 : melval=ieldec 271 : if (typdec.eq.'REAL*8') then 272 : IBMN=MIN(IB,VELCHE(/2)) 273 : IGMN=MIN(IGAU,VELCHE(/1)) 274 : epstf(ma)=VELCHE(IGMN,IBMN) 275 : else 276 : IBMN=MIN(IB,IELCHE(/2)) 277 : IGMN=MIN(IGAU,IELCHE(/1)) 278 : epstf(ma)=DBLE(IELCHE(IGMN,IBMN)) 279 : endif 280 : 7121 continue 281 : endif 282 : * 283 : * pour les materiaux et dls caracteristiques on passe dans 284 : * l'ancienne programmation 285 : 286 : if( mkkrez.eq.1) then 287 : do 715 ma=1,mkkre0(/1) 288 : if(mkkre0(ma).eq.0) go to 715 289 : deche =mkkre0(ma) 290 : melval=ieldec 291 : if (typdec.eq.'REAL*8') then 292 : IBMN=MIN(IB,VELCHE(/2)) 293 : IGMN=MIN(IGAU,VELCHE(/1)) 294 : ture0(ma)=VELCHE(IGMN,IBMN) 295 : else 296 : IBMN=MIN(IB,IELCHE(/2)) 297 : IGMN=MIN(IGAU,IELCHE(/1)) 298 : ture0(ma)=DBLE(IELCHE(IGMN,IBMN)) 299 : endif 300 : 715 continue 301 : do 7151 ma=1,mkkref(/1) 302 : if(mkkref(ma).eq.0) go to 7151 303 : deche =mkkref(ma) 304 : melval=ieldec 305 : if (typdec.eq.'REAL*8') then 306 : IBMN=MIN(IB,VELCHE(/2)) 307 : IGMN=MIN(IGAU,VELCHE(/1)) 308 : turef(ma)=VELCHE(IGMN,IBMN) 309 : else 310 : IBMN=MIN(IB,IELCHE(/2)) 311 : IGMN=MIN(IGAU,IELCHE(/1)) 312 : turef(ma)=DBLE(IELCHE(IGMN,IBMN)) 313 : endif 314 : 7151 continue 315 : endif 316 : if( mkkinz.eq.1) then 317 : 318 : do 716 ma=1,mkkin0(/1) 319 : if(mkkin0(ma).eq.0) go to 716 320 : deche =mkkin0(ma) 321 : melval=ieldec 322 : if (typdec.eq.'REAL*8') then 323 : IBMN=MIN(IB,VELCHE(/2)) 324 : IGMN=MIN(IGAU,VELCHE(/1)) 325 : prin0(ma)=VELCHE(IGMN,IBMN) 326 : else 327 : IBMN=MIN(IB,IELCHE(/2)) 328 : IGMN=MIN(IGAU,IELCHE(/1)) 329 : prin0(ma)=DBLE(IELCHE(IGMN,IBMN)) 330 : endif 331 : 716 continue 332 : do 7161 ma=1,mkkinf(/1) 333 : if(mkkinf(ma).eq.0) go to 7161 334 : deche =mkkinf(ma) 335 : melval=ieldec 336 : if (typdec.eq.'REAL*8') then 337 : IBMN=MIN(IB,VELCHE(/2)) 338 : IGMN=MIN(IGAU,VELCHE(/1)) 339 : prinf(ma)=VELCHE(IGMN,IBMN) 340 : else 341 : IBMN=MIN(IB,IELCHE(/2)) 342 : IGMN=MIN(IGAU,IELCHE(/1)) 343 : prinf(ma)=DBLE(IELCHE(IGMN,IBMN)) 344 : endif 345 : 7161 continue 346 : endif 347 : if(mkkhoz.eq.1) then 348 : do 717 ma=1,mkkho0(/1) 349 : if(mkkho0(ma).eq.0) go to 717 350 : deche =mkkho0(ma) 351 : melval=ieldec 352 : if (typdec.eq.'REAL*8') then 353 : IBMN=MIN(IB,VELCHE(/2)) 354 : IGMN=MIN(IGAU,VELCHE(/1)) 355 : maho0(ma)=VELCHE(IGMN,IBMN) 356 : else 357 : IBMN=MIN(IB,IELCHE(/2)) 358 : IGMN=MIN(IGAU,IELCHE(/1)) 359 : maho0(ma)=DBLE(IELCHE(IGMN,IBMN)) 360 : endif 361 : 717 continue 362 : do 7171 ma=1,mkkhof(/1) 363 : if(mkkhof(ma).eq.0) go to 7171 364 : deche =mkkhof(ma) 365 : melval=ieldec 366 : if (typdec.eq.'REAL*8') then 367 : IBMN=MIN(IB,VELCHE(/2)) 368 : IGMN=MIN(IGAU,VELCHE(/1)) 369 : mahof(ma)=VELCHE(IGMN,IBMN) 370 : else 371 : IBMN=MIN(IB,IELCHE(/2)) 372 : IGMN=MIN(IGAU,IELCHE(/1)) 373 : mahof(ma)=DBLE(IELCHE(IGMN,IBMN)) 374 : endif 375 : 7171 continue 376 : endif 377 : if(mkktaz.eq.1) then 378 : do 718 ma=1,mkkta0(/1) 379 : if(mkkta0(ma).eq.0) go to 718 380 : deche =mkkta0(ma) 381 : melval=ieldec 382 : if (typdec.eq.'REAL*8') then 383 : IBMN=MIN(IB,VELCHE(/2)) 384 : IGMN=MIN(IGAU,VELCHE(/1)) 385 : hota0(ma)=VELCHE(IGMN,IBMN) 386 : else 387 : IBMN=MIN(IB,IELCHE(/2)) 388 : IGMN=MIN(IGAU,IELCHE(/1)) 389 : hota0(ma)=DBLE(IELCHE(IGMN,IBMN)) 390 : endif 391 : 718 continue 392 : do 7181 ma=1,mkktaf(/1) 393 : if(mkktaf(ma).eq.0) go to 7181 394 : deche =mkktaf(ma) 395 : melval=ieldec 396 : if (typdec.eq.'REAL*8') then 397 : IBMN=MIN(IB,VELCHE(/2)) 398 : IGMN=MIN(IGAU,VELCHE(/1)) 399 : hotaf(ma)=VELCHE(IGMN,IBMN) 400 : else 401 : IBMN=MIN(IB,IELCHE(/2)) 402 : IGMN=MIN(IGAU,IELCHE(/1)) 403 : hotaf(ma)=DBLE(IELCHE(IGMN,IBMN)) 404 : endif 405 : 7181 continue 406 : endif 407 : if(mkkvrz.eq.1) then 408 : do 720 ma=1,mkkvr0(/1) 409 : if(mkkvr0(ma).eq.0) go to 720 410 : deche =mkkvr0(ma) 411 : melval=ieldec 412 : if (typdec.eq.'REAL*8') then 413 : IBMN=MIN(IB,VELCHE(/2)) 414 : IGMN=MIN(IGAU,VELCHE(/1)) 415 : var0(ma)=VELCHE(IGMN,IBMN) 416 : else 417 : IBMN=MIN(IB,IELCHE(/2)) 418 : IGMN=MIN(IGAU,IELCHE(/1)) 419 : var0(ma)=DBLE(IELCHE(IGMN,IBMN)) 420 : endif 421 : 720 continue 422 : do 7201 ma=1,mkkvrf(/1) 423 : if(mkkvrf(ma).eq.0) go to 7201 424 : deche =mkkvrf(ma) 425 : melval=ieldec 426 : if (typdec.eq.'REAL*8') then 427 : IBMN=MIN(IB,VELCHE(/2)) 428 : IGMN=MIN(IGAU,VELCHE(/1)) 429 : varf(ma)=VELCHE(IGMN,IBMN) 430 : else 431 : IBMN=MIN(IB,IELCHE(/2)) 432 : IGMN=MIN(IGAU,IELCHE(/1)) 433 : varf(ma)=DBLE(IELCHE(IGMN,IBMN)) 434 : endif 435 : 7201 continue 436 : endif 437 : if( mkkafz.eq.1) then 438 : do 721 ma=1,mkkaf0(/1) 439 : if(mkkaf0(ma).eq.0) go to 721 440 : deche =mkkaf0(ma) 441 : melval=ieldec 442 : if (typdec.eq.'REAL*8') then 443 : IBMN=MIN(IB,VELCHE(/2)) 444 : IGMN=MIN(IGAU,VELCHE(/1)) 445 : graf0(ma)=VELCHE(IGMN,IBMN) 446 : else 447 : IBMN=MIN(IB,IELCHE(/2)) 448 : IGMN=MIN(IGAU,IELCHE(/1)) 449 : graf0(ma)=DBLE(IELCHE(IGMN,IBMN)) 450 : endif 451 : 721 continue 452 : do 7211 ma=1,mkkaff(/1) 453 : if(mkkaff(ma).eq.0) go to 7211 454 : deche =mkkaff(ma) 455 : melval=ieldec 456 : if (typdec.eq.'REAL*8') then 457 : IBMN=MIN(IB,VELCHE(/2)) 458 : IGMN=MIN(IGAU,VELCHE(/1)) 459 : graff(ma)=VELCHE(IGMN,IBMN) 460 : else 461 : IBMN=MIN(IB,IELCHE(/2)) 462 : IGMN=MIN(IGAU,IELCHE(/1)) 463 : graff(ma)=DBLE(IELCHE(IGMN,IBMN)) 464 : endif 465 : 7211 continue 466 : endif 467 : if(mkkasz.eq.1) then 468 : do 723 ma=1,mkkas0(/1) 469 : if(mkkas0(ma).eq.0) go to 723 470 : deche =mkkas0(ma) 471 : melval=ieldec 472 : if (typdec.eq.'REAL*8') then 473 : IBMN=MIN(IB,VELCHE(/2)) 474 : IGMN=MIN(IGAU,VELCHE(/1)) 475 : rhas0(ma)=VELCHE(IGMN,IBMN) 476 : else 477 : IBMN=MIN(IB,IELCHE(/2)) 478 : IGMN=MIN(IGAU,IELCHE(/1)) 479 : rhas0(ma)=DBLE(IELCHE(IGMN,IBMN)) 480 : endif 481 : 723 continue 482 : do 7231 ma=1,mkkasf(/1) 483 : if(mkkasf(ma).eq.0) go to 7231 484 : deche =mkkasf(ma) 485 : melval=ieldec 486 : if (typdec.eq.'REAL*8') then 487 : IBMN=MIN(IB,VELCHE(/2)) 488 : IGMN=MIN(IGAU,VELCHE(/1)) 489 : rhasf(ma)=VELCHE(IGMN,IBMN) 490 : else 491 : IBMN=MIN(IB,IELCHE(/2)) 492 : IGMN=MIN(IGAU,IELCHE(/1)) 493 : rhasf(ma)=DBLE(IELCHE(IGMN,IBMN)) 494 : endif 495 : 7231 continue 496 : endif 497 : if(mkkpnz.eq.1) then 498 : do 724 ma=1,mkkpn0(/1) 499 : if(mkkpn0(ma).eq.0) go to 724 500 : deche =mkkpn0(ma) 501 : melval=ieldec 502 : if (typdec.eq.'REAL*8') then 503 : IBMN=MIN(IB,VELCHE(/2)) 504 : IGMN=MIN(IGAU,VELCHE(/1)) 505 : epin0(ma)=VELCHE(IGMN,IBMN) 506 : else 507 : IBMN=MIN(IB,IELCHE(/2)) 508 : IGMN=MIN(IGAU,IELCHE(/1)) 509 : epin0(ma)=DBLE(IELCHE(IGMN,IBMN)) 510 : endif 511 : 724 continue 512 : do 7241 ma=1,mkkpnf(/1) 513 : if(mkkpnf(ma).eq.0) go to 7241 514 : deche =mkkpnf(ma) 515 : melval=ieldec 516 : if (typdec.eq.'REAL*8') then 517 : IBMN=MIN(IB,VELCHE(/2)) 518 : IGMN=MIN(IGAU,VELCHE(/1)) 519 : epinf(ma)=VELCHE(IGMN,IBMN) 520 : else 521 : IBMN=MIN(IB,IELCHE(/2)) 522 : IGMN=MIN(IGAU,IELCHE(/1)) 523 : epinf(ma)=DBLE(IELCHE(IGMN,IBMN)) 524 : endif 525 : 7241 continue 526 : endif 527 : if (mkkexz.eq.1) then 528 : do 725 ma=1,mkkex0(/1) 529 : if(mkkex0(ma).eq.0) go to 725 530 : deche =mkkex0(ma) 531 : melval=ieldec 532 : if (typdec.eq.'REAL*8') then 533 : IBMN=MIN(IB,VELCHE(/2)) 534 : IGMN=MIN(IGAU,VELCHE(/1)) 535 : parex0(ma)=VELCHE(IGMN,IBMN) 536 : else 537 : IBMN=MIN(IB,IELCHE(/2)) 538 : IGMN=MIN(IGAU,IELCHE(/1)) 539 : parex0(ma)=DBLE(IELCHE(IGMN,IBMN)) 540 : endif 541 : 725 continue 542 : do 7251 ma=1,mkkexf(/1) 543 : if(mkkexf(ma).eq.0) go to 7251 544 : deche =mkkexf(ma) 545 : melval=ieldec 546 : if (typdec.eq.'REAL*8') then 547 : IBMN=MIN(IB,VELCHE(/2)) 548 : IGMN=MIN(IGAU,VELCHE(/1)) 549 : parexf(ma)=VELCHE(IGMN,IBMN) 550 : else 551 : IBMN=MIN(IB,IELCHE(/2)) 552 : IGMN=MIN(IGAU,IELCHE(/1)) 553 : parexf(ma)=DBLE(IELCHE(IGMN,IBMN)) 554 : endif 555 : 7251 continue 556 : endif 557 : if(mkkvxz.eq.1) then 558 : do 726 ma=1,mkkvx0(/1) 559 : if(mkkvx0(ma).eq.0) go to 726 560 : deche =mkkvx0(ma) 561 : melval=ieldec 562 : if (typdec.eq.'REAL*8') then 563 : IBMN=MIN(IB,VELCHE(/2)) 564 : IGMN=MIN(IGAU,VELCHE(/1)) 565 : exova0(ma)=VELCHE(IGMN,IBMN) 566 : else 567 : IBMN=MIN(IB,IELCHE(/2)) 568 : IGMN=MIN(IGAU,IELCHE(/1)) 569 : exova0(ma)=DBLE(IELCHE(IGMN,IBMN)) 570 : endif 571 : 726 continue 572 : do 7261 ma=1,mkkvx1(/1) 573 : if(mkkvx1(ma).eq.0) go to 7261 574 : deche =mkkvx1(ma) 575 : melval=ieldec 576 : if (typdec.eq.'REAL*8') then 577 : IBMN=MIN(IB,VELCHE(/2)) 578 : IGMN=MIN(IGAU,VELCHE(/1)) 579 : exova1(ma)=VELCHE(IGMN,IBMN) 580 : else 581 : IBMN=MIN(IB,IELCHE(/2)) 582 : IGMN=MIN(IGAU,IELCHE(/1)) 583 : exova1(ma)=DBLE(IELCHE(IGMN,IBMN)) 584 : endif 585 : 7261 continue 586 : 587 : endif 588 : 589 : endif 590 : *------------------------------------------------- 591 : if( ib+IGAu.eq.2) THEN 592 : idepup=1 593 : ifinup=nbluc1 594 : else 595 : idepup=13 596 : ifinup=14 597 : endif 598 : * copie les valeurs au point d integration dans wrk52 599 : do 1000 ino = idepup,ifinup 600 : domdec = liluc(ino) 601 : c segact domdec*nomod 602 : nomid = jnomid 603 : c segact nomid 604 : pilnec = jilnec 605 : if (pilnec.le.0) goto 1000 606 : c segact pilnec*nomod 607 : mran = pilobl(/2) 608 : mobl = pilobl(/1) 609 : mfac = pilfac(/1) 610 : if (mran.le.0) goto 1000 611 : do 3000 ir = 1,mran 612 : deche=0 613 : if (mobl.le.0) goto 101 614 : do 100 ic = 1,mobl 615 : passe1= 0.d0 616 : ipilo1 = pilobl(ic,ir) 617 : * attention les valeurs induites par deche (nomdec, typdec)ne sont pas effacees 618 : if (pilobl(ic,ir).gt.0) then 619 : deche = pilobl(ic,ir) 620 : c segact deche 621 : * on evite les deche crees pour le modele 622 : * write(6,*) ino,ir,ic,deche,nomdec,typdec,condec 623 : if (ir.eq.indeso.and.condec.eq.conmod) goto 100 624 : melval = ieldec 625 : c segact melval 626 : if (typdec.eq.'REAL*8') then 627 : IBMN=MIN(IB,VELCHE(/2)) 628 : IGMN=MIN(IGAU,VELCHE(/1)) 629 : passe1=VELCHE(IGMN,IBMN) 630 : else 631 : IBMN=MIN(IB,IELCHE(/2)) 632 : IGMN=MIN(IGAU,IELCHE(/1)) 633 : passe1=DBLE(IELCHE(IGMN,IBMN)) 634 : endif 635 : endif 636 : * 637 : * AIGUILLAGE SUIVANT MOT CLE 638 : * 639 : if (ino.gt.nmot) goto 98 640 : GOTO ( 1, 2, 99, 99, 99, 6, 7,99,99,10,11,12,13,14,15,16, 17,18, 641 : 1 99,20,21,99,23,24,25) ino 642 : * 643 : 99 CONTINUE 644 : c pas de composantes pour ce champ 645 : RETURN 646 : * 647 : 1 if (ipilo1.le.0) goto 100 648 : if (ir.eq.1) then 649 : scal0(ic) = passe1 650 : mkkal0(ic)=deche 651 : else if (ir.ge.(mran -1)) then 652 : scalf(ic) = passe1 653 : mkklaf(ic)=deche 654 : endif 655 : if(deche.ne.0) mkkalz=1 656 : GOTO 120 657 : * 658 : 2 continue 659 : if (ipilo1.le.0) goto 100 660 : if (ir.eq.1) then 661 : temp0 = passe1 662 : mkktp0=deche 663 : else if (ir.ge.(mran -1)) then 664 : tempf = passe1 665 : mkktpf=deche 666 : endif 667 : if (tempf.lt.temp0 .and. ir.gt.1) then 668 : * pas de temps negatif constituant m1%8 669 : * write(ioimp,*) 'pas de temps negatif constituant ', condec, 670 : * & deche,temp0, tempf 671 : C* moterr(1:8) = condec 671 : call erreur(414) 672 : return 673 : endif 674 : GOTO 120 675 : * 676 : * 677 : 6 if (ipilo1.le.0) goto 100 678 : if (ir.eq.1) then 679 : depl0(ic) = passe1 680 : mkkpl0(ic)=deche 681 : else if (ir.ge.(mran -1)) then 682 : deplf(ic) = passe1 683 : mkkplf(ic)=deche 684 : endif 685 : if(deche.ne.0) mkkplz=1 686 : GOTO 120 687 : * 688 : 7 if (ipilo1.le.0) goto 100 689 : if (ir.eq.1) then 690 : forc0(ic) = passe1 691 : mkkrc0(ic)=deche 692 : else if (ir.ge.(mran -1)) then 693 : forcf(ic) = passe1 694 : mkkrcf(ic)=deche 695 : endif 696 : if(deche.ne.0) mkkrcz=1 697 : GOTO 120 698 : * 699 : 10 if (ipilo1.le.0) goto 100 700 : if (ir.eq.1) then 701 : grad0(ic) = passe1 702 : mkkad0(ic)=deche 703 : else if (ir.ge.(mran -1)) then 704 : gradf(ic) = passe1 705 : mkkadf(ic)=deche 706 : endif 707 : if(deche.ne.0) mkkadz=1 708 : GOTO 120 709 : * 710 : 11 if (ipilo1.le.0) goto 100 711 : if (ir.eq.1) then 712 : SIG0(ic) = passe1 713 : mkkig0(ic)=deche 714 : else if (ir.ge.(mran -1)) then 715 : SIGF(ic) = passe1 716 : mkkigf(ic)=deche 717 : endif 718 : if(deche.ne.0) mkkigz=1 719 : GOTO 120 720 : * 721 : 12 if (ipilo1.le.0) goto 100 722 : if (ir.eq.1) then 723 : epst0(ic) = passe1 724 : mkkst0(ic) =deche 725 : else if (ir.gt.1.and.ir.le.mran) then 726 : epstf(ic) = passe1 727 : mkkstf(ic) = deche 728 : endif 729 : if(deche.ne.0) mkkstz=1 730 : GOTO 120 731 : 732 : * caracteristiques materiau 733 : 13 continue 734 : if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then 735 : commat(ic) = lesobl(ic) 736 : tyval(ic) = 'REAL*8 ' 737 : endif 738 : if (ir.gt.1) then 739 : if (ir.eq.1) 740 : > write (6,*) ' dans comval ivalma mobl ic ',ivalma(/1),mobl,ic 741 : ivalma(ic) = 0 742 : if (ipilo1.gt.0) ivalma(ic) = ieldec 743 : endif 744 : if (ipilo1.le.0) goto 100 745 : if (ir.eq.1) then 746 : valma0(ic) = passe1 747 : mkkva0(ic)=deche 748 : elseif (ir.gt.1.and.ir.le.(mran -1)) then 749 : VALMAT(ic) = passe1 750 : mkkvat(ic)=deche 751 : tyval (ic)= typdec 752 : xmatf(ic) = passe1 753 : mkkatf(ic)=deche 754 : else if (ir.eq.mran ) then 755 : xmatf(ic) = passe1 756 : mkkatf(ic)=deche 757 : endif 758 : if (igau.eq.1.and.ib.eq.1) then 759 : IF (CMATE.EQ.'SECTION') THEN 760 : N2PTEL=MAX(N2PTEL,IELCHE(/1)) 761 : N2EL =MAX(N2EL ,IELCHE(/2)) 762 : ELSE 763 : N2PTEL=MAX(N2PTEL,VELCHE(/1)) 764 : N2EL =MAX(N2EL ,VELCHE(/2)) 765 : ENDIF 766 : endif 767 : GOTO 120 768 : 769 : * caracteristiques geometriques 770 : 14 if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then 771 : comcar(ic) = lesobl(ic) 772 : tycar(ic) = 'REAL*8 ' 773 : endif 774 : mblcar=mobl 775 : if (ipilo1.le.0.and.mfrbi.ne.9.and.mfrbi.ne.3) goto 100 776 : if (ir.eq.1) then 777 : xcar0(ic) = passe1 778 : mkkar0(ic)=deche 779 : elseif (ir.gt.1.and.ir.le.(mran-1)) then 780 : tycar(ic) = typdec 781 : XCARB(ic) = passe1 782 : mkkarb(ic)=deche 783 : xcarbf(ic) = passe1 784 : mkkrbf(ic)=deche 785 : * 786 : * tuyaux 787 : * 788 : IF (mfrbi.eq.13) THEN 789 : C 790 : C Poutre 3D 791 : C 792 : ELSE IF(MFRbi.EQ.7.AND.IDIM.EQ.3)THEN 793 : C 794 : C Poutre 2D 795 : C 796 : ELSEIF(IDIM.EQ.2) THEN 797 : if (ipilo1.le.0.and.ic.eq.2) then 798 : IF(MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN 799 : XCARB(IC)=0.66666666666666D0 800 : ENDIF 801 : endif 802 : ELSE 803 : * cas des coques minces : défaut de alfah 804 : IF (ipilo1.le.0.and.IC.EQ.2.AND. 805 : & (MFRbi.EQ.3.OR.MFRbi.EQ.9)) THEN 806 : XCARB(IC)=0.666666666666666D0 807 : ENDIF 808 : C 809 : ENDIF 810 : 811 : else if (ir.eq.mran) then 812 : xcarbf(ic) = passe1 813 : mkkrbf(ic)=deche 814 : endif 815 : if(deche.ne.0) mkkarz=1 816 : GOTO 120 817 : * 818 : 15 if (ipilo1.le.0) goto 100 819 : if (ir.eq.1) then 820 : ture0(ic) = passe1 821 : mkkre0(ic)=deche 822 : else if (ir.ge.(mran -1)) then 823 : turef(ic) = passe1 824 : mkkref(ic)=deche 825 : endif 826 : if(deche.ne.0) mkkrez=1 827 : GOTO 120 828 : * 829 : 16 if (ipilo1.le.0) goto 100 830 : if (ir.eq.1) then 831 : prin0(ic) = passe1 832 : mkkin0(ic)=deche 833 : else if (ir.ge.(mran -1)) then 834 : prinf(ic) = passe1 835 : mkkinf(ic)=deche 836 : endif 837 : if(deche.ne.0) mkkinz=1 838 : GOTO 120 839 : * 840 : 17 if (ipilo1.le.0) goto 100 841 : if (ir.eq.1) then 842 : maho0(ic) = passe1 843 : mkkho0(ic)=deche 844 : else if (ir.ge.(mran -1)) then 845 : mahof(ic) = passe1 846 : mkkhof(ic)=deche 847 : endif 848 : if(deche.ne.0) mkkhoz=1 849 : GOTO 120 850 : * 851 : 18 if (ipilo1.le.0) goto 100 852 : if (ir.eq.1) then 853 : hota0(ic) = passe1 854 : mkkta0(ic)=deche 855 : else if (ir.ge.(mran -1)) then 856 : hotaf(ic) = passe1 857 : mkktaf(ic)=deche 858 : endif 859 : if(deche.ne.0) mkktaz=1 860 : GOTO 120 861 : * 862 : 20 if (ipilo1.le.0) goto 100 863 : if (ir.eq.1) then 864 : VAR0(ic) = passe1 865 : mkkvr0(ic)=deche 866 : else if (ir.ge.(mran -1)) then 867 : VARF(ic) = passe1 868 : mkkvrf(ic)=deche 869 : endif 870 : if(deche.ne.0) mkkvrz=1 871 : GOTO 120 872 : * 873 : 21 if (ipilo1.le.0) goto 100 874 : if (ir.eq.1) then 875 : graf0(ic) = passe1 876 : mkkaf0(ic)=deche 877 : else if (ir.ge.(mran -1)) then 878 : graff(ic) = passe1 879 : mkkaff(ic)=deche 880 : endif 881 : if(deche.ne.0) mkkafz=1 882 : GOTO 120 883 : * 884 : 23 if (ipilo1.le.0) goto 100 885 : if (ir.eq.1) then 886 : rhas0(ic) = passe1 887 : mkkas0(ic)=deche 888 : else if (ir.ge.(mran -1)) then 889 : rhasf(ic) = passe1 890 : mkkasf(ic)=deche 891 : endif 892 : if(deche.ne.0) mkkasz=1 893 : GOTO 120 894 : * 895 : 24 if (ipilo1.le.0) goto 100 896 : if (ir.eq.1) then 897 : EPIN0(ic) = passe1 898 : mkkpn0(ic)=deche 899 : else if (ir.ge.(mran -1)) then 900 : EPINF(ic) = passe1 901 : mkkpnf(ic)=deche 902 : endif 903 : if(deche.ne.0) mkkpnz=1 904 : GOTO 120 905 : * 906 : 25 if (ipilo1.le.0) goto 100 907 : if (ir.eq.1) then 908 : PAREX0(ic) = passe1 909 : mkkex0(ic)=deche 910 : else if (ir.ge.(mran -1)) then 911 : PAREXF(ic) = passe1 912 : mkkexf(ic)=deche 913 : endif 914 : if(deche.ne.0) mkkexz=1 915 : GOTO 120 916 : * 917 : 98 if (ipilo1.le.0) goto 100 918 : if (ir.eq.1) then 919 : exova0(ic) = passe1 920 : mkkvx0(ic)=deche 921 : else if (ir.ge.(mran -1)) then 922 : exova1(ic) = passe1 923 : mkkvx1(ic)=deche 924 : endif 925 : if (nomexo(ic).eq.'STEP') istep = int(exova0(ic)) 926 : if(deche.ne.0) mkkvxz=1 927 : GOTO 120 928 : * 929 : 120 CONTINUE 930 : * 931 : 100 continue 932 : 933 : 101 continue 934 : * 935 : * if (mfac.le.0) goto 301 936 : do 200 ic = 1,mfac 937 : passe1= 0.d0 938 : ipilo2 = pilfac(ic,ir) 939 : if (pilfac(ic,ir).gt.0) then 940 : deche = pilfac(ic,ir) 941 : c segact deche 942 : * on evite les deche crees pour le modele 943 : * if (ib.eq.1.and.igau.eq.1) 944 : * & write(6,*) ino,ir,ic,deche,nomdec,typdec,condec 945 : if (ir.eq.indeso.and.condec.eq.conmod) goto 200 946 : melval = ieldec 947 : c segact melval 948 : if (typdec.eq.'REAL*8') then 949 : IBMN=MIN(IB,VELCHE(/2)) 950 : IGMN=MIN(IGAU,VELCHE(/1)) 951 : passe1=VELCHE(IGMN,IBMN) 952 : else 953 : IBMN=MIN(IB,IELCHE(/2)) 954 : IGMN=MIN(IGAU,IELCHE(/1)) 955 : passe1=DBLE(IELCHE(IGMN,IBMN)) 956 : endif 957 : endif 958 : * 959 : * AIGUILLAGE SUIVANT MOT CLE 960 : * 961 : if (ino.gt.nmot) goto 298 962 : GOTO ( 201,202,299,299,299,206, 207,299,299,210,211, 963 : & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino 964 : * 965 : 299 CONTINUE 966 : c pas de composantes pour ce champ 967 : RETURN 968 : * 969 : 201 if (ipilo2.le.0) goto 200 970 : if (ir.eq.1) then 971 : scal0(mobl+ic) = passe1 972 : mkkal0(ic+mobl)=deche 973 : else if (ir.ge.(mran -1)) then 974 : scalf(mobl+ic) = passe1 975 : mkklaf(ic+mobl)=deche 976 : endif 977 : if(deche.ne.0) mkkalz=1 978 : GOTO 320 979 : * 980 : 202 if (ipilo2.le.0) goto 200 981 : * bizarre de passer la ... 982 : GOTO 320 983 : * 984 : 206 if (ipilo2.le.0) goto 200 985 : if (ir.eq.1) then 986 : depl0(mobl+ic) = passe1 987 : mkkpl0(ic+mobl)=deche 988 : else if (ir.ge.(mran -1)) then 989 : deplf(mobl+ic) = passe1 990 : mkkplf(ic+mobl)=deche 991 : endif 992 : if(deche.ne.0) mkkplz=1 993 : GOTO 320 994 : * 995 : 207 if (ipilo2.le.0) goto 200 996 : if (ir.eq.1) then 997 : forc0(mobl+ic) = passe1 998 : mkkrc0(ic+mobl)=deche 999 : else if (ir.ge.(mran -1)) then 1000 : forcf(mobl+ic) = passe1 1001 : mkkrcf(ic+mobl)=deche 1002 : endif 1003 : if(deche.ne.0) mkkrcz=1 1004 : GOTO 320 1005 : * 1006 : 210 if (ipilo2.le.0) goto 200 1007 : if (ir.eq.1) then 1008 : grad0(mobl+ic) = passe1 1009 : mkkad0(ic+mobl)=deche 1010 : else if (ir.ge.(mran -1)) then 1011 : gradf(mobl+ic) = passe1 1012 : mkkadf(ic+mobl)=deche 1013 : endif 1014 : if(deche.ne.0) mkkadz=1 1015 : GOTO 320 1016 : * 1017 : 211 if (ipilo2.le.0) goto 200 1018 : if (ir.eq.1) then 1019 : SIG0(mobl+ic) = passe1 1020 : mkkig0(ic+mobl)=deche 1021 : else if (ir.ge.(mran -1)) then 1022 : SIGF(mobl+ic) = passe1 1023 : mkkigf(ic+mobl)=deche 1024 : endif 1025 : if(deche.ne.0) mkkigz=1 1026 : GOTO 320 1027 : * 1028 : 212 if (ipilo2.le.0) goto 200 1029 : if (ir.eq.1) then 1030 : epst0(mobl+ic) = passe1 1031 : mkkst0(ic+mobl) =deche 1032 : else if (ir.gt.1.and.ir.le.mran) then 1033 : epstf(mobl+ic) = passe1 1034 : mkkstf(ic+mobl) = deche 1035 : endif 1036 : if(deche.ne.0) mkkstz=1 1037 : GOTO 320 1038 : * 1039 : 213 continue 1040 : if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then 1041 : commat(mobl+ic) = lesfac(ic) 1042 : tyval(mobl+ic) = 'REAL*8 ' 1043 : endif 1044 : if (ir.gt.1) then 1045 : ivalma(mobl+ic) = 0 1046 : if (ipilo2.gt.0) ivalma(mobl+ic) = ieldec 1047 : endif 1048 : if (ipilo2.le.0) goto 200 1049 : if (ir.eq.1) then 1050 : valma0(mobl+ic) = passe1 1051 : mkkva0(ic+mobl)=deche 1052 : elseif (ir.gt.1.and.ir.le.(mran - 1)) then 1053 : VALMAT(mobl+ic) = passe1 1054 : mkkvat(ic+mobl)=deche 1055 : tyval(mobl+ic) = typdec 1056 : xmatf(mobl+ic) = passe1 1057 : mkkatf(ic+mobl)=deche 1058 : if ((inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) 1059 : & .and.nomdec(1:4).eq.'ALPH') then 1060 : if (typdec(1:8).eq.'REAL*8 '.or.typdec(1:8).eq.'POINTEUR') 1061 : & ITHHER=1 1062 : endif 1063 : else if (ir.eq.mran) then 1064 : xmatf(mobl+ic) = passe1 1065 : mkkatf(ic+mobl)=deche 1066 : endif 1067 : if (igau.eq.1.and.ib.eq.1) then 1068 : IF (CMATE.EQ.'SECTION') THEN 1069 : N2PTEL=MAX(N2PTEL,IELCHE(/1)) 1070 : N2EL =MAX(N2EL ,IELCHE(/2)) 1071 : ELSE 1072 : N2PTEL=MAX(N2PTEL,VELCHE(/1)) 1073 : N2EL =MAX(N2EL ,VELCHE(/2)) 1074 : ENDIF 1075 : endif 1076 : GOTO 320 1077 : * 1078 : 214 if (ib.eq.1.and.igau.eq.1.and.ir.eq.1) then 1079 : comcar(mobl+ic)=lesfac(ic) 1080 : tycar(mobl+ic)='REAL*8 ' 1081 : endif 1082 : if (ipilo2.le.0.and.mfrbi.ne.9.and.mfrbi.ne.3) goto 200 1083 : if (ir.eq.1) then 1084 : xcar0(mobl+ic) = passe1 1085 : mkkar0(ic+mobl)=deche 1086 : else if (ir.gt.1.and.ir.le.(mran -1)) then 1087 : XCARB(mobl+ic) = passe1 1088 : mkkarb(ic+mobl)=deche 1089 : xcarbf(mobl+ic) = passe1 1090 : tycar(mobl+ic) = typdec 1091 : * 1092 : * tuyaux 1093 : * 1094 : IF (mfrbi.eq.13) THEN 1095 : * composante VECT 1096 : if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT') then 1097 : ip = int(passe1) 1098 : mkkarb(ic+mobl)=deche 1099 : IREF=(IP-1)*(IDIM+1) 1100 : * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR 1101 : DO 3208 IC2=1,IDIM 1102 : XCARB(ncarr+IC2)=XCOOR(IREF+IC2) 1103 : 3208 continue 1104 : else 1105 : DO 3209 IC2=1,IDIM 1106 : XCARB(ncarr+IC2)=0.d0 1107 : 3209 continue 1108 : endif 1109 : C 1110 : C Poutre 3D 1111 : C 1112 : ELSE IF(MFRbi.EQ.7.AND.IDIM.EQ.3)THEN 1113 : * composante VECT 1114 : if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT') then 1115 : IP=int(passe1) 1116 : mkkarb(ic+mobl)=deche 1117 : IREF=(IP-1)*(IDIM+1) 1118 : * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR 1119 : DO 4208 IC2=1,IDIM 1120 : XCARB(ncarr+IC2)=XCOOR(IREF+IC2) 1121 : 4208 continue 1122 : else 1123 : DO 4209 IC2=1,IDIM 1124 : XCARB(ncarr+IC2)=0.D0 1125 : 4209 continue 1126 : endif 1127 : C 1128 : C Poutre 2D 1129 : C 1130 : ELSEIF(IDIM.EQ.2) THEN 1131 : if (ipilo2.le.0.and.mobl+ic.eq.2) then 1132 : IF(MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN 1133 : XCARB(mobl+IC)=0.66666666666666D0 1134 : ENDIF 1135 : endif 1136 : ELSE 1137 : * cas des coques minces : défaut de alfah 1138 : IF (ipilo2.le.0.and.mobl+IC.EQ.2.AND. 1139 : & (MFRbi.EQ.3.OR.MFRbi.EQ.9)) THEN 1140 : XCARB(mobl+IC)=0.666666666666666D0 1141 : ENDIF 1142 : C 1143 : C 1144 : ENDIF 1145 : else if (ir.ge.mran) then 1146 : xcarbf(mobl+ic) = passe1 1147 : mkkrbf(ic+mobl)=deche 1148 : endif 1149 : if(deche.ne.0) mkkarz=1 1150 : GOTO 320 1151 : * 1152 : 215 if (ipilo2.le.0) goto 200 1153 : if (ir.eq.1) then 1154 : ture0(mobl+ic) = passe1 1155 : mkkre0(ic+mobl)=deche 1156 : else if (ir.ge.(mran -1)) then 1157 : turef(mobl+ic) = passe1 1158 : mkkref(ic+mobl)=deche 1159 : endif 1160 : if(deche.ne.0) mkkrez=1 1161 : GOTO 320 1162 : * 1163 : 216 if (ipilo2.le.0) goto 200 1164 : if (ir.eq.1) then 1165 : prin0(mobl+ic) = passe1 1166 : mkkin0(ic+mobl)=deche 1167 : else if (ir.ge.(mran -1)) then 1168 : prinf(mobl+ic) = passe1 1169 : mkkinf(ic+mobl)=deche 1170 : endif 1171 : if(deche.ne.0) mkkinz=1 1172 : GOTO 320 1173 : * 1174 : 217 if (ipilo2.le.0) goto 200 1175 : if (ir.eq.1) then 1176 : maho0(mobl+ic) = passe1 1177 : mkkho0(ic+mobl)=deche 1178 : else if (ir.ge.(mran -1)) then 1179 : mahof(mobl+ic) = passe1 1180 : mkkhof(ic+mobl)=deche 1181 : endif 1182 : if(deche.ne.0) mkkhoz=1 1183 : GOTO 320 1184 : * 1185 : 218 if (ipilo2.le.0) goto 200 1186 : if (ir.eq.1) then 1187 : hota0(mobl+ic) = passe1 1188 : mkkta0(ic+mobl)=deche 1189 : else if (ir.ge.(mran -1)) then 1190 : hotaf(mobl+ic) = passe1 1191 : mkktaf(ic+mobl)=deche 1192 : endif 1193 : if(deche.ne.0) mkktaz=1 1194 : GOTO 320 1195 : * 1196 : 220 if (ipilo2.le.0) goto 200 1197 : if (ir.eq.1) then 1198 : VAR0(mobl+ic) = passe1 1199 : mkkvr0(ic+mobl)=deche 1200 : else if (ir.ge.(mran -1)) then 1201 : VARF(mobl+ic) = passe1 1202 : mkkvrf(ic+mobl)=deche 1203 : endif 1204 : if(deche.ne.0) mkkvrz=1 1205 : GOTO 320 1206 : * 1207 : 221 if (ipilo2.le.0) goto 200 1208 : if (ir.eq.1) then 1209 : graf0(mobl+ic) = passe1 1210 : mkkaf0(ic+mobl)=deche 1211 : else if (ir.ge.(mran -1)) then 1212 : graff(mobl+ic) = passe1 1213 : mkkaff(ic+mobl)=deche 1214 : endif 1215 : if(deche.ne.0) mkkafz=1 1216 : GOTO 320 1217 : * 1218 : 223 if (ipilo2.le.0) goto 200 1219 : if (ir.eq.1) then 1220 : rhas0(mobl+ic) = passe1 1221 : mkkas0(ic+mobl)=deche 1222 : else if (ir.ge.(mran -1)) then 1223 : rhasf(mobl+ic) = passe1 1224 : mkkasf(ic+mobl)=deche 1225 : endif 1226 : if(deche.ne.0) mkkasz=1 1227 : GOTO 320 1228 : * 1229 : 224 if (ipilo2.le.0) goto 200 1230 : if (ir.eq.1) then 1231 : EPIN0(mobl+ic) = passe1 1232 : mkkpn0(ic+mobl)=deche 1233 : else if (ir.ge.(mran -1)) then 1234 : EPINF(mobl+ic) = passe1 1235 : mkkpnf(ic+mobl)=deche 1236 : endif 1237 : if(deche.ne.0) mkkpnz=1 1238 : GOTO 320 1239 : * 1240 : 298 if (ipilo2.le.0) goto 200 1241 : exova0(mobl + ic) = passe1 1242 : mkkvx0(ic+mobl)=deche 1243 : if(deche.ne.0) mkkvxz=1 1244 : GOTO 320 1245 : * 1246 : 320 CONTINUE 1247 : 1248 : 200 continue 1249 : 1250 : 301 continue 1251 : 1252 : 3000 continue 1253 : * 1254 : 1000 continue 1255 : 1001 continue 1256 : * 1257 : dt = tempf - temp0 1258 : * 1259 : if (igau.eq.1.and.ib.eq.1) then 1260 : IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN 1261 : N2PTEL=1 1262 : ELSE 1263 : N2PTEL=NBG 1264 : ENDIF 1265 : endif 1266 : * 1267 : do ig = 1, depst(/1) 1268 : DEPST(ig)= epstf(ig) - epst0(ig) 1269 : enddo 1270 : * 1271 : nucar = xcarb(/1) 1272 : IF((MFRbi.EQ.7.OR.MFRbi.EQ.13.OR.MFRbi.EQ.15.OR.MFRbi.EQ.17) 1273 : 1 .AND. CMATE.NE.'SECTION') THEN 1274 : * 1275 : IF (MFRbi.EQ.15) THEN 1276 : NUCAR=NUCAR/2 1277 : IE=1 1278 : domdec = liluc(14) 1279 : c segact domdec*nomod 1280 : pilnec = jilnec 1281 : c segact pilnec*nomod 1282 : mobl = pilobl(/1) 1283 : mfac = pilfac(/1) 1284 : DO 1007 IC=1,3,2 1285 : DO 1007 ICOMP=1,min(NUCAR,mobl) 1286 : deche = pilobl(icomp,2) 1287 : if (deche.gt.0) then 1288 : c segact deche 1289 : melval = ieldec 1290 : c segact melval 1291 : IAUX=MELVAL 1292 : IF (IAUX.NE.0) THEN 1293 : IGMN=MIN(IC,VELCHE(/1)) 1294 : IBMN=MIN(IB,VELCHE(/2)) 1295 : VALCAR(IE)=VELCHE(IGMN,IBMN) 1296 : ELSE 1297 : VALCAR(IE)=0.D0 1298 : ENDIF 1299 : else 1300 : VALCAR(IE)=0.D0 1301 : endif 1302 : IE=IE+1 1303 : 1007 CONTINUE 1304 : DO 1009 IC=1,3,2 1305 : DO 1009 ICOMP=1,mfac 1306 : deche = pilfac(icomp,2) 1307 : if (deche.gt.0) then 1308 : c segact deche 1309 : melval = ieldec 1310 : c segact melval 1311 : IAUX=MELVAL 1312 : IF (IAUX.NE.0) THEN 1313 : IGMN=MIN(IC,VELCHE(/1)) 1314 : IBMN=MIN(IB,VELCHE(/2)) 1315 : VALCAR(IE)=VELCHE(IGMN,IBMN) 1316 : ELSE 1317 : VALCAR(IE)=0.D0 1318 : ENDIF 1319 : else 1320 : VALCAR(IE)=0.D0 1321 : endif 1322 : IE=IE+1 1323 : 1009 CONTINUE 1324 : * 1325 : ELSE if (inplas.ne.73) then 1326 : * pour la loi de cisaillement 73, valcar ne sert a rien 1327 : domdec = liluc(14) 1328 : c segact domdec*nomod 1329 : pilnec = jilnec 1330 : c segact pilnec*nomod 1331 : mobl = pilobl(/1) 1332 : mfac = pilfac(/1) 1333 : DO 1010 ICOMP=1,pilobl(/1) 1334 : VALCAR(ICOMP)=0.D0 1335 : deche = pilobl(icomp,2) 1336 : if (deche.gt.0) then 1337 : c segact deche 1338 : melval = ieldec 1339 : c segact melval 1340 : IAUX=MELVAL 1341 : DO 1008 IAUX1=1,NBPTEL 1342 : IF (IAUX.NE.0) THEN 1343 : IBMN=MIN(IB ,VELCHE(/2)) 1344 : IGMN=MIN(IAUX1,VELCHE(/1)) 1345 : VALCAR(ICOMP)=VALCAR(ICOMP)+VELCHE(IGMN,IBMN) 1346 : ENDIF 1347 : IF(IAUX1.EQ.NBPTEL) VALCAR(ICOMP)=VALCAR(ICOMP)/NBPTEL 1348 : 1008 CONTINUE 1349 : endif 1350 : 1010 CONTINUE 1351 : DO 1012 ICOMP=1,pilfac(/1) 1352 : VALCAR(mobl+ICOMP)=0.D0 1353 : deche = pilfac(icomp,2) 1354 : if (deche.gt.0) then 1355 : c segact deche 1356 : melval = ieldec 1357 : c segact melval 1358 : IAUX=MELVAL 1359 : DO 1011 IAUX1=1,NBPTEL 1360 : IF (IAUX.NE.0) THEN 1361 : * write (6,*) ' ielche velche ',ielche(/2),velche(/2) 1362 : * write (6,*) ' mfrbi ifour icomp ',mfrbi,ifour,icomp 1363 : IF (ielche(/2).ne.0) THEN 1364 : IBMN=MIN(IB ,IELCHE(/2)) 1365 : IGMN=MIN(IAUX1,IELCHE(/1)) 1366 : VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+IELCHE(IGMN,IBMN) 1367 : ELSE 1368 : IBMN=MIN(IB ,VELCHE(/2)) 1369 : IGMN=MIN(IAUX1,VELCHE(/1)) 1370 : VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+VELCHE(IGMN,IBMN) 1371 : ENDIF 1372 : ENDIF 1373 : IF(IAUX1.EQ.NBPTEL) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)/NBPTEL 1374 : 1011 CONTINUE 1375 : endif 1376 : 1012 CONTINUE 1377 : ENDIF 1378 : 1379 : else 1380 : if (nucar.gt.0) then 1381 : do ip = 1,nucar 1382 : valcar(ip) = xcarb(ip) 1383 : enddo 1384 : endif 1385 : ENDIF 1386 : * 1387 : IF(MFRbi.EQ.27.OR.MFRbi.EQ.49) THEN 1388 : * 1389 : * on cherche la section de l'element ib 1390 : * 1391 : domdec = liluc(14) 1392 : c segact domdec*nomod 1393 : pilnec = jilnec 1394 : * segact pilnec 1395 : deche=0 1396 : if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2) 1397 : IF( deche.eq.0) then 1398 : sect=0.d0 1399 : ELSE 1400 : c segact deche 1401 : melval = ieldec 1402 : c segact melval 1403 : IAUX=MELVAL 1404 : IF (IAUX.NE.0) THEN 1405 : IBMN=MIN(IB ,VELCHE(/2)) 1406 : IGMN=MIN(IGAU,VELCHE(/1)) 1407 : SECT=VELCHE(IGMN,IBMN) 1408 : ELSE 1409 : SECT=0.D0 1410 : ENDIF 1411 : ENDIF 1412 : ENDIF 1413 : * 1414 : * prise en compte de l'epaisseur et de l'excentrement 1415 : * dans le cas des coques minces avec ou sans cisaillement 1416 : * transverse 1417 : * 1418 : IF (MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN 1419 : IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR. 1420 : 1 CMATE.EQ.'UNIDIREC') THEN 1421 : domdec = liluc(14) 1422 : c segact domdec*nomod 1423 : pilnec = jilnec 1424 : * segact pilnec 1425 : deche = pilobl(1,2) 1426 : c segact deche 1427 : deche=0 1428 : if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2) 1429 : melval = ieldec 1430 : c segact melval 1431 : IAUX=MELVAL 1432 : IF (IAUX.NE.0) THEN 1433 : IBMN=MIN(IB ,VELCHE(/2)) 1434 : IGMN=MIN(IGAU,VELCHE(/1)) 1435 : EPAIST=VELCHE(IGMN,IBMN) 1436 : ELSE 1437 : EPAIST=0.D0 1438 : ENDIF 1439 : ENDIF 1440 : ENDIF 1441 : ** 1442 : c on veut travailler sur tous les pgauss sans economie 1443 : NBGMAT = NBPTEL 1444 : NELMAT = NEL 1445 : 1446 : * on traite le materiau dependant de la temperature pour lemaitre endommageable 1447 : if (inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) then 1448 : do ic = 1,tyval(/2) 1449 : if (tyval(ic)(9:16).EQ.'EVOLUTIO') then 1450 : MEVOLL=nint(valmat(ic)) 1451 : IF(MEVOLL.EQ.0) THEN 1452 : KERRE=37 1453 : RETURN 1454 : ENDIF 1455 : SEGACT MEVOLL 1456 : KEVOLL=IEVOLL(1) 1457 : SEGACT KEVOLL 1458 : if (nomevx.eq.'T ') ITHHER = 2 1459 : * on ne desactive pas les segments pour reduire la contention sur esope en // 1460 : *** segdes kevoll,mevoll 1461 : if (ithher.eq.2) goto 4010 1462 : endif 1463 : if (tyval(ic)(9:16).EQ.'NUAGE ') then 1464 : MNUAGE=nint(valmat(ic)) 1465 : SEGACT MNUAGE 1466 : IF(MNUAGE.EQ.0) THEN 1467 : MOTERR(1:8)='NUAGE ' 1467 : CALL ERREUR(37) 1468 : KERRE=37 1469 : RETURN 1470 : ENDIF 1471 : NVAR=NUANOM(/2) 1472 : IF(NVAR.LE.1) THEN 1473 : * on ne desactive pas les segments pour reduire la contention sur esope en // 1474 : *** SEGDES MNUAGE 1475 : INTERR(1)=MNUAGE 1476 : INTERR(2)=2 1477 : INTERR(3)=2 1477 : CALL ERREUR(628) 1478 : KERRE=628 1479 : RETURN 1480 : ENDIF 1481 : if (nuanom(1).eq.'T ') ITHHER = 2 1482 : * on ne desactive pas les segments pour reduire la contention sur esope en // 1483 : *** segdes mnuage 1484 : if (ithher.eq.2) goto 4010 1485 : endif 1486 : enddo 1487 : 4010 continue 1488 : * ---> PLastique endommageable de Lemaitre 1489 : IF ( INPLAS .EQ. 26 ) THEN 1490 : C* Test refait juste apres 1491 : C* IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 1492 : C* TREFA = 20. 1493 : C* ENDIF 1494 : PRECIS = 1.d-8 1495 : ENDIF 1496 : endif 1497 : ** 1498 : IF (INPLAS.NE.43) THEN 1499 : IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN 1500 : TREFA= 20.D0 1501 : ENDIF 1502 : ENDIF 1503 : 1504 : ** 1505 : RETURN 1506 : END 1507 : 1508 : 1509 : 1510 : 1511 : 1512 : 1513 :
© Cast3M 2003 - All rights reserved.
Disclaimer