1 : C COML8 SOURCE FANDEUR 14/01/22 21:15:05 7891 2 : SUBROUTINE COML8(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2, 3 : & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, 4 : & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) 5 : 6 : *---------------------------------------------------------------- 7 : * lois locales pour la mecanique 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 CCHAMP 15 : -INC SMMODEL 16 : -INC SMELEME 17 : -INC SMINTE 18 : -INC SMCOORD 19 : * segment deroulant le mcheml 20 : -INC DECHE 21 : * 22 : SEGMENT WRK2 23 : REAL*8 TRAC(LTRAC) 24 : ENDSEGMENT 25 : * 26 : SEGMENT WRK3 27 : REAL*8 WORK(LW),WORK2(LW2) 28 : ENDSEGMENT 29 : * 30 : SEGMENT MWRKXE 31 : REAL*8 XE(3,NBNNbi) 32 : ENDSEGMENT 33 : * 34 : SEGMENT WRK6 35 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 36 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 37 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) 38 : ENDSEGMENT 39 : * 40 : SEGMENT WRK7 41 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 42 : ENDSEGMENT 43 : * 44 : SEGMENT WRK8 45 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 46 : REAL*8 DDINVp(NSTRS,NSTRS) 47 : ENDSEGMENT 48 : * 49 : SEGMENT WRK9 50 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 51 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 52 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 53 : REAL*8 SIGY(NSIGY) 54 : INTEGER NKX(NNKX) 55 : ENDSEGMENT 56 : * 57 : SEGMENT WRK91 58 : REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1) 59 : REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2) 60 : REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1) 61 : REAL*8 SIGY1(NSIGY1) 62 : ENDSEGMENT 63 : * 64 : SEGMENT WR10 65 : INTEGER IABLO1(NTABO1) 66 : REAL*8 TABLO2(NTABO2) 67 : ENDSEGMENT 68 : * 69 : SEGMENT WR11 70 : INTEGER IABLO3(NTABO3) 71 : REAL*8 TABLO4(NTABO4) 72 : ENDSEGMENT 73 : * 74 : SEGMENT WR12 75 : REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) 76 : REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) 77 : REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) 78 : REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) 79 : REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) 80 : REAL*8 SM8(NSTRS) 81 : ENDSEGMENT 82 : SEGMENT WRK12 83 : real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9 84 : real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17 85 : real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25 86 : real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33 87 : real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41 88 : real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49 89 : real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55 90 : integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8 91 : integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16 92 : ENDSEGMENT 93 : segment wrkgur 94 : real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7 95 : real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6) 96 : real*8 wgur13(7), wgur14 97 : real*8 wgur15,wgur16,wgur17 98 : endsegment 99 : C 100 : C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant 101 : C l'integrateur externe specifique UMAT 102 : C 103 : SEGMENT WKUMAT 104 : C Entrees/sorties de la routine UMAT 105 : REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD, 106 : & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT, 107 : & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED), 108 : & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3) 109 : CHARACTER*16 CMNAME 110 : INTEGER NDI, NSHR, NSTATV, NPROPS, 111 : & LAYER, KSPT, KSTEP, KINC 112 : C Variables de travail 113 : LOGICAL LTEMP, LPRED, LVARI, LDFGRD 114 : INTEGER NSIG0, NPARE0, NGRAD0 115 : ENDSEGMENT 116 : C 117 : C Segment de travail pour les lois 'VISCO_EXTERNE' 118 : C 119 : SEGMENT WCREEP 120 : C Entrees/sorties constantes de la routine CREEP 121 : REAL*8 SERD 122 : CHARACTER*16 CMNAMC 123 : INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC 124 : C Entrees/sorties de la routine CREEP pouvant varier 125 : REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV), 126 : & STVP2(NSTV), STV12(NSTV), STVP3(NSTV), 127 : & STVP4(NSTV), STV13(NSTV), STVF(NSTV), 128 : & TMP12, TMP, TMP32, 129 : & DTMP12, DTMP, 130 : & PRD12(NPRD), PRD(NPRD), PRD32(NPRD), 131 : & DPRD12(NPRD), DPRD(NPRD) 132 : INTEGER KSTEPC 133 : C Autres indicateurs et variables de travail 134 : LOGICAL LTMP, LPRD, LSTV 135 : INTEGER IVIEX, NPAREC 136 : REAL*8 dTMPdt, dPRDdt(NPRD) 137 : ENDSEGMENT 138 : * 139 : SEGMENT ENDO0 140 : REAL*8 ENDO(LENDO),RAPP(LENDO) 141 : ENDSEGMENT 142 : * 143 : character*16 modemo 144 : REAL*8 CRIGI(12),CMASS(12) 145 : DIMENSION NWA(9) 146 : DIMENSION SIG01(8),VAR01(37) 147 : DIMENSION EPSFLU(8) 148 : 149 : SEGMENT ECOU 150 : REAL*8 ecow00,ecow0, 151 : C REAL*8 TEST, ALFAH, 152 : 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6), 153 : C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 154 : 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 155 : 2 ecow12(6), 156 : C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 157 : 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), 158 : C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 159 : 2 ecow17(6),ecow18(6),ecow19,ecow20 160 : C 2 SIPLAD(6),DSIGP0(6),TET,TETI 161 : ENDSEGMENT 162 : * 163 : * Segment NECOU utilisé dans ECOINC 164 : * 165 : SEGMENT NECOU 166 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 167 : . ITYP,IFOURB,IFLUAG, 168 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 169 : . JFLUAG,KFLUAG,LFLUAG, 170 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 171 : ENDSEGMENT 172 : * 173 : * Segment IECOU: sert de fourre-tout pour les initialisations 174 : * d'entiers 175 : * 176 : SEGMENT IECOU 177 : INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, 178 : . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, 179 : . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, 180 : . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, 181 : . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, 182 : . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, 183 : . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 184 : ENDSEGMENT 185 : * 186 : * Segment XECOU: sert de fourre-tout pour les initialisations 187 : * de réels 188 : * 189 : SEGMENT XECOU 190 : REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 191 : ENDSEGMENT 192 : C----------------------------------------------------------------------- 193 : C 194 : c moterr(1:6) = 'COML8 ' 195 : c moterr(7:15) = 'element ' 196 : c interr(1) = ib 197 : c interr(2) = igau 197 : c call erreur(-329) 198 : * write(6,*) ' entrée dans coml8 iecou ', iecou 199 : imodel = iqmod 200 : c 201 : c traitement du modele 202 : c 203 : c NFOR=FORMOD(/2) 204 : c NMAT=MATMOD(/2) 205 : c 206 : NBPGAU = nbgs 207 : NVARI = NVART 208 : TETA1 = ture0(1) 209 : TETA2 = turef(1) 210 : SUCC1 = -1.E35 211 : SUCC2 = -1.E35 212 : nexo = exova0(/1) 213 : if (nexo.gt.0) then 214 : do 1296 inex = 1,nexo 215 : if ((nomexo(inex).eq.'SUCC').and.(conexo(inex).eq.CONM)) then 216 : SUCC1 = exova0(inex) 217 : SUCC2 = exova1(inex) 218 : goto 1295 219 : endif 220 : 1296 continue 221 : endif 222 : 1295 continue 223 : jnplas = inplas + 3 224 : * inplas -2 -1 0 225 : GOTO ( 898, 899, 900, 226 : * inplas 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 227 : $ 900,302,900,900,900,900,900,900,309,900,900,900,900,314,900, 228 : $ 316,900,318,900,900,900,900,900,900,900,326,327,328,329,330, 229 : * 31 230 : $ 331,332,333,334,335,336,337,338,339,340,341,342,900,900,900, 231 : $ 900,347,348,349,350,351,352,900,354,355,356,357,358,359,360, 232 : * 61 233 : $ 900,362,900,364,365,366,367,368,369,900,371,372,373,374,375, 234 : $ 900,900,378,379,380,900,900,900,900,900,900,900,388,389,900, 235 : * 91 236 : $ 391,392,393,900,900,396,397,398,900,900,900,900,900,404,900, 237 : $ 406,900,408,900,900,900,900,900,900,900,900,900,418,419,900, 238 : * 121 239 : $ 900,900,900,900,425,900,427,428,429,900,431,432,433,434,435, 240 : $ 900,900,900,900,440,441,442,443,900,900,900,447,900,900,450, 241 : * 151 152 155 156 157 158 159 160 242 : $ 451,452,900,900,455,456,900,900,900,900 243 : $ ) JNPLAS 244 : 245 : 900 continue 246 : write(6,*) ' erreur d aiguillage coml8' 246 : call erreur (5) 247 : return 248 : *--------------------------------------------------------------------- 249 : * modeles de viscoplasticite integres par consti 250 : * avec endommagement 251 : *--------------------------------------------------------------------- 252 : 329 continue 253 : * IF (INPLAS .EQ. 29) THEN 254 : ntabo1 = iablo1(/1) 255 : ntabo2 = tablo2(/1) 256 : * 257 : NYOG=IABLO1(1) 258 : NYNU=IABLO1(2) 259 : NYALFA=IABLO1(3) 260 : NYSMAX=IABLO1(4) 261 : NYN=IABLO1(5) 262 : NYM=IABLO1(6) 263 : NYKK=IABLO1(7) 264 : NYALF1=IABLO1(8) 265 : NYBET1=IABLO1(9) 266 : NYR=IABLO1(10) 267 : NYA=IABLO1(11) 268 : C 269 : INTMAT=NMATT 270 : C 271 : IF (NTABO1.EQ.INTMAT) THEN 272 : NNKX=1 273 : NYKX=IABLO1(12) 274 : ELSE 275 : NNKX=IABLO1(12) 276 : NYKX=0 277 : DO 1881 I=1,NNKX 278 : 1881 NYKX=NYKX+(2*IABLO1(12+I)) 279 : NYKX=NYKX+NNKX 280 : ENDIF 281 : NYRHO=IABLO1(NTABO1) 282 : NSIGY=1 283 : SEGINI WRK9 284 : inplas2 = INPLAS 285 : ifour2 = IFOUR 286 : mfr2 = MFRbi 286 : CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2) 287 : SEGSUP WR10 288 : IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN 289 : NCOURB=2*NKX(1) 290 : ELSE 291 : NCOURB=NKX(1) 292 : DO 1882 I=1,NNKX 293 : 1882 IF (NKX(I).GE.NCOURB) NCOURB=NKX(I) 294 : NCOURB=2*NCOURB 295 : ENDIF 296 : SEGINI WRK7 297 : *** IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN 298 : IF (VAR0(3).GE.0.96) THEN 298 : CALL ZDANUL(SIGF,NSTRS) 299 : DO 1883 I=1,NVARI 300 : VARF(I) = VAR0(I) 301 : 1883 CONTINUE 302 : VARF(3) = 1.D0 303 : DO 1884 I=1,NSTRS 304 : EPINF(I) = EPIN0(I) 305 : 1884 CONTINUE 306 : ELSE 307 : FI1=0.D0 308 : FI2=0.D0 309 : dtbi=dt 310 : iforb=ifourb 311 : nccor = ncourb 311 : CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91, 312 : 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2, 313 : 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou) 314 : ifourb=iforb 315 : ncourb=nccor 316 : c 317 : *** IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN 318 : IF (TLIFE.GE.0.D0) THEN 319 : INTERR(1)=IB 320 : INTERR(2)=IGAU 321 : REAERR(1)=TLIFE 321 : CALL ERREUR(-279) 322 : ENDIF 323 : DTOPTI = MIN(DTOPTI,DTT) 324 : NINCMA = MAX(NINCMA,NSSINC) 325 : NCOMP = NCOMP + 1 326 : TSOM = TSOM + DTT 327 : NSOM = NSOM + NSSINC 328 : NINV = NINV + INV 329 : TCAR = TCAR + DTT* DTT 330 : IF (KERRE.NE.0) THEN 331 : KERR1=1 332 : ENDIF 333 : ENDIF 334 : SEGSUP WRK7 335 : SEGSUP WRK9 336 : RETURN 337 : C 338 : 442 continue 339 : * ELSEIF (INPLAS .EQ. 142) THEN 340 : 341 : ntabo1 = iablo1(/1) 342 : ntabo2 = tablo2(/1) 343 : * 344 : NYOG1=IABLO1(1) 345 : NYNU1=IABLO1(2) 346 : NYALFT1=IABLO1(3) 347 : NYSMAX1=IABLO1(4) 348 : NYN1=IABLO1(5) 349 : NYM1=IABLO1(6) 350 : NYKK1=IABLO1(7) 351 : NYALF2=IABLO1(8) 352 : NYBET2=IABLO1(9) 353 : NYR1=IABLO1(10) 354 : NYA1=IABLO1(11) 355 : NYQ1=IABLO1(12) 356 : NYRHO1=IABLO1(NTABO1) 357 : NSIGY1=1 358 : SEGINI WRK91 359 : inplas2 = INPLAS 360 : ifour2 = IFOUR 361 : mfr2 = MFRbi 361 : CALL MAT142(WR10,WRK91,inplas2,ifour2,mfr2) 362 : SEGSUP WR10 363 : SEGINI WRK7 364 : IF (VAR0(8).GE.0.96) THEN 364 : CALL ZDANUL(SIGF,NSTRS) 365 : DO I=1,NVARI 366 : VARF(I) = VAR0(I) 367 : ENDDO 368 : VARF(8) = 1.D0 369 : DO I=1,NSTRS 370 : EPINF(I) = EPIN0(I) 371 : ENDDO 372 : ELSE 373 : FI1=0.D0 374 : FI2=0.D0 375 : dtbi=dt 376 : iforb=ifourb 377 : nccor = ncourb 377 : CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91, 378 : 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2, 379 : 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou) 380 : segact necou*mod 381 : ifourb=iforb 382 : ncourb=nccor 383 : c 384 : IF (TLIFE.GE.0.D0) THEN 385 : INTERR(1)=IB 386 : INTERR(2)=IGAU 387 : REAERR(1)=TLIFE 387 : CALL ERREUR(-279) 388 : ENDIF 389 : DTOPTI = MIN(DTOPTI,DTT) 390 : NINCMA = MAX(NINCMA,NSSINC) 391 : NCOMP = NCOMP + 1 392 : TSOM = TSOM + DTT 393 : NSOM = NSOM + NSSINC 394 : NINV = NINV + INV 395 : TCAR = TCAR + DTT* DTT 396 : IF (KERRE.NE.0) THEN 397 : KERR1=1 398 : ENDIF 399 : ENDIF 400 : SEGSUP WRK7 401 : SEGSUP WRK91 402 : RETURN 403 : c 404 : c modele plastique d'endommagement de lemaitre 405 : c ++++++++++++++++++++++++++++++++++++++++++++ 406 : c traitement du materiau qui depend eventuellement de la temperature 407 : c ------------------------------------------------------------------ 408 : 326 continue 409 : * ELSE IF (INPLAS.EQ.26) THEN 410 : ntabo1 = iablo1(/1) 411 : ntabo2 = tablo2(/1) 412 : NYOG=IABLO1(1) 413 : NYNU=IABLO1(2) 414 : NYRHO=IABLO1(3) 415 : NYALFA=IABLO1(4) 416 : c IF ((MFRbi.EQ.1.OR.MFRbi.EQ.31.OR.MFRbi.EQ.33).AND.IFOUR.EQ.-2) 417 : c & THEN 418 : c+DC INTMAT=9 419 : c INTMAT=10 420 : c ELSE 421 : c+DC INTMAT=8 422 : c INTMAT=9 423 : c ENDIF 424 : INTMAT=NMATT 425 : IF (NTABO1.EQ.INTMAT) THEN 426 : NNKX=1 427 : NYKX=IABLO1(5) 428 : IEPS=0 429 : ELSE 430 : NNKX=IABLO1(5) 431 : NYKX=0 432 : DO 1789 I=1,NNKX 433 : 1789 NYKX=NYKX+(2*IABLO1(5+I)) 434 : NYKX=NYKX+NNKX 435 : IEPS=1 436 : ENDIF 437 : IORIGI=6+(IEPS*NNKX) 438 : NYN=IABLO1(IORIGI) 439 : NYM=IABLO1(IORIGI+1) 440 : NYKK=IABLO1(IORIGI+2) 441 : NYSMAX=0 442 : NYALF1=0 443 : NYBET1=0 444 : NYR=0 445 : NYA=0 446 : NSIGY=0 447 : SEGINI WRK9 448 : inplas2 = INPLAS 449 : ifour2 = IFOUR 450 : mfr2 = MFRbi 451 : * write(6,*) ' coml8 inplas2 ifour2 mfr2 ifourb' 452 : * write(6,*) inplas2,ifour2,mfr2,ifourb 452 : CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2) 453 : * write(6,*) ' sortier de mat29 kerre',kerre 454 : SEGSUP WR10 455 : c 456 : c *** si le pt. de gauss est ruine, les contr. sont annulees et 457 : c *** on n' ecoule pas 458 : c 458 : CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP) 459 : IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN 460 : DO 1115 IEN=1,NVARI 461 : VARF(IEN)=VAR0(IEN) 462 : 1115 continue 463 : VARF(3)=1.D0 463 : CALL ZDANUL(SIGF,NSTRS) 463 : CALL ZDANUL(DEFP,NSTRS) 464 : ELSE 465 : c ---------------------------------------------------------------------- 466 : c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d 467 : c p est en supplement 468 : c ---------------------------------------------------------------------- 469 : NNVARI=2 470 : IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN 471 : nccor=ncourb 471 : CALL CCOTRA(WRK52,WRK2,Nccor,WRK53) 472 : NCOURB=2*NKX(1) 473 : ELSE 474 : NCOURB=NKX(1) 475 : DO 1119 I=1,NNKX 476 : 1119 if (nkx(i).ge.ncourb) ncourb=nkx(i) 477 : NCOURB=4*NCOURB 478 : ENDIF 479 : IF (KERRE.EQ.0) THEN 480 : SEGINI WRK7 481 : trefab=trefa 482 : iforb=ifourb 483 : nccor=ncourb 483 : CALL CENDOM(wrk52,wrk53,wrk54,WRK6,WRK7,WRK8,WRK9, 484 : 1 NVARI, TETA1,TETA2,TREFAb,IB,IGAU,iforb,nccor,iecou) 485 : ifourb=iforb 486 : ncourb=nccor 487 : trefa=trefab 488 : SEGSUP WRK7 489 : IF (KERRE.GT.200) THEN 490 : KERR1=1 491 : ENDIF 492 : ENDIF 493 : ENDIF 494 : SEGSUP WRK9 495 : RETURN 496 : * ELSE 497 : c KERRE = 99 498 : * ENDIF 499 : * 500 : *--------------------------------------------------------------------- 501 : * 502 : * ecoulement selon les modeles plastique avec endommagement 503 : * 504 : *--------------------------------------------------------------------- 505 : c 506 : c modeles implantes dans ecoinc 507 : c 508 : 351 continue 509 : * IF (INPLAS.EQ.51) THEN 510 : c 511 : SEGINI ENDO0 512 : c cas de la plasticite isotrope ecrouissable avec un 513 : c endommagement de type P/Y 514 : c 515 : c on recupere la courbe de traction et la courbe de début d'endommagement 516 : c 517 : nccor=ncourb 517 : CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP) 518 : ncourb=nccor 519 : INPLS0 = 51 520 : INPLAS = 5 521 : IF (VAR0(7).GE.1.D-10) THEN 522 : DO 110 I=1,NSTRS 523 : SIG0(I)=SIG0(I)/VAR0(7) 524 : 110 CONTINUE 525 : ENDIF 526 : c 527 : c calcul des contraintes plastiquement admissibles 528 : c 529 : IF (KERRE .EQ. 0) THEN 530 : DO 1114 IC=1,ICARA 531 : WORK(IC)=xcarb(IC) 532 : 1114 continue 533 : BID(1)=0.D00 534 : BID(2)=0.D00 535 : BID(3)=0.D00 535 : CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, 536 : & NBPGAU,ecou,necou,iecou) 537 : ENDIF 538 : c retour au modèle d'endommagement P/Y 539 : c 540 : c calcul des contraintes endommagées 541 : c 541 : CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP, 542 : & NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE) 543 : segsup ENDO0 544 : INPLAS = 51 545 : RETURN 546 : c 547 : 362 continue 548 : * ELSE IF (INPLAS.EQ.62) THEN 549 : c 550 : c Modèle d'endommagement de Rousselier 551 : c - on recupère la courbe de traction 552 : c 553 : nccor=ncourb 553 : CALL CCOTRA(wrk52,WRK2,NCcor,wrk53) 554 : ncourb=nccor 555 : c 556 : c - appel au modèle 557 : C 558 : IF (KERRE.EQ.0) THEN 558 : CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0, 559 : & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE, 560 : & necou) 561 : IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN 562 : KERR1=1 563 : ENDIF 564 : ENDIF 565 : RETURN 566 : c 567 : 364 continue 568 : * ELSE IF (INPLAS.EQ.64) THEN 569 : c 570 : c Modèle d'endommagement de Gurson modifié Needleman Tvergaard 571 : c - on recupère la courbe de traction 572 : c 573 : nccor=ncourb 573 : CALL CCOTRA(wrk52,WRK2,NCcor,wrk53) 574 : ncourb=nccor 575 : c 576 : c - appel au modèle 577 : c 578 : IF (KERRE.EQ.0) THEN 578 : CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0, 579 : & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE, 580 : & necou) 581 : IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN 582 : KERR1=1 583 : ENDIF 584 : ENDIF 585 : RETURN 586 : c 587 : 375 continue 588 : * ELSE IF (INPLAS.EQ.75) THEN 589 : c 590 : c Modèle d'endommagement de Dragon 591 : c 591 : CALL CDRAGO(wrk52,wrk53,wrk54) 592 : c 593 : c 594 : RETURN 595 : 433 continue 596 : * ELSE IF (INPLAS.EQ.133) THEN 597 : c 598 : c Modèle viscoplastique viscoendommageable pour la dynamique rapide du LMT 599 : c 599 : CALL DYNAR(wrk52,wrk53,wrk54,iecou) 600 : RETURN 601 : c 602 : * ELSE 603 : c KERRE = 99 604 : * ENDIF 605 : *--------------------------------------------------------------------- 606 : * 607 : * ecoulement selon les modeles (endommageables) 608 : * 609 : *--------------------------------------------------------------------- 610 : * 611 : 330 continue 612 : * IF (INPLAS .EQ. 30) THEN 613 : c 614 : c modele d'endommagement mazars ( beton ) 615 : c 615 : c CALL MAZZZ(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 616 : c & ICARA,MFR1) 616 : CALL CMAZZZ(WRK52,WRK53,WRK54,NVARI,Iecou) 617 : RETURN 618 : c 619 : 331 continue 620 : * ELSE IF (INPLAS .EQ. 31) THEN 621 : c 622 : c modele d'endommagement unilateral ( beton ) 623 : c 623 : c CALL CLBBBB(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, 624 : c & ICARA,KERRE,MFR1,IFOURB) 625 : 625 : CALL COLBBB(WRK52,WRK53,WRK54,NVARI,Iecou,necou) 626 : RETURN 627 : c 628 : 337 continue 629 : * ELSE IF (INPLAS .EQ. 37) THEN 630 : c 631 : c modele rotating crack 632 : c 633 : nstrbi=nstrss 634 : icarbi=icara 634 : CALL COTATI(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi) 635 : nstrss=nstrbi 636 : icara=icarbi 637 : RETURN 638 : c 639 : 388 continue 640 : * ELSE IF (INPLAS .EQ. 88) THEN 641 : c modele SIC_SIC 642 : c 642 : CALL CICSIC(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou 643 : & ,iecou) 644 : RETURN 645 : c 646 : 389 continue 647 : * ELSE IF (INPLAS .EQ. 89) THEN 648 : C HINTE 649 : C MODELE INTERFACE 2D 650 : 650 : CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,xcarb,SIGF, 651 : & VARF,DEFP,PRECIS,MFR1,KERRE) 652 : RETURN 653 : C 654 : 396 continue 655 : * ELSE IF (INPLAS .EQ. 96) THEN 656 : C 657 : C MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS 658 : C 658 : CALL CMICRO(WRK52,WRK53,WRK54,NVARI,Iecou) 659 : RETURN 660 : * 661 : 397 continue 662 : * ELSE IF (INPLAS .EQ. 97) THEN 663 : C 664 : C MODELE D'ENDOMMAGEMENT VISCOUNILATERAL ( BETON ) 665 : C 666 : icarbi=icara 666 : CALL CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou) 667 : RETURN 668 : * 669 : 398 continue 670 : * ELSE IF (INPLAS .EQ. 98) THEN 671 : C 672 : C MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS 673 : C 673 : CALL CMICRI(WRK52,WRK53,WRK54,NVARI,Iecou) 674 : RETURN 675 : * 676 : 418 continue 677 : * ELSE IF (INPLAS.EQ.118) THEN 678 : C 679 : C modified von mises model 680 : C 680 : CALL CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou) 681 : RETURN 682 : c 683 : 431 continue 684 : * ELSE IF (INPLAS .EQ. 131) THEN 685 : c modele SIC_SIC 686 : c 686 : CALL SICSCAL(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou 687 : & ,iecou) 688 : RETURN 689 : c 690 : 432 continue 691 : * ELSE IF (INPLAS .EQ. 132) THEN 692 : c modele SIC_SIC 693 : c 693 : CALL SICTENS(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou 694 : & ,iecou) 695 : RETURN 696 : C 697 : 434 continue 698 : * ELSE IF (INPLAS.EQ.134) THEN 699 : C 700 : C Modele de DESMORAT 701 : C 701 : CALL DESMOR(wrk52,wrk53,wrk54,nvari,iecou) 702 : RETURN 703 : * ELSE 704 : c KERRE = 99 705 : * ENDIF 706 : * 707 : *--------------------------------------------------------------------- 708 : * 709 : * ecoulement selon les modeles (plastique hors moule ccoinXX) 710 : * 711 : *--------------------------------------------------------------------- 712 : c 713 : c modele linespring 714 : c 715 : 302 continue 716 : 327 continue 717 : * IF (INPLAS.EQ.2.OR.INPLAS.EQ.27) THEN 718 : * write(6,*) ' coml8 ifour avant appel calsig', ifour 718 : CALL CLISPP(wrk52,wrk53,wrk54,WRK2,IFOUR,IB,IGAU, 719 : & NBPGAU,iecou) 720 : RETURN 721 : c 722 : c modele beton 723 : c 724 : 309 continue 725 : * ELSE IF (INPLAS.EQ.9) THEN 725 : CALL BETON(SIG0 ,DEPST,VAR0,XMAT,ivalma,NMATT,xcarb, 726 : 1 DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB, 727 : 2 IGAU,EPAIST,MELE,NPINT, SECT,LHOOK, 728 : 3 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT, 729 : 4 SIGF,VARF,DEFP, NBPGAU,KERRE,ecou,necou,iecou) 730 : IF (KERRE.GT.200) THEN 731 : KERR1=1 732 : ENDIF 733 : RETURN 734 : c 735 : c tuyau fissure 736 : c 737 : 314 continue 738 : 318 continue 739 : * ELSE IF (INPLAS.EQ.14.OR.INPLAS.EQ.18) THEN 740 : iforb=ifourb 740 : CALL CTUFPL(wrk52,wrk53,wrk54,WRK2,IFORB,IB,IGAU, 741 : & NBPGAU,iecou) 742 : ifourb=iforb 743 : 744 : 745 : c pas de materiau 18 dans nomate 02/01 Kich 746 : if (inplas.eq.18) inplas = 14 747 : c 748 : c modele gauvain 749 : c 750 : RETURN 751 : 316 continue 752 : * ELSE IF (INPLAS.EQ.16) THEN 753 : c 754 : c on recupere les courbes moment-courbure 755 : c 756 : nccor=ncourb 756 : CALL CCOTR2(wrk52,wrk53,WRK2,NCcor) 757 : ncourb=nccor 758 : IF (KERRE.NE.0) RETURN 759 : iforb=ifourb 760 : nccor=ncourb 761 : mfr1bi=mfr1 762 : nbgmab=nbgmat 763 : nlmatb=nelmat 764 : nstrbi=nstrs 764 : CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,MFR1bi,IFORB, 765 : 1 IB,IGAU,EPAIST,MELE,NPINT,NBGMAb,NLMATb,SECT, 766 : 2 LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI, 767 : 3 SIG0,NSTRbi,DEPST,VAR0,XMAT,NCOMAT,xcarb,TRAC, 768 : 4 NCcor,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE) 769 : ifourb=iforb 770 : ncourb=nccor 771 : mfr1=mfr1bi 772 : nbgmat=nbgmab 773 : nelmat=nlmatb 774 : nstrs=nstrbi 775 : 776 : IF (KERRE.GT.200) THEN 777 : KERR1=1 778 : ENDIF 779 : * ENDIF 780 : RETURN 781 : c 782 : c modele ubiquitous 783 : c 784 : 328 continue 785 : * ELSE IF (INPLAS .EQ.28) THEN 785 : CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB, 786 : 1 IGAU,EPAIST,MELE,NPINT ,SECT,LHOOK, 787 : 2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0, 788 : 3 DEPST,VAR0,XMAT,NBPGAU,NMATT,xcarb,DSIGT, 789 : 4 SIGF,VARF,DEFP,KERRE,ecou,necou,iecou) 790 : IF (KERRE.GT.200) THEN 791 : KERR1=1 792 : ENDIF 793 : RETURN 794 : c 795 : c modele global 796 : c 797 : 332 continue 798 : * ELSE IF (INPLAS.EQ.32) THEN 799 : iforb=ifourb 799 : CALL CCOTR3(wrk52,wrk53,wrk54,IFORB,IB,IGAU, 800 : & NBPGAU,iecou) 801 : ifourb=iforb 802 : IF (KERRE.LT.0) THEN 803 : INTERR(1)=IB 804 : INTERR(2)=IGAU 805 : IF (KERRE.LE.(-4)) THEN 806 : MOTERR(5:16) = 'CISAILLEMENT' 806 : CALL ERREUR(-283) 807 : KERRE = KERRE + 4 808 : ENDIF 809 : IF (KERRE.LE.(-2)) THEN 810 : MOTERR(5:16) = 'FLEXION' 810 : CALL ERREUR(-283) 811 : KERRE = KERRE + 2 812 : ENDIF 813 : IF (KERRE.LT.0) THEN 814 : MOTERR(5:16) = 'COMPRESSION' 814 : CALL ERREUR(-283) 815 : KERRE = 0 816 : ENDIF 817 : ENDIF 818 : RETURN 819 : c 820 : c modele cam-clay 821 : c 822 : 333 continue 823 : * ELSE IF (INPLAS.EQ.33) THEN 823 : CALL CAMCLA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF, 824 : & VARF,DEFP,PRECIS,MFR1,KERRE) 825 : RETURN 826 : c 827 : 334 continue 828 : * ELSE IF (INPLAS .EQ. 34) THEN 829 : c 830 : c modele de mohr coulomb pour les joints 831 : c 832 : IF (MFR.EQ.35) THEN 833 : IF (IFOUR.EQ.2) THEN 834 : c 835 : c --------------------joints 3d 836 : c 836 : CALL COUL3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, 837 : & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) 838 : ELSE 839 : c 840 : c --------------------joints 2d 841 : c 841 : CALL COUL2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, 842 : & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) 843 : ENDIF 844 : c 845 : c --------------------joints JOI1 846 : c 847 : ELSE IF (MFR.EQ.75) THEN 847 : CALL COUL1(IB,IGAU,NSTRS,SIG0,EPST0,EPIN0,VAR0,NVARI,DEPST, 848 : & IFOURB,XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) 849 : ENDIF 850 : RETURN 851 : c 852 : 335 continue 853 : * ELSE IF (INPLAS .EQ. 35) THEN 854 : c 855 : c modele de coulomb_dilatant pour les joints 2d 856 : c 857 : IF (IFOUR.NE.2) THEN 857 : CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE) 858 : ENDIF 859 : RETURN 860 : c 861 : c modele de gurson 862 : c 863 : 338 continue 864 : * ELSE IF (INPLAS .EQ. 38) THEN 865 : nstrbi=nstrss 866 : icarbi=icara 866 : CALL PRGURS(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi, 867 : & NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur) 868 : nstrss=nstrbi 869 : icara=icarbi 870 : RETURN 871 : c 872 : 336 continue 873 : * ELSE IF (INPLAS .EQ. 36) THEN 874 : c 875 : c modele beton_axi 876 : c 877 : nstrbi=nstrss 877 : CALL BETAXI(SIG0,NSTRbi,DSIGT,VAR0,XMAT,ivalma,NMATT,xcarb, 878 : & SIGF,VARF,DEFP,MFR1,KERRE,ecou,necou) 879 : nstrss=nstrbi 880 : IF (KERRE.GT.200) THEN 881 : KERR1=1 882 : ENDIF 883 : RETURN 884 : c 885 : 339 continue 886 : * ELSE IF ((INPLAS .EQ. 39) .AND. (MFRbi .EQ. 27)) THEN 887 : c 888 : c modele beton_uni pour les elements unidirectionels (barre ..) 889 : c 890 : KERR1=0 890 : CALL BARBET(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) 891 : RETURN 892 : c 893 : 404 continue 894 : * ELSE IF ((INPLAS .EQ. 104) .AND. (MFRbi .EQ. 27)) THEN 895 : c 896 : c modele beton unilateral pour les elements unidirectionels (barre ..) 897 : c 898 : KERR1=0 898 : CALL BARLAB(XMAT,XCARB,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) 899 : RETURN 900 : c 901 : 393 continue 902 : * ELSE IF ((INPLAS .EQ. 93) .AND. (MFRbi .EQ. 27)) THEN 903 : c 904 : c 905 : c modele ancrage_acier pour les elements unidirectionels (barre ..) 906 : c 907 : KERR1=0 907 : CALL BARSTA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) 908 : RETURN 909 : c 910 : 378 continue 911 : * ELSE IF ((INPLAS .EQ. 78) .AND. (MFRbi .EQ. 27)) THEN 912 : c 913 : c modele fragile_uni pour les elements unidirectionels (barre ..) 914 : c 915 : KERR1=0 915 : CALL BARFRA(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP) 916 : RETURN 917 : c 918 : 379 continue 919 : * ELSE IF ((INPLAS .EQ. 79) .AND. (MFRbi .EQ. 27)) THEN 920 : c 921 : c modele beton_bael pour les elements unidirectionels (barre ..) 922 : c 923 : KERR1=0 923 : CALL BABAEL(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP) 924 : RETURN 925 : c 926 : 392 continue 927 : * ELSE IF ((INPLAS .EQ. 92) .AND. (MFRbi .EQ. 27)) THEN 928 : c 929 : c 930 : c modele ancrage_parfait pour les elements unidirectionels (barre ..) 931 : c 932 : KERR1=0 932 : CALL BARPAA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) 933 : RETURN 934 : c 935 : c 936 : 380 continue 937 : * ELSE IF ((INPLAS .EQ. 80) .AND. (MFRbi .EQ. 27)) THEN 938 : c 939 : c modele parfait_uni pour les elements unidirectionels (barre ..) 940 : c 941 : KERR1=0 941 : CALL BARPAR(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) 942 : c 943 : * IF (KERRE.NE.0) return 944 : RETURN 945 : c 946 : c modele acier_uni pour les materiau unidirectionel 947 : c 948 : c 949 : 340 continue 950 : * ELSE IF ((INPLAS .EQ. 40) .AND. (MFRbi .EQ. 27)) THEN 951 : IF(MFRbi .EQ. 27)then 952 : c 953 : c modele acier_uni pour les elements unidirectionels (barre ..) 954 : c 955 : KERR1=0 955 : CALL BARSTE(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) 956 : RETURN 957 : elseif(MATE.EQ.4) then 958 : * ELSE IF (INPLAS .EQ. 40 .AND. MATE.EQ.4) THEN 959 : nstrbi=nstrss 960 : mfr1bi=mfr1 960 : CALL CUNIAC(wrk52,wrk53,wrk54,NSTRbi,MFR1bi) 961 : nstrss=nstrbi 962 : mfr1=mfr1bi 963 : RETURN 964 : endif 965 : c 966 : c modele poutre en formulation section 967 : c 968 : 341 continue 969 : * ELSE IF (INPLAS.EQ.41.AND.MFRbi.EQ.7) THEN 970 : c 971 : nstrbi=nstrss 972 : icarbi=icara 972 : CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi) 973 : nstrss=nstrbi 974 : icara=icarbi 975 : RETURN 976 : c 977 : 350 continue 978 : * ELSE IF (INPLAS .EQ. 50) THEN 979 : c 980 : c cas du modele de zerilli armstrong 981 : c 982 : c on recupere le pas de temps dt : voir comval 983 : c kich : fixe dt = 0. pour plasticite 984 : dtk1 = dt 985 : dt = 0.d0 986 : c 987 : IF (KERRE .EQ. 0) THEN 988 : DO 1124 IC=1,ICARA 989 : WORK(IC)=xcarb(IC) 990 : 1124 continue 991 : BID(1)=0.D00 992 : BID(2)=0.D00 993 : BID(3)=0.D00 993 : CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, 994 : & NBPGAU,necou,ecou,iecou,xecou) 995 : ENDIF 996 : dt = dtk1 997 : RETURN 998 : c 999 : c modele de steinberg cochran guinan 1000 : c 1001 : 349 continue 1002 : * ELSE IF (INPLAS.EQ.49) THEN 1002 : CALL STEINB(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0, 1003 : 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2, 1004 : 2 KERRE) 1005 : IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN 1006 : KERR1=1 1007 : ENDIF 1008 : RETURN 1009 : c 1010 : c modele hujeux 1011 : c 1012 : 348 continue 1013 : * ELSE IF (INPLAS.EQ.48) THEN 1013 : CALL HUJEUX(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF, 1014 : & VARF,DEFP,PRECIS,MFR1,KERRE) 1015 : RETURN 1016 : c 1017 : c modele ottosen 1018 : c 1019 : 342 continue 1020 : * ELSE IF (INPLAS.EQ.42) THEN 1020 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,NMATT, 1021 : 1 xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,IB, 1022 : 2 IGAU) 1023 : RETURN 1024 : c 1025 : 347 continue 1026 : * ELSE IF (INPLAS.EQ.47) THEN 1027 : c 1028 : c modele de amadei-saeb pour les joints 1029 : c 1030 : C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi 1031 : IF (IFOUR.EQ.2) THEN 1032 : c 1033 : c --------------------joints 3d 1034 : c 1034 : CALL AMADE3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, 1035 : & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE) 1036 : ELSE 1037 : c 1038 : c --------------------joints 2d 1039 : c 1039 : CALL AMADE2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, 1040 : & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE) 1041 : ENDIF 1042 : RETURN 1043 : c 1044 : 352 continue 1045 : * ELSE IF (INPLAS.EQ.52) THEN 1046 : c 1047 : c modèle Preston-Tonks-Wallace 1048 : c 1049 : c on recupere le pas de temps dt : voir comval 1050 : c kich : fixe dt = 0. pour plasticite 1051 : dtk1 = dt 1052 : dt = 0.d0 1053 : c 1053 : CALL PRESTO(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0, 1054 : 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2, 1055 : 2 KERRE,DT) 1056 : IF (KERRE.NE.0) THEN 1057 : KERR1=1 1058 : ENDIF 1059 : dt = dtk1 1060 : RETURN 1061 : c 1062 : 354 continue 1063 : * ELSE IF (INPLAS.EQ.54) THEN 1064 : c 1065 : c modele BETOCYCL 1066 : C 1067 : C ON VERIFIE LES CONTRAINTES PLANES 1068 : C 1069 : IF (IFOUR.EQ.-2) THEN 1070 : C 1071 : C ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION 1072 : C 1073 : IPOS1=1 1073 : CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT) 1074 : NTRAT=NPOINT/2 1075 : IPOS2=IPOS1+NPOINT 1075 : CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT) 1076 : NTRAC=NPOINT/2 1077 : IF (KERRE.EQ.0) THEN 1077 : CALL CBETOC(wrk52,wrk53,wrk54,WRK2,NTRAT,NTRAC) 1078 : ENDIF 1079 : ELSE 1080 : KERRE = 99 1081 : ENDIF 1082 : RETURN 1083 : C 1084 : 355 continue 1085 : * ELSE IF (INPLAS.EQ.55) THEN 1086 : C 1087 : C MODELE ROTATING CRACK 1088 : C 1089 : C ON VERIFIE LES CONTRAINTES PLANES 1090 : C 1091 : IF (IFOUR.EQ.-2) THEN 1092 : IF (KERRE.EQ.0) THEN 1092 : CALL CROTAT(wrk52,wrk53,wrk54) 1093 : ENDIF 1094 : ELSE 1095 : KERRE = 99 1096 : ENDIF 1097 : RETURN 1098 : c 1099 : 356 continue 1100 : * ELSE IF (INPLAS.EQ.56) THEN 1101 : C 1102 : C MODELE JOINT_SOFT 1103 : C 1104 : C 1105 : C ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR 1106 : C 1107 : C 1108 : C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est 1109 : C 6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et 1110 : C 'ALFA' a la place 3 et 4 dans defmat.eso 1111 : C 1112 : IPOS1=1 1112 : CALL COTRAJ(wrk52,wrk53,WRK2,8, IPOS1,1, NPOINT) 1113 : NTRAC=NPOINT/2 1114 : IPOS2=IPOS1+NPOINT 1114 : CALL COTRAJ(wrk52,wrk53,WRK2,9, IPOS2,1, NPOINT) 1115 : NTRAS=NPOINT/2 1116 : IPOS3=IPOS2+NPOINT 1116 : CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS3,1, NPOINT) 1117 : NTRAT=NPOINT/2 1118 : C 1119 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN 1120 : IF(KERRE.EQ.0) THEN 1121 : C 1121 : CALL SJONL2(SIG0,DEPST,VAR0,XMAT, 1122 : . TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS, 1123 : . TRAC(IPOS3),NTRAT, 1124 : . SIGF,VARF,DEFP,KERRE) 1125 : END IF 1126 : ELSEIF(IFOUR.EQ.2)THEN 1127 : IF(KERRE.EQ.0) THEN 1128 : C 1128 : CALL SJONL3(SIG0,DEPST,VAR0,XMAT, 1129 : . TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT, 1130 : . TRAC(IPOS3),NTRAC, 1131 : . SIGF,VARF,DEFP,KERRE) 1132 : END IF 1133 : C 1134 : END IF 1135 : RETURN 1136 : C 1137 : 419 continue 1138 : * ELSE IF (INPLAS.EQ.119)THEN 1139 : C 1140 : C MODELE JOINT_COAT 1141 : C 1142 : C ON RECUPERE LA COURBE DE SHEAR 1143 : C 1144 : C Note: La courbe a maintenant l'indices 4 alors que c'est 1145 : C 2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et 1146 : C 'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...) 1147 : C 1148 : IPOS1=1 1148 : CALL COTRAJ(wrk52,wrk53,WRK2,4,IPOS1,1, NPOINT) 1149 : NTRAS=NPOINT/2 1150 : C 1151 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN 1152 : IF(KERRE.EQ.0) THEN 1153 : C 1153 : CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS, 1154 : . SIGF,VARF,DEFP,KERRE) 1155 : END IF 1156 : ELSEIF(IFOUR.EQ.2)THEN 1157 : IF(KERRE.EQ.0) THEN 1158 : END IF 1159 : C 1160 : END IF 1161 : RETURN 1162 : C 1163 : 425 continue 1164 : * ELSE IF (INPLAS.EQ.125)THEN 1165 : IF(MFR.EQ.1)THEN 1165 : CALL DAMATC(IFOUR,XMAT,DDHOOK,LHOOK,SIG0,VAR0, 1166 : & DEPST,DSIGT,EPST0,EPIN0, SIGF,VARF,DEFP) 1167 : ENDIF 1168 : RETURN 1169 : 1170 : 435 continue 1171 : * ELSE IF (INPLAS.EQ.135) THEN 1171 : CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0, 1172 : & SIGF,DEPST,NSTRS,KERRE,ISTEP) 1173 : RETURN 1174 : C 1175 : C 1176 : 426 continue 1177 : * ELSE IF (INPLAS.EQ.126)THEN 1178 : C 1179 : C MODELE MUR_SHEAR 1180 : C POUR LE MOMENT, ELEMENT DE POUTRE 1181 : C MAIS ON AJOUTE MAINTENANT LE MACRO ELEMENT 1182 : C 1183 : IF(MFR.EQ.7.OR.MFR.EQ.61)THEN 1184 : C 1185 : C ON RECUPERE LES COURBES 1186 : C 1187 : C Note: Les courbes ont maintenant les indices 5 a 10 alors que 1188 : C c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a 1189 : C incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso 1190 : C 1191 : IPOS1=1 1191 : CALL COTRAJ(wrk52,wrk53,WRK2, 5,IPOS1,0, NPOINT) 1192 : NCURFP=NPOINT/2 1193 : IPOS2=IPOS1+NPOINT 1193 : CALL COTRAJ(wrk52,wrk53,WRK2, 6,IPOS2,0, NPOINT) 1194 : NCURKP=NPOINT/2 1195 : IPOS3=IPOS2+NPOINT 1195 : CALL COTRAJ(wrk52,wrk53,WRK2, 7,IPOS3,0, NPOINT) 1196 : NCURLP=NPOINT/2 1197 : IPOS4=IPOS3+NPOINT 1197 : CALL COTRAJ(wrk52,wrk53,WRK2, 8,IPOS4,0, NPOINT) 1198 : NCURFM=NPOINT/2 1199 : IPOS5=IPOS4+NPOINT 1199 : CALL COTRAJ(wrk52,wrk53,WRK2, 9,IPOS5,0, NPOINT) 1200 : NCURKM=NPOINT/2 1201 : IPOS6=IPOS5+NPOINT 1201 : CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS6,0, NPOINT) 1202 : NCURLM=NPOINT/2 1203 : C 1204 : IF(KERRE.EQ.0) THEN 1205 : C+PPM 1206 : IF(MFR.EQ.7)THEN 1207 : C+PPM 1207 : CALL MSHETI(wrk52,wrk53,WRK2, 1208 : > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM, 1209 : > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6, 1210 : > KERR2) 1211 : KERRE = KERR2 1212 : C+PPM 1213 : ELSE 1214 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN 1214 : CALL MASHEJ(wrk52,wrk53,WRK2, 1215 : > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM, 1216 : > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6) 1217 : ELSE 1218 : KERRE=99 1219 : ENDIF 1220 : ENDIF 1221 : C+PPM 1222 : END IF 1223 : 1224 : C 1225 : END IF 1226 : RETURN 1227 : C 1228 : C 1229 : c 1230 : 391 continue 1231 : * ELSE IF (INPLAS.EQ.91) THEN 1232 : C 1233 : C MODELE ANCRAGE_ELIGEHAUSEN 1234 : C 1235 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN 1236 : C 1236 : CALL ANCREL(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE) 1237 : ENDIF 1238 : RETURN 1239 : c 1240 : 357 continue 1241 : * ELSE IF (INPLAS.EQ.57) THEN 1242 : C 1243 : C MODELE BILI_MOMY 1244 : C 1245 : KERRE=0 1245 : CALL BILIPO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP) 1246 : RETURN 1247 : c 1248 : 358 continue 1249 : * ELSE IF (INPLAS.EQ.58) THEN 1250 : C 1251 : C MODELE BILI_EFFZ 1252 : C 1253 : KERRE=0 1253 : CALL BILIFO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP) 1254 : RETURN 1255 : c 1256 : 359 continue 1257 : * ELSE IF (INPLAS.EQ.59) THEN 1258 : C 1259 : C MODELE TAKEMO_MOMY 1260 : C 1261 : C ON RECUPERE LES COURBES MOMENT-COURBURE 1262 : C 1263 : nccor=ncourb 1263 : CALL COTRAF(wrk52,wrk53,WRK2,NCcOR) 1264 : ncourb=nccor 1265 : IF (KERRE.EQ.0) THEN 1266 : C 1267 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN 1267 : CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, 1268 : & NCOURB,SIGF,VARF,DEFP,KERRE) 1269 : ELSE 1269 : CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, 1270 : & NCOURB,SIGF,VARF,DEFP,KERRE) 1271 : ENDIF 1272 : ENDIF 1273 : RETURN 1274 : 1275 : 1276 : 1277 : 1278 : 447 continue 1279 : * ELSE IF (INPLAS.EQ.73) THEN 1280 : C 1281 : C MODELE BA1D 1282 : C 1282 : CALL BA1D(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, 1283 : & NCOURB,SIGF,VARF,DEFP,KERRE) 1284 : 1285 : RETURN 1286 : c 1287 : 360 continue 1288 : * ELSE IF (INPLAS.EQ.60) THEN 1289 : C 1290 : C MODELE TAKEMO_EFFZ 1291 : C 1292 : C 1293 : C ON RECUPERE LES COURBES MOMENT-COURBURE 1294 : C 1295 : nccor=ncourb 1295 : CALL COTRAF(wrk52,wrk53,WRK2,NCcor) 1296 : ncourb=nccor 1297 : IF (KERRE.EQ.0) THEN 1298 : C 1299 : IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN 1299 : CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, 1300 : & NCOURB,SIGF,VARF,DEFP,KERRE) 1301 : ELSE 1301 : CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, 1302 : & NCOURB,SIGF,VARF,DEFP,KERRE) 1303 : ENDIF 1304 : C 1305 : ENDIF 1306 : RETURN 1307 : c 1308 : 440 continue 1309 : * ELSE IF (INPLAS.EQ.140) THEN 1310 : * 1311 : * modele DRUCKER_PRAGER2 1312 : * 1313 : XLCARA=0.D0 1314 : NEXO = EXOVA0(/1) 1315 : DO INEX=1,NEXO 1316 : IF ((NOMEXO(INEX).EQ.'LCAR').AND.(CONEXO(INEX).EQ.CONM)) THEN 1317 : XLCARA=EXOVA0(INEX) 1318 : ENDIF 1319 : ENDDO 1319 : CALL DRUCK2(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVALMA, 1320 : & NMATT,XCARB,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE, 1321 : & IB,IGAU,IFOURB,XLCARA,MELE) 1322 : RETURN 1323 : 441 continue 1324 : * ELSE IF (INPLAS.EQ.141) THEN 1325 : 1326 : * Fatigue damage model (fatsin) 1327 : * print*,'appel a cfattt dans coml8' 1327 : CALL CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou) 1328 : RETURN 1329 : 1330 : * ELSE 1331 : * KERRE=99 1332 : * ENDIF 1333 : * 1334 : *--------------------------------------------------------------------- 1335 : * 1336 : * ecoulement selon les modeles (plastique hors ccoinXX) suite 1337 : * 1338 : *--------------------------------------------------------------------- 1339 : * 1340 : 366 continue 1341 : * IF (INPLAS.EQ.66) THEN 1342 : C 1343 : C 1344 : C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES, 1345 : C DEFORMATION PLANES ET AXISYMETRIE 1346 : C 1347 : nstrbi=nstrss 1348 : iwpoi1=wrk12 1348 : CALL BEINSA(SIG0,NSTRbi,DEPST,VAR0,XMAT,ivalma,NMATT,SIGF,VARF, 1349 : 1 KERRE,MELE,IFOURB,NVARI,xcarb,NCARR,MFRbi,EPIN0, 1350 : 2 EPINF,DT,XE,NBNNbi,CMATE,IB,IGAU,iwpoi1) 1351 : RETURN 1352 : C 1353 : C 1354 : 367 continue 1355 : * ELSEIF (INPLAS.EQ.67) THEN 1356 : C 1357 : C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE) 1358 : C 1359 : MVEL1= nint(XMAT(NMATR) ) 1360 : nccor=ncourb 1360 : CALL CCOTRO(wrk52,wrk53,WRK2,NCcor,MVEL1) 1361 : ncourb=nccor 1362 : LT1=NCOURB*2 1362 : CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC, 1363 : & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB) 1364 : RETURN 1365 : * 1366 : * 1367 : 368 continue 1368 : * ELSEIF (INPLAS.EQ.68) THEN 1369 : C 1370 : C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE) 1371 : C 1372 : NCOURB=3 1373 : KERRE = 0 1374 : TRAC(1)=0.D0 1375 : TRAC(2)=0.D0 1376 : TRAC(3)=XMAT(NMATR) 1377 : TRAC(4)=XMAT(NMATR)/XMAT(1) 1378 : TRAC(5)=XMAT(NMATR) 1379 : TRAC(6)=1.D0 1380 : IF (XMAT(NMATR).EQ.0.D0) KERRE = 33 1381 : LT1=NCOURB*2 1381 : CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC, 1382 : & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB) 1383 : RETURN 1384 : C 1385 : 369 continue 1386 : * ELSEIF (INPLAS.EQ.69) THEN 1387 : C 1388 : C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO 1389 : C 1390 : **************************** 1391 : * SPECIAL SUCCION 1392 : * 1392 : CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0, 1393 : & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou) 1394 : IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN 1395 : KERR1=1 1396 : ENDIF 1397 : RETURN 1398 : C 1399 : 371 continue 1400 : * ELSEIF (INPLAS.EQ.71) THEN 1401 : C 1402 : C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD 1403 : C 1403 : CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0, 1404 : & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou) 1405 : IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN 1406 : KERR1=1 1407 : ENDIF 1408 : RETURN 1409 : **************************** 1410 : C 1411 : 372 continue 1412 : * ELSEIF (INPLAS.EQ.72) THEN 1413 : C 1414 : C MODELE INFILL_UNI 1415 : C 1416 : IF (MFRbi.EQ.27) THEN 1417 : C 1418 : C ON RECUPERE LA COURBE FORCE-DEPLACEMENT 1419 : C 1419 : CALL COTRAJ(wrk52,wrk53,WRK2,12,1,0, NPOINT) 1420 : NCOURB=NPOINT/2 1421 : IF (KERRE.EQ.0) THEN 1422 : nccor=ncourb 1422 : CALL CINFIL(wrk52,wrk53,wrk54,WRK2,NCcor) 1423 : ncourb=nccor 1424 : ENDIF 1425 : ELSE 1426 : KERRE = 99 1427 : ENDIF 1428 : RETURN 1429 : C 1430 : 373 continue 1431 : * ELSE IF (INPLAS.EQ.73) THEN 1432 : C 1433 : C MODELE ETAGE 1434 : C pour le moment, element de barre 1435 : * 1436 : IF (MFRbi.EQ.7) THEN 1437 : C 1438 : C ON RECUPERE LA COURBE FORCE-DEPLACEMENT 1439 : C 1440 : IPOS1=1 1440 : CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT) 1441 : NTRAP=NPOINT/2 1442 : IPOS2=IPOS1+NPOINT 1442 : CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT) 1443 : NTRAN=NPOINT/2 1444 : IF (KERRE.EQ.0) THEN 1444 : CALL CETAG(wrk52,wrk53,wrk54,WRK2,NTRAP,NTRAN) 1445 : ENDIF 1446 : ELSE 1447 : KERRE = 99 1448 : ENDIF 1449 : RETURN 1450 : C 1451 : * ELSE 1452 : c KERRE=99 1453 : * ENDIF 1454 : * 1455 : *--------------------------------------------------------------------- 1456 : * ceramique caroline, couplage gatt_monerie ottosen, 1457 : * maxwell, couplage maxwell ottosen 1458 : *--------------------------------------------------------------------- 1459 : 365 continue 1460 : * IF (INPLAS.EQ.65) THEN 1461 : * 1462 : IF ((MFRbi.EQ.1).AND.(IFOMOD.EQ.2)) THEN 1463 : IBIDO = 19 1464 : ELSE 1465 : IBIDO = 14 1466 : ENDIF 1467 : * 1468 : * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION 1469 : * CAD LORSQUE TTRAN = 0 1470 : * 1471 : IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN 1472 : * 1473 : * si le point de gauss est déjà endommagé par endommagement généralisé 1474 : * on le traite simplement par ccerac 1475 : * 1476 : IF (VAR0(NVARI-1).EQ.1) THEN 1477 : iforb=ifourb 1477 : CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1478 : 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) 1479 : IND=1 1480 : ELSE 1481 : * 1482 : * si le point de gauss n'a pas un endommagement généralisé 1483 : * on regarde si il a été fissuré 1484 : * par ottosen et si non on applique le fluage puis ottosen 1485 : * si oui on le traite par ottosen 1486 : * 1486 : CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi) 1487 : IF (ITOTO.EQ.0) THEN 1488 : iforb=ifourb 1488 : CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1489 : 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) 1490 : ifourb=iforb 1491 : IND=1 1492 : * Ligne suivante à supprimer 1493 : * IF (IND.EQ.0) THEN 1494 : * on regarde si on a eu endommagement généralisé 1495 : * si on n'a pas eu endommagement généralisé on appelle ottosen 1496 : IF (VARF(NVARI-1).NE.1) THEN 1497 : DO 161 I = 1,NVARI 1498 : VAR01(I) = VARF(I) 1499 : 161 CONTINUE 1500 : DO 835 I=1,NSTRS 1501 : * PRINT *,'DEPST EPINF-EPIN0 ', 1502 : * 1 I,DEPST(I),(EPINF(I)-EPIN0(I)) 1503 : DEPST(I) = DEPST(I) - (EPINF(I)-EPIN0(I)) 1504 : C on remplace SIGF par SIG0 1505 : SIG01(I) = SIG0(I) 1506 : 835 CONTINUE 1506 : CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT, 1507 : 1 ivalma,NMATT,xcarb,ICARA,NVARI,SIGF,VARF, 1508 : 2 DEFP,MFR1,KERRE,IB,IGAU) 1509 : C on met à jour la variable interne EPSE commune aux deux modèles 1510 : VARF(1) = VARF(1)+VARF(NVARI) 1511 : C DO 537 I=1,NSTRS 1512 : C IF (SIGF(I).NE.SIG01(I)) THEN 1513 : C PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I) 1514 : C ENDIF 1515 : C537 CONTINUE 1516 : C DO 538 I=1,NVARI 1517 : C IF (VARF(I).NE.VAR01(I)) THEN 1518 : C PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I) 1519 : C ENDIF 1520 : C 538 CONTINUE 1521 : 1522 : C on calcule l'increment de déformation du pas de temps 1523 : DO 836 I=1,NSTRS 1524 : C IF (DEFP(I).NE.0.) PRINT *,'DEFP',DEFP(I) 1525 : DEFP(I) = DEFP(I)+(EPINF(I)-EPIN0(I)) 1526 : 836 CONTINUE 1527 : IND=0 1528 : ENDIF 1529 : C Ligne suivante à supprimer 1530 : C ENDIF 1531 : ELSE 1531 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma, 1532 : 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1, 1533 : 2 KERRE,IB,IGAU) 1534 : VARF(1) = VARF(1)+VARF(NVARI) 1535 : IND=0 1536 : ENDIF 1537 : ENDIF 1538 : C 1539 : ELSE 1540 : * 1541 : * CAS OU ON PREND EN COMPTE LA TEMPERATURE DE TRANSITION 1542 : * 1543 : IF (TETA2.GE.XMAT(IBIDO)) THEN 1543 : CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi) 1544 : IF (ITOTO.EQ.0) THEN 1545 : iforb=ifourb 1545 : CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1546 : 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) 1547 : ifourb=iforb 1548 : IND=1 1549 : ELSE 1549 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma, 1550 : 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1, 1551 : 2 KERRE,IB,IGAU) 1552 : VARF(1) = VARF(1)+VARF(NVARI) 1553 : IND=0 1554 : ENDIF 1555 : ELSE 1556 : IF (VAR0(NVARI-1).EQ.1) THEN 1557 : iforb=ifourb 1557 : CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1558 : 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) 1559 : ifourb=iforb 1560 : IND=1 1561 : ELSE 1561 : CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma, 1562 : 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1, 1563 : 2 KERRE,IB,IGAU) 1564 : VARF(1) = VARF(1)+VARF(NVARI) 1565 : IND=0 1566 : ENDIF 1567 : ENDIF 1568 : ENDIF 1569 : IF (MFR1.EQ.17) THEN 1570 : IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN 1570 : CALL ERREUR(KERREU1) 1571 : ENDIF 1572 : ENDIF 1573 : C 1574 : DTOPTI = MIN(DTOPTI,DTT) 1575 : NINCMA = MAX(NINCMA,NSSINC) 1576 : NCOMP = NCOMP + 1 1577 : TSOM = TSOM + DTT 1578 : NSOM = NSOM + NSSINC 1579 : NINV = NINV + INV 1580 : TCAR = TCAR + DTT* DTT 1581 : IF (KERRE.NE.0.AND.KERRE.NE.99) THEN 1582 : KERR1=1 1583 : ENDIF 1584 : RETURN 1585 : C 1586 : 408 continue 1587 : * ELSEIF (INPLAS.EQ.108) THEN 1588 : C 1589 : IND=0 1590 : FI1 = 0.D0 1591 : FI2 = 0.D0 1592 : nexo = exova0(/1) 1593 : do 2050 inex = 1,nexo 1594 : if ((nomexo(inex).eq.'DFIS').and. 1595 : & (conexo(inex).eq.CONM)) then 1596 : fi1 = exova0(inex) 1597 : fi2 = exova1(inex) 1598 : goto 2001 1599 : endif 1600 : 2050 continue 1601 : 2001 continue 1602 : C 1603 : C NSIMP pointe sur la caracteristique de fissuration facult. qui 1604 : C indique le type de resolution souhaite 1605 : C 1606 : IF (IFOMOD.EQ.2.AND.MFR1.EQ.1) THEN 1607 : NSIMP=71 1608 : ELSE 1609 : NSIMP=66 1610 : IF(MFR1.EQ.1.AND.IFOUR.EQ.-2) NSIMP=62 1611 : IF(MFR1.EQ.3.OR.MFR1.EQ.9) NSIMP=61 1612 : ENDIF 1613 : XSIMP=XMAT(NSIMP) 1614 : C 1615 : IF (XSIMP.EQ.0.D0) THEN 1616 : C resolution complete 1617 : C 1617 : CALL UO2OTO(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA, 1618 : 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS, 1619 : 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE) 1620 : ELSE 1621 : C resolution simplifiee 1622 : C 1622 : CALL UO2OT2(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA, 1623 : 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS, 1624 : 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE) 1625 : ENDIF 1626 : IF (KERRE.NE.0.AND.KERRE.NE.99) KERR1=1 1627 : RETURN 1628 : C 1629 : 374 continue 1630 : * ELSE IF (INPLAS.EQ.74) THEN 1631 : * 1632 : * CHAINE DE MAXWELL 1633 : * 1634 : * on commence par recuperer le nombre d'elements dans la chaine 1635 : * et les proprietes et variables internes associees a des objets 1636 : * 1637 : nbgmab=nbgmat 1638 : nlmatb=nelmat 1638 : CALL CMAXTA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMbT,NLMATb,NWA, 1639 : & NCHAIN) 1640 : nbgmat=nbgmab 1641 : nelmat=nlmatb 1642 : IF (IERR.NE.0) THEN 1643 : SEGSUP WR12 1644 : return 1645 : ENDIF 1646 : C 1647 : IF (MFRbi.EQ.3.OR.MFRbi.EQ.39) THEN 1648 : dtbi=dt 1648 : CALL CMAXGE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA) 1649 : dt=dtbi 1650 : ELSE 1651 : C 1652 : * 1653 : * MLR 10/08/99 1654 : * 1655 : * ON PASSE LE SEGMENT DE TRAVAIL WTRAV 1656 : dtbi=dt 1656 : CALL CMAXWE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA) 1657 : dt=dtbi 1658 : ENDIF 1659 : * 1660 : * ici gerer les erreurs 1661 : * 1661 : CALL CMAXTB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN) 1662 : SEGSUP WR12 1663 : RETURN 1664 : 1665 : *---------------------------------------------------------- 1666 : * modele maxott 1667 : *---------------------------------------------------------- 1668 : 406 continue 1669 : * ELSE IF (INPLAS.EQ.106) THEN 1670 : * 1671 : * on commence par recuperer le nombre d'elements dans la chaine 1672 : * et les proprietes et variables internes associees a des objets 1673 : * 1674 : nbgmab=nbgmat 1675 : nlmatb=nelmat 1675 : CALL CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAb,NLMATb,NWA, 1676 : & NCHAIN,EPSFLU) 1677 : nbgmat=nbgmab 1678 : nelmat=nlmatb 1679 : IF (IERR.NE.0) THEN 1680 : SEGSUP WR12 1681 : RETURN 1682 : ENDIF 1683 : * 1684 : * modele maxott 1685 : * 1686 : dtbi=dt 1686 : CALL CMAXOT(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA, 1687 : & EPSFLU) 1688 : dt=dtbi 1689 : * 1690 : * stockage des variables internes et des proprietes 1691 : * 1691 : CALL CMAXOB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN,EPSFLU) 1692 : SEGSUP WR12 1693 : RETURN 1694 : * 1695 : *---------------------------------------------------------- 1696 : * modeles FBB1 et FBB2 1697 : *---------------------------------------------------------- 1698 : * 1699 : 427 continue 1700 : 428 continue 1701 : * ELSE IF (INPLAS.EQ.127.OR.INPLAS.EQ.128) THEN 1702 : * 1703 : LEPLAS = INPLAS 1703 : CALL CFBB(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU, 1704 : & IECOU,LEPLAS) 1705 : RETURN 1706 : * 1707 : *---------------------------------------------------------- 1708 : * modele INCO 1709 : *---------------------------------------------------------- 1710 : 429 continue 1711 : * ELSE IF (INPLAS .EQ. 129) THEN 1712 : * 1713 : * modele INCO 1714 : * 1714 : CALL INCO(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU) 1715 : RETURN 1716 : * 1717 : *---------------------------------------------------------- 1718 : * modele FLUTRA 1719 : *---------------------------------------------------------- 1720 : 443 continue 1721 : * ELSE IF (INPLAS .EQ. 143) THEN 1722 : * 1723 : * modele FLUTRA 1724 : * 1725 : NMATER = NMATT + 3 1726 : LWTRA = NMATER + (8*NSTRS) + (3*NSTRS*NSTRS) 1727 : IF(LW.LT.LWTRA) THEN 1728 : LW = LWTRA 1729 : SEGADJ WRK3 1730 : ENDIF 1731 : * 1732 : LA1 = 1 1733 : LA2 = LA1 + NMATER 1734 : LA3 = LA2 + NSTRS 1735 : LA4 = LA3 + NSTRS 1736 : LA5 = LA4 + NSTRS 1737 : LA6 = LA5 + NSTRS*NSTRS 1738 : LA7 = LA6 + NSTRS 1739 : LA8 = LA7 + NSTRS 1740 : LA9 = LA8 + NSTRS 1741 : LA10 = LA9 + NSTRS 1742 : LA11 = LA10 + NSTRS 1743 : LA12 = LA11 + NSTRS*NSTRS 1744 : * 1744 : CALL FLUTRA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NMATT, 1745 : & IFOUR,DT,IB,IGAU,TETA1,TETA2,ITHER,NMATER, 1746 : & SIGF,VARF,WORK(LA1),WORK(LA2),WORK(LA3), 1747 : & WORK(LA4),WORK(LA5),WORK(LA6),WORK(LA7), 1748 : & WORK(LA8),WORK(LA9),WORK(LA10),WORK(LA11), 1749 : & WORK(LA12),KERRE) 1750 : RETURN 1751 : * 1752 : 450 continue 1753 : * ELSE IF (INPLAS.EQ.150) THEN 1754 : C 1755 : C MODELE BILIN_EFFX 1756 : C 1757 : KERRE=0 1757 : CALL BREVA1(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP) 1758 : RETURN 1759 : * 1760 : 451 continue 1761 : * ELSE IF (INPLAS.EQ.151) THEN 1762 : C 1763 : C MODELE ISS_GRANGE 1764 : C 1765 : KERRE=0 1765 : CALL ISSGRA(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU) 1766 : IF (KERRE.EQ.22) THEN 1767 : INTERR(1)=IB 1768 : MOTERR(1:4) = 'JOI1' 1769 : INTERR(2)=IGAU 1770 : INTERR(3)=INPLAS 1770 : CALL ERREUR(268) 1771 : ENDIF 1772 : IF (KERRE.EQ.23) THEN 1772 : CALL ERREUR(1016) 1773 : ENDIF 1774 : IF (KERRE.EQ.25) THEN 1774 : CALL ERREUR(1017) 1775 : ENDIF 1776 : RETURN 1777 : * 1778 : 452 continue 1779 : * ELSE IF (INPLAS.EQ.152) THEN 1780 : C 1781 : C MODELE RUP_THER 1782 : C 1783 : KERRE=0 1783 : CALL RUPTHE(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU) 1784 : IF (KERRE.EQ.22) THEN 1785 : INTERR(1)=IB 1786 : MOTERR(1:4) = 'JOI1' 1787 : INTERR(2)=IGAU 1788 : INTERR(3)=INPLAS 1788 : CALL ERREUR(268) 1789 : ENDIF 1790 : RETURN 1791 : * 1792 : 455 continue 1793 : * ELSE IF (INPLAS.EQ.155) THEN 1794 : C 1795 : C MODELE GERNAY 1796 : C 1797 : KERRE=0 1797 : CALL GERNAY(WRK52,WRK53,WRK54,WRK3,IB,IGAU,NBPGAU) 1798 : RETURN 1799 : 1800 : 456 continue 1801 : * ELSE IF (INPLAS.EQ.156) THEN 1802 : C 1803 : C MODELE WELLS 1804 : C 1804 : CALL WELLS(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU) 1805 : RETURN 1806 : C 1807 : C----------------------------------------------------------------------- 1808 : C Modele 'NON_LINEAIRE' 'UTILISATEUR' : integrateur externe 1809 : C specifique UMAT 1810 : C----------------------------------------------------------------------- 1811 : 899 continue 1812 : * ELSE IF (INPLAS.EQ.-1) THEN 1813 : C 1814 : KERR1 = 0 1815 : C 1816 : C Pointeur (>0) sur fonction externe si definie 1817 : m_ptre = wrk53.jecher 1818 : C 1819 : C Preparation des entrees de la routine UMAT 1820 : C N.B. Les arguments pointeurs sont reperes par des 1821 : C caracteres minuscules 1822 : C 1822 : CALL WKUMA1 ( wrk52, wkumat ) 1823 : C 1824 : C Integration de la loi externe au point courant 1825 : C N.B. Les entrees/sorties non actives ou non exploitees sont 1826 : C reperees par des caracteres minuscules 1827 : C 1828 : IF (m_ptre.LE.0) THEN 1829 : C 1830 : C Appel a UMAT standard de Cast3M 1830 : CALL UMAT ( SIGF, VARF, ddsdde, sse, spd, scd, 1831 : & rpl, ddsddt, drplde, drpldt, 1832 : & EPST0, DEPST, TIME, DTIME, 1833 : & TEMP, DTEMP, PAREX0, DPRED, 1834 : & CMNAME, ndi, nshr, NSIG0, NSTATV, 1835 : & XMATF, NPROPS, COORGA, 1836 : & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1, 1837 : & IB, IGAU, layer, kspt, kstep, KINC ) 1838 : C 1839 : ELSE 1840 : C 1841 : C Branchement a la loi externe pointee par m_ptre 1841 : C* CALL EXTLOI(m_ptre,...) 1842 : KINC = 251 1843 : C*TMP Option non disponible pour l'instant (cf. modeli.eso) 1844 : C 1845 : ENDIF 1846 : C 1847 : IF (KINC.NE.1) THEN 1848 : IF (KINC.EQ.0) THEN 1849 : ISIGN = 1 1850 : ELSE 1851 : ISIGN = ABS(KINC)/KINC 1852 : ENDIF 1853 : KERRE = ISIGN*92 1854 : KERR1 = -1-ABS(KINC) 1855 : ENDIF 1856 : C 1857 : C Releve du pas de temps optimal pour l'iteration suivante 1858 : C 1859 : DTOPTI=PNEWDT*DTIME 1860 : 1861 : RETURN 1862 : C 1863 : C----------------------------------------------------------------------- 1864 : C Modeles 'VISCO_EXTERNE' : integres par CCREEP 1865 : C----------------------------------------------------------------------- 1866 : 898 continue 1867 : * ELSE IF (INPLAS.EQ.-2) THEN 1868 : C 1869 : KERR1 = 0 1870 : C 1871 : C Pointeur (>0) sur fonction externe si definie 1872 : m_ptre = wrk53.jecher 1873 : C 1874 : IF (m_ptre.LE.0) THEN 1875 : C 1876 : C Appel a CCREEP standard de Cast3M 1877 : IFORB = IFOURB 1877 : CALL CCREEP ( wrk52, wrk53, wrk54, 1878 : & IFORB, IB, IGAU, NBPGAU, 1879 : & wcreep, iecou, xecou ) 1880 : C 1881 : ELSE 1882 : C 1883 : C Branchement a la loi externe pointee par m_ptre 1883 : C* CALL EXTLOI(m_ptre,...) 1884 : KSTEPC = 251 1885 : C*TMP Option non disponible pour l'instant (cf. modeli.eso) 1886 : C 1887 : ENDIF 1888 : 1889 : C Erreur detectee par l'integrateur CCREEP 1890 : C 1891 : IF (KERRE.NE.0) THEN 1892 : KERR1 = 1 1893 : RETURN 1894 : ENDIF 1895 : C 1896 : C Erreur lors d'un appel au module utilisateur CREEP 1897 : C 1898 : IF (KSTEPC.NE.1) THEN 1899 : IF (KSTEPC.EQ.0) THEN 1900 : ISIGN = 1 1901 : ELSE 1902 : ISIGN = ABS(KSTEPC)/KSTEPC 1903 : ENDIF 1904 : KERRE = ISIGN*93 1905 : KERR1 = -1-ABS(KSTEPC) 1906 : ENDIF 1907 : C 1908 : RETURN 1909 : C 1910 : C----------------------------------------------------------------------- 1911 : C----------------------------------------------------------------------- 1912 : * ELSE 1913 : * KERRE = 99 1914 : * ENDIF 1915 : * 1916 : RETURN 1917 : END 1918 : 1919 :
© Cast3M 2003 - All rights reserved.
Disclaimer