1 : C COML7 SOURCE FANDEUR 13/01/29 21:15:17 7683 2 : SUBROUTINE COML7(iqmod,wrk52,wrk53,wrk54,IB,igau, 3 : & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, 4 : & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) 5 : 6 : *----------------------------------------------------------------------- 7 : * lois locales en MECANIQUE et POREUX 8 : * decrites au point d integration 9 : *----------------------------------------------------------------------- 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : -INC CCOPTIO 13 : -INC CCGEOME 14 : -INC SMLREEL 15 : -INC SMMODEL 16 : -INC SMELEME 17 : -INC SMINTE 18 : -INC CCHAMP 19 : -INC SMCOORD 20 : * segment deroulant le mcheml 21 : -INC DECHE 22 : * 23 : SEGMENT WRK2 24 : REAL*8 TRAC(LTRAC) 25 : ENDSEGMENT 26 : * 27 : SEGMENT WRK3 28 : REAL*8 WORK(LW),WORK2(LW2) 29 : ENDSEGMENT 30 : * 31 : SEGMENT MWRKXE 32 : REAL*8 XE(3,NBNN) 33 : ENDSEGMENT 34 : * 35 : SEGMENT WRK6 36 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 37 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 38 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) 39 : ENDSEGMENT 40 : * 41 : SEGMENT WRK7 42 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 43 : ENDSEGMENT 44 : * 45 : SEGMENT WRK8 46 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 47 : REAL*8 DDINVp(NSTRS,NSTRS) 48 : ENDSEGMENT 49 : * 50 : SEGMENT WRK9 51 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 52 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 53 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 54 : REAL*8 SIGY(NSIGY) 55 : INTEGER NKX(NNKX) 56 : ENDSEGMENT 57 : * 58 : SEGMENT WRK91 59 : REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1) 60 : REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2) 61 : REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1) 62 : REAL*8 SIGY1(NSIGY1) 63 : ENDSEGMENT 64 : * 65 : SEGMENT WR10 66 : INTEGER IABLO1(NTABO1) 67 : REAL*8 TABLO2(NTABO2) 68 : ENDSEGMENT 69 : * 70 : SEGMENT WR11 71 : INTEGER IABLO3(NTABO3) 72 : REAL*8 TABLO4(NTABO4) 73 : ENDSEGMENT 74 : * 75 : c mistral : 76 : SEGMENT WR13 77 : REAL*8 PDILT(NPDILT),PNBRE(NPNBRE),PCOHI(NPCOHI),PECOU(NPECOU) 78 : REAL*8 PEDIR(NPEDIR),PRVCE(NPRVCE),PECRX(NPECRX),PDVDI(NPDVDI) 79 : REAL*8 PCROI(NPCROI) 80 : REAL*8 PINCR(NPINCR) 81 : ENDSEGMENT 82 : * 83 : segment wrk12 84 : real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9 85 : real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17 86 : real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25 87 : real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33 88 : real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41 89 : real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49 90 : real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55 91 : integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8 92 : integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16 93 : endsegment 94 : * 95 : segment wrkgur 96 : real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7 97 : real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6) 98 : real*8 wgur13(7), wgur14 99 : real*8 wgur15,wgur16,wgur17 100 : endsegment 101 : C 102 : C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant 103 : C l'integrateur externe specifique UMAT 104 : C 105 : SEGMENT WKUMAT 106 : C Entrees/sorties de la routine UMAT 107 : REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD, 108 : & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT, 109 : & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED), 110 : & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3) 111 : CHARACTER*16 CMNAME 112 : INTEGER NDI, NSHR, NSTATV, NPROPS, 113 : & LAYER, KSPT, KSTEP, KINC 114 : C Variables de travail 115 : LOGICAL LTEMP, LPRED, LVARI, LDFGRD 116 : INTEGER NSIG0, NPARE0, NGRAD0 117 : ENDSEGMENT 118 : C 119 : C Segment de travail pour les lois 'VISCO_EXTERNE' 120 : C 121 : SEGMENT WCREEP 122 : C Entrees/sorties constantes de la routine CREEP 123 : REAL*8 SERD 124 : CHARACTER*16 CMNAMC 125 : INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC 126 : C Entrees/sorties de la routine CREEP pouvant varier 127 : REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV), 128 : & STVP2(NSTV), STV12(NSTV), STVP3(NSTV), 129 : & STVP4(NSTV), STV13(NSTV), STVF(NSTV), 130 : & TMP12, TMP, TMP32, 131 : & DTMP12, DTMP, 132 : & PRD12(NPRD), PRD(NPRD), PRD32(NPRD), 133 : & DPRD12(NPRD), DPRD(NPRD) 134 : INTEGER KSTEPC 135 : C Autres indicateurs et variables de travail 136 : LOGICAL LTMP, LPRD, LSTV 137 : INTEGER IVIEX, NPAREC 138 : REAL*8 dTMPdt, dPRDdt(NPRD) 139 : ENDSEGMENT 140 : * 141 : REAL*8 CRIGI(12),CMASS(12) 142 : * 143 : * Segment ECOU: sert de fourre-tout pour les tableaux 144 : * 145 : SEGMENT ECOU 146 : REAL*8 TEST, ALFAH, 147 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 148 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 149 : 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 150 : 2 SIPLAD(6),DSIGP0(6),TET,TETI 151 : ENDSEGMENT 152 : * 153 : * Segment NECOU utilisé dans CCOINC 154 : * 155 : SEGMENT NECOU 156 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 157 : . ITYP,IFOURB,IFLUAG, 158 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 159 : . JFLUAG,KFLUAG,LFLUAG, 160 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 161 : ENDSEGMENT 162 : * 163 : * Segment IECOU: sert de fourre-tout pour les initialisations 164 : * d'entiers 165 : * 166 : SEGMENT IECOU 167 : INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, 168 : . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, 169 : . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, 170 : . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, 171 : . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, 172 : . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, 173 : . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 174 : ENDSEGMENT 175 : * 176 : * Segment XECOU: sert de fourre-tout pour les initialisations 177 : * de réels 178 : * 179 : SEGMENT XECOU 180 : REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 181 : ENDSEGMENT 182 : * 183 : * moterr(1:6) = 'COML7 ' 184 : * moterr(7:15) = 'element ' 185 : * interr(1) = ib 186 : * interr(2) = igau 186 : * call erreur(-329) 187 : 188 : imodel = iqmod 189 : 190 : *--------------------------------------------------------------------- 191 : * ecoulement selon les modeles 192 : *--------------------------------------------------------------------- 193 : c 194 : NBPGAU = NBGS 195 : NVARI = NVART 196 : c 197 : *--------------------------------------------------------------------- 198 : c modele elastique lineaire 199 : *--------------------------------------------------------------------- 200 : IF (INPLAS.EQ.0)THEN 201 : * barres et poutres 202 : IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN 203 : IF (CMATE.EQ.'SECTION') THEN 204 : IPM = int(xmat(1)) 205 : IPC = int(xmat(2)) 206 : MLREEL = NINT(XMAT(3)) 207 : IF(MLREEL.EQ.0)THEN 207 : CALL FRIGIE(IPM,IPC,CRIGI,CMASS) 208 : ELSE 209 : SEGACT, MLREEL 209 : CALL BIFLX1(PROG(1),NSTRS,CRIGI) 210 : SEGDES, MLREEL 211 : ENDIF 212 : ENDIF 213 : ENDIF 214 : c 214 : CALL CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, 215 : 1 MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,NPINT,NBGMAT, 216 : 2 NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO, 217 : 3 DDHOMU,CRIGI,DSIGT,IRTD) 218 : * 219 : IF(IRTD.EQ.1) THEN 220 : DO 10 IC=1,NSTRSS 221 : SIGF(IC)=SIG0(IC)+DSIGT(IC) 222 : 10 CONTINUE 223 : * 224 : DO 20 IC=1,NVARI 225 : VARF(IC)=VAR0(IC) 226 : 20 CONTINUE 227 : ELSE 228 : KERRE=69 229 : ENDIF 230 : RETURN 231 : ENDIF 232 : c 233 : *--------------------------------------------------------------------- 234 : c modeles implantes dans ccoinc 235 : *--------------------------------------------------------------------- 236 : * appel ccoin0 et ccoinc 237 : * mfr1 <- MFR , nstrss <- nstrs , wrk52 <- wrk0 238 : * CCOTRA <- COTRAC , xcarb <- XCAR 239 : *--------------------------------------------------------------------- 240 : c 241 : c 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 242 : GOTO(301,300,303,304,305,300,307,300,300,300,300,312,300,300,315, 243 : $ 300,317,300,319,320,321,322,323,324,325,300,300,300,300,300, 244 : * 31 245 : $ 300,300,300,300,300,300,300,300,300,300,300,300,343,344,345, 246 : $ 300,300,300,300,300,300,300,353,300,300,300,300,300,300,300, 247 : * 61 248 : $ 361,300,363,300,300,300,300,300,300,370,300,300,300,300,300, 249 : $ 376,377,300,300,300,300,382,300,384,385,386,387,300,300,390, 250 : * 91 251 : $ 300,300,300,394,395,300,300,300,300,400,401,402,403,900,405, 252 : $ 900,407,900,400,900,411,412,413,900,900,900,900,900,900,420, 253 : * 421 254 : $ 421,422,900,900,900,900,900,900,900,430,900,900,900,900,900, 255 : $ 436,437,438,439,900,900,900,900,900,900,900,900,900,900,900, 256 : * 451 257 : $ 900,900,900,900,900,900,900,900,900,900,900,900,900,900,900 258 : $ ) INPLAS 259 : 300 continue 260 : 900 continue 261 : write(ioimp,*) ' erreur d aiguillage coml7 ' 261 : call erreur(5) 262 : return 263 : 264 : * ELSE IF ( INPLAS .EQ. 1 .OR. INPLAS .EQ. 3 .OR. 265 : * 2 INPLAS .EQ. 4 .OR. INPLAS .EQ. 5 .OR. 266 : * 3 INPLAS .EQ. 7 .OR. INPLAS .EQ. 12 .OR. 267 : * 4 INPLAS .EQ. 15 .OR. INPLAS .EQ. 87 ) THEN 268 : c 269 : c modele von mises isotrope associe ( d'apres inca ) 270 : c 271 : * IF (INPLAS .EQ. 1) THEN 272 : 301 continue 273 : c 274 : c cas de la plasticite parfaite 275 : c 276 : NCOURB=2 277 : IF (MATE.EQ.4.AND.MFRbi.EQ.1.AND.IDIM.EQ.3) THEN 278 : TRAC(1)=XMAT(9) 279 : TRAC(3)=XMAT(9) 280 : ELSE 281 : TRAC(1)=XMAT(5) 282 : TRAC(3)=XMAT(5) 283 : ENDIF 284 : TRAC(2)=0.D0 285 : TRAC(4)=1.D9 286 : IF( (IDIM.EQ.2.AND.XMAT(5).EQ.0.D0).OR. 287 : + (MATE.EQ.4.AND.MFRbi.EQ.1.AND.IDIM.EQ.3.AND. 288 : + XMAT(9).EQ.0.D0)) THEN 289 : KERRE = 33 290 : ELSE 291 : KERRE = 0 292 : ENDIF 293 : GO TO 800 294 : c 295 : * ELSE IF (INPLAS .EQ. 3) THEN 296 : 303 continue 297 : c 298 : c cas du modele de drucker-prager parfait 299 : c les donnees sont les limites en traction et en compression 300 : c 301 : IMAPLA=5 302 : DEN = ABS(XMAT(6)) + XMAT(5) 303 : IF(DEN.EQ.0.D0) THEN 304 : KERRE=48 305 : ELSE 306 : XMAT(7) = 2.0D0*ABS(XMAT(6))*XMAT(5)/DEN 307 : XMAT(5) = (ABS(XMAT(6)) - XMAT(5))/DEN 308 : XMAT(6) = 1.D0 309 : XMAT(8)=XMAT(5) 310 : XMAT(9)=XMAT(6) 311 : XMAT(10)=XMAT(5) 312 : XMAT(11)=XMAT(6) 313 : XMAT(12)=XMAT(7) 314 : XMAT(13)=0.D0 315 : c 316 : c petits tests sur les donnees 317 : IF(XMAT(10)/(XMAT(11)+1.D-20).GT. 318 : & XMAT(5)*1.01/(XMAT(6)+1.D-20) 319 : & .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN 320 : KERRE = 48 321 : ELSE 322 : KERRE = 0 323 : ENDIF 324 : ENDIF 325 : GO TO 800 326 : c 327 : * ELSE IF (INPLAS .EQ. 4) THEN 328 : 304 continue 329 : c 330 : c cas de la plasticite cinematique bilineaire 331 : c 332 : IF(XMAT(5).EQ.0.D0) THEN 333 : KERRE=33 334 : ELSE 335 : ICINE=1 336 : NCOURB=2 337 : TRAC(1)=XMAT(5) 338 : TRAC(2)=0.D0 339 : TRAC(4)=1.D9 340 : TRAC(3)=XMAT(5)+XMAT(6)*TRAC(4) 341 : ENDIF 342 : GOTO 800 343 : c 344 : * ELSE IF (INPLAS .EQ. 5 .OR.INPLAS.EQ.87) THEN 345 : 305 continue 346 : 387 continue 347 : c 348 : c cas de la plasticite isotrope ecrouissable 349 : c 350 : c on recupere la courbe de traction 351 : c 352 : nccor=ncourb 352 : CALL CCOTRA(WRK52,WRK2,NCcor,WRK53) 353 : ncourb=nccor 354 : GO TO 800 355 : c 356 : 307 continue 357 : * ELSE IF (INPLAS .EQ. 7) THEN 358 : c 359 : c cas du modele chaboche 1 360 : c 361 : KERRE = 0 362 : ICINE = 1 363 : IMAPLA= 4 364 : GO TO 800 365 : c 366 : * ELSE IF (INPLAS .EQ. 12) THEN 367 : 312 continue 368 : c 369 : c cas du modele chaboche 2 370 : c 371 : KERRE = 0 372 : ICINE = 1 373 : IMAPLA= 4 374 : GO TO 800 375 : c 376 : * ELSE IF (INPLAS .EQ. 15) THEN 377 : 315 continue 378 : c 379 : c cas du modele de drucker-prager general 380 : c 381 : IMAPLA=5 382 : c 383 : c petits tests sur les donnees 384 : c 385 : IF(XMAT(10)/(XMAT(11)+1.D-20).GT. 386 : 1 XMAT(5)*1.01/(XMAT(6)+1.D-20) 387 : 2 .OR.XMAT(12).GT.XMAT(7)*1.01 ) THEN 388 : KERRE = 48 389 : ELSE 390 : KERRE = 0 391 : c 392 : c permutations pour ecoinc 393 : c 394 : DO 30 I=5,7 395 : WW=XMAT(I) 396 : XMAT(I)=XMAT(I+5) 397 : XMAT(I+5)=WW 398 : 30 CONTINUE 399 : ENDIF 400 : c 401 : * ENDIF 402 : 800 continue 403 : IF (KERRE .NE. 0) RETURN 404 : DO 40 IC=1,ICARA 405 : WORK(IC)=XCARB(IC) 406 : 40 CONTINUE 407 : BID(1)=0.D00 408 : BID(2)=0.D00 409 : BID(3)=0.D00 410 : 411 : IF ((INPLAS .EQ. 1 .OR.INPLAS .EQ. 4 .OR. 412 : & INPLAS .EQ. 5 .OR.INPLAS .EQ. 7 .OR. 413 : & INPLAS .EQ. 12.OR.INPLAS.EQ.87 ) .AND. 414 : & (MFRbi .EQ. 1 .OR. MFRbi .EQ. 3 .OR. 415 : & MFRbi .EQ. 5 .OR. MFRbi .EQ. 7 .OR. 416 : & MFRbi .EQ. 9 ) .AND. 417 : & (CMATE.NE.'UNIDIREC')) THEN 418 : c 419 : nccor=ncourb 420 : iforb=ifourb 421 : 421 : CALL CCOIN0(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, 422 : & NBPGAU,NCcor,IFORB,iecou) 423 : ncourb=nccor 424 : ifourb=iforb 425 : c 426 : ELSE 427 : c 427 : CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, 428 : & NBPGAU,ecou,necou,iecou) 429 : c 430 : ENDIF 431 : c 432 : RETURN 433 : * ENDIF 434 : c 435 : C BCN 436 : C 437 : * MRS-Lade (INPLAS=111) 438 : * J2 (INPLAS=112) 439 : * RH_COULOMB (INPLAS=113) 440 : * ELSE IF (INPLAS.eq.111.or.INPLAS.eq.112.or.INPLAS.eq.113) 441 : 411 continue 442 : 412 continue 443 : 413 continue 444 : * . THEN 445 : c calcula incremento de tensiones trial, DSIGT 445 : call CALSIG(DEPST,DDAUX,NSTRSS,CMATE,VALMAT,VALCAR, 446 : . N2EL,N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST, 447 : . NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR, 448 : . XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD) 449 : nescri =0 450 : nues =6 451 : nitmax =25 452 : precis =1.E-10 453 : IF (INPLAS.eq.111) THEN 454 : c MODELE MRS_LADE 455 : C mrs-lade requiere siempre derivacion numerica 456 : nnumer=3 457 : deltax=2.D0**(int(log10(1.D-6)/log10(2.D0))) 457 : call eco_MRSMAC(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST, 458 : . NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri, 459 : . nues,nnumer,deltax,kdummy) 460 : ELSE IF (INPLAS.eq.112) THEN 461 : c MODELE J2 461 : call eco_j2(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST, 462 : . NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri, 463 : . nues,kdummy) 464 : ELSE IF (INPLAS.eq.113) THEN 465 : c Rounded Hyperbolic Mohr-Coulomb 465 : call eco_rhmc(SIG0,VAR0,DSIGT,SIGF,VARF,DEFP,IPLAST, 466 : . NSTRSS,XMAT,KERRE,PRECIS,NITMAX,nescri, 467 : . nues,kdummy) 468 : ENDIF 469 : if (kerre.eq.1) then 470 : write(*,*) 471 : . ' Nonconvergence at elem: ', ib,' gauss:',igau 472 : kerre=99 473 : endif 474 : RETURN 475 : C 476 : C BCNc 477 : *** ELSE 478 : * KERRE = 99 479 : * ENDIF 480 : *--------------------------------------------------------------------- 481 : * modeles de viscoplasticite integres par consti 482 : *--------------------------------------------------------------------- 483 : * IF ( INPLAS .EQ. 17 .OR. 484 : * 2 (INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR. 485 : * 3 INPLAS .EQ. 61 .OR. INPLAS .EQ. 63 .OR. 486 : * 4 INPLAS .EQ. 53 .OR. INPLAS .EQ. 102 .OR. 487 : * 5 INPLAS .EQ. 44 .OR. INPLAS .EQ. 76 .OR. 488 : * 6 INPLAS .EQ. 45 .OR. INPLAS .EQ. 77 .OR. 489 : * 7 INPLAS .EQ. 84 .OR. INPLAS .EQ. 85 .OR. 490 : * 8 INPLAS .EQ. 86 .OR. INPLAS .EQ. 70 .OR. 491 : * 9 INPLAS .EQ. 107 .OR. INPLAS .EQ. 130 .OR. 492 : * a INPLAS .EQ. 136 .OR. INPLAS .EQ. 137 .OR. 493 : * b INPLAS .EQ. 138 .OR. INPLAS .EQ. 139 ) THEN 494 : 317 continue 495 : 319 continue 496 : 320 continue 497 : 321 continue 498 : 322 continue 499 : 323 continue 500 : 324 continue 501 : 325 continue 502 : 344 continue 503 : 345 continue 504 : 353 continue 505 : 361 continue 506 : 363 continue 507 : 370 continue 508 : 376 continue 509 : 377 continue 510 : 384 continue 511 : 385 continue 512 : 386 continue 513 : 402 continue 514 : 407 continue 515 : 430 continue 516 : 436 continue 517 : 437 continue 518 : 438 continue 519 : 439 continue 520 : * 521 : TETA1 = ture0(1) 522 : TETA2 = turef(1) 523 : IF (INPLAS.EQ.44.AND.VAR0(NVARI).EQ.0.0) THEN 524 : VAR0(NVARI)=XMAT(20) 525 : ENDIF 526 : IF (INPLAS.EQ.45.AND.VAR0(NVARI).EQ.0.0) THEN 527 : VAR0(NVARI-2)=XMAT(20) 528 : VAR0(NVARI-1)=XMAT(21) 529 : VAR0(NVARI)=XMAT(27) 530 : ENDIF 531 : FI1 = 0.D0 532 : FI2 = 0.D0 533 : IF (INPLAS.EQ.107) THEN 534 : nexo = exova0(/1) 535 : do 50 inex = 1,nexo 536 : if ((nomexo(inex).eq.'DFIS').and. 537 : & (conexo(inex).eq.CONM)) then 538 : fi1 = exova0(inex) 539 : fi2 = exova1(inex) 540 : goto 2001 541 : endif 542 : 50 continue 543 : 2001 continue 544 : ENDIF 545 : * 546 : if (f(/1).ne.ncourb) segadj wrk7 547 : if (YOG(/1).ne.NYOG.or.YNU(/1).ne.NYNU.or.YALFA(/1).ne.NYALFA 548 : > .or.YSMAX(/1).ne.NYSMAX.or.YN(/1).ne.NYN.or.YM(/1).ne.NYM.or. 549 : > YKK(/1).ne.NYKK.or.YALFA1(/1).ne.NYALF1.or.YBETA1(/1).ne.NYBET1 550 : > .or.YR(/1).ne.NYR.or.YA(/1).ne.NYA.or.YKX(/1).ne.NYKX.or. 551 : > YRHO(/1).ne.NYRHO.or.SIGY(/1).ne.NSIGY.or.NKX(/1).ne.NNKX) 552 : > segadj wrk9 553 : if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or. 554 : > YALFT1(/1).ne.NYALFT1 .or. 555 : > YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or. 556 : > YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or. 557 : > YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or. 558 : > YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1) 559 : > segadj wrk91 560 : c 561 : iforb=ifourb 562 : nccor = ncourb 563 : 563 : CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91, 564 : 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2, 565 : 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou) 566 : c 567 : ifourb=iforb 568 : ncourb=nccor 569 : IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN 570 : IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN 570 : CALL ERREUR(KERREU1) 571 : ENDIF 572 : ENDIF 573 : DTOPTI = MIN(DTOPTI,DTT) 574 : NINCMA = MAX(NINCMA,NSSINC) 575 : NCOMP = NCOMP + 1 576 : TSOM = TSOM + DTT 577 : NSOM = NSOM + NSSINC 578 : NINV = NINV + INV 579 : TCAR = TCAR + DTT* DTT 580 : IF(KERRE.NE.0.AND.KERRE.NE.99) THEN 581 : KERR1=1 582 : ENDIF 583 : RETURN 584 : c 585 : *** ELSE 586 : c KERRE = 99 587 : * ENDIF 588 : * 589 : *--------------------------------------------------------------------- 590 : c 591 : c modele viscoplastique parfait 592 : c 593 : *--------------------------------------------------------------------- 594 : 343 continue 595 : * IF ( INPLAS .EQ. 43 ) THEN 596 : * les lignes en desous sont juste pour diminuer le nombre de cartes suite 597 : icarbi=icara 598 : dtbi=dt 599 : iforb=ifourb 600 : nlmatb=nelmat 601 : nbgmab=nbgmat 602 : mfr1bi = mfr1 603 : nstrbi=nstrss 603 : CALL PRVPAR(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI, 604 : 1 SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL, 605 : 2 N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT, 606 : 3 NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK, 607 : 4 ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi) 608 : dt=dtbi 609 : ifourb=iforb 610 : nelmat=nlmatb 611 : nbgmat=nbgmab 612 : mfr1=mfr1bi 613 : nstrss=nstrbi 614 : IND = 0 615 : RETURN 616 : c 617 : c modele VISK2 618 : c 619 : 382 continue 620 : * ELSE IF ( INPLAS .EQ. 82 ) THEN 621 : * les lignes en desous sont juste pour diminuer le nombre de cartes suite 622 : icarbi=icara 623 : dtbi=dt 624 : iforb=ifourb 625 : nlmatb=nelmat 626 : nbgmab=nbgmat 627 : mfr1bi = mfr1 628 : nstrbi=nstrss 628 : CALL PRVIK2(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,XCAR,ICARbi,NVARI, 629 : 1 SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT,VALCAR,N2EL, 630 : 2 N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST,MELE,NPINT, 631 : 3 NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK, 632 : 4 ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi) 633 : nstrss=nstrbi 634 : dt=dtbi 635 : ifourb=iforb 636 : nelmat=nlmatb 637 : nbgmat=nbgmab 638 : mfr1=mfr1bi 639 : IND = 0 640 : RETURN 641 : c 642 : 390 continue 643 : * ELSE IF (INPLAS .EQ. 90) THEN 644 : C VISCOHINTE 645 : C MODELE INTERFACE 2D 645 : CALL VISHIN(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,XCAR,SIGF, 646 : & VARF,DEFP,PRECIS,MFR1,KERRE,DT) 647 : 648 : IND =1 649 : RETURN 650 : c----------------------------------------------------------------------- 651 : c Modele MISTRAL 652 : c----------------------------------------------------------------------- 653 : 394 continue 654 : * ELSE IF (INPLAS.EQ.94) THEN 655 : FI1 = 0.D0 656 : FI2 = 0.D0 657 : nexo = exova0(/1) 658 : do 60 inex = 1,nexo 659 : if ((nomexo(inex).eq.'FI').and.(conexo(inex).eq.CONM)) then 660 : fi1 = exova0(inex) 661 : fi2 = exova1(inex) 662 : goto 2002 663 : endif 664 : 60 continue 665 : 2002 continue 665 : CALL CMISC1(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU, 666 : & NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR) 667 : SEGINI WR13 667 : CALL CMISC2(wrk52,wrk53,NPDILT,NPNBRE,NPCOHI,NPECOU, 668 : & NPEDIR,NPRVCE,NPECRX,NPDVDI,NPCROI,NPINCR,WR13) 669 : NDPI = nint(PNBRE(1)) 670 : NDVP = nint(PNBRE(2)) 671 : NXX = nint(PNBRE(3)) 672 : NPSI = nint(PNBRE(4)) 673 : TETA1 = ture0(1) 674 : TETA2 = turef(1) 674 : CALL MISTRL(TEMP0,TETA1,FI1, SIG0, VAR0, IFOURB, NSTRS,DT, 675 : & TETA2,FI2,DEPST, valmat,TXR,IDIM, 676 : & PDILT,NDPI,NDVP,NXX,NPSI, 677 : & PCOHI,PECOU,PEDIR,PRVCE,PECRX,PDVDI, PCROI, 678 : & NPINCR,PINCR, SIGF,VARF,EPINF) 679 : SEGSUP WR13 680 : IND = 1 681 : RETURN 682 : c----------------------------------------------------------------------- 683 : c MODELE BPEL_RELAX 684 : c----------------------------------------------------------------------- 685 : 395 continue 686 : * ELSE IF ( INPLAS .EQ. 95 ) THEN 687 : * les lignes en desous sont juste pour diminuer le nombre de cartes suite 688 : nstrbi=nstrss 689 : icarbi=icara 690 : mfr1bi=mfr1 691 : iforb=ifourb 692 : nbgmab=nbgmat 693 : nlmatb=nelmat 694 : dtbi=dt 694 : CALL ECBPEL(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi, 695 : 1 NVARI,SIGF,VARF,DEFP,MFR1bi,DDAUX,CMATE,VALMAT, 696 : 2 VALCAR,N2EL,N2PTEL,NBPGAU,IFORB,IB,IGAU,EPAIST, 697 : 3 MELE,NPINT,NBGMAb,NLMATb,SECT,LHOOK,TXR,XLOC,XGLOB, 698 : 4 D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,KERRE,DTbi) 699 : nstrss=nstrbi 700 : dt=dtbi 701 : ifourb=iforb 702 : nelmat=nlmatb 703 : nbgmat=nbgmab 704 : mfr1=mfr1bi 705 : icara=icarbi 706 : IND = 0 707 : RETURN 708 : c 709 : c MODELE BETON_URGC 710 : c 711 : 399 continue 712 : 400 continue 713 : 401 continue 714 : 420 continue 715 : 422 continue 716 : * ELSE IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR. 717 : * 1 (INPLAS.EQ.120).OR.(INPLAS.EQ.122)) THEN 718 : c 719 : xlcar = bid(1) 720 : TETA1 = ture0(1) 721 : TETA2 = turef(1) 722 : c modele BET_URGC : CONTRAINTES PLANES, 723 : c DEFORMATION PLANES ET AXISYMETRIE 724 : if (inplas.eq.100) inurgc = 1 725 : C modele BETON_URGC ELASTO PLASTIQUE: CONTRAINTES PLANES, 726 : C DEFORMATION PLANES ET AXISYMETRIE 727 : if (inplas.eq.99) inurgc = 0 728 : C modele BETON_URGC VISCO ELASTO PLASTIQUE : CONTRAINTES PLANES, 729 : C DEFORMATION PLANES ET AXISYMETRIE 730 : if (inplas.eq.101) inurgc = 2 731 : C modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES, 732 : C DEFORMATION PLANES ET AXISYMETRIE 733 : if (inplas.eq.120) inurgc = 3 734 : C modele BETON_URGC_ENDO VISCOPLASTIQUE ENDOMMAGEABLE : CONTRAINTES PLANES, 735 : C DEFORMATION PLANES ET AXISYMETRIE 736 : if (inplas.eq.122) inurgc = 4 737 : 738 : nstrbi=nstrss 739 : iforb=ifourb 740 : dtbi=dt 740 : CALL CURGCS(wrk52,wrk53,wrk54,WRK4,NSTRbi,IFORB,DTbi,IB,IGAU, 741 : & xlcar,inurgc,TETA1,TETA2) 742 : nstrss=nstrbi 743 : ifourb=iforb 744 : dt=dtbi 745 : RETURN 746 : C 747 : 421 continue 748 : * ELSE IF (INPLAS.EQ.121) THEN 749 : c 750 : xlcar = bid(1) 751 : C modele BETON_URGC PLASTIQUE ENDOMMAGEABLE : 3D 752 : 753 : nstrbi=nstrss 754 : iforb=ifourb 755 : dtbi=dt 755 : CALL bet3D(wrk52,wrk53,wrk54,WRK4,NSTRbi,IFORB,DTbi,IB,IGAU, 756 : & xlcar) 757 : nstrss=nstrbi 758 : ifourb=iforb 759 : dt=dtbi 760 : RETURN 761 : * 762 : *--------------------------------------------------------------------- 763 : * modele fluage lemaitre LEMENDO 764 : *--------------------------------------------------------------------- 765 : 403 continue 766 : * ELSE IF (inplas.eq.103) THEN 767 : iforb=ifourb 768 : nbgmab=nbgmat 769 : nlmatb=nelmat 769 : CALL CFLUE2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb, 770 : & NLMATb,IFORB) 771 : 772 : ifourb=iforb 773 : nbgmat=nbgmab 774 : nelmat=nlmatb 775 : RETURN 776 : *--------------------------------------------------------------------- 777 : * modele fluage type Norton FLUNOR2 778 : *--------------------------------------------------------------------- 779 : 405 continue 780 : * ELSE IF (inplas.eq.105) THEN 781 : iforb=ifourb 782 : nbgmab=nbgmat 783 : nlmatb=nelmat 783 : CALL CFLUN2(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,NBPGAU,NBGMAb, 784 : & NLMATb,IFORB) 785 : ifourb=iforb 786 : nbgmat=nbgmab 787 : nelmat=nlmatb 788 : RETURN 789 : *--------------------------------------------------------------------- 790 : RETURN 791 : END 792 : 793 : 794 :
© Cast3M 2003 - All rights reserved.
Disclaimer