1 : C COML6 SOURCE FANDEUR 14/01/22 21:15:04 7891 2 : 3 : SUBROUTINE COML6(iqmod,ipcon,ipinf,indeso,insupp,itruli, IRETOU) 4 : 5 : *-------------------------------------------------------------------- 6 : * coml6 : 7 : * boucle elements et point d integration 8 : * pretraite les caracteristiques et les donnees suivant 9 : * le modele, passe a la loi locale, signale les erreurs 10 : * d integration, prepare les resultats 11 : *---------------------------------------------------------------- 12 : 13 : IMPLICIT INTEGER(I-N) 14 : IMPLICIT REAL*8(A-H,O-Z) 15 : 16 : -INC CCOPTIO 17 : -INC CCGEOME 18 : -INC CCHAMP 19 : 20 : -INC SMCHAML 21 : -INC SMELEME 22 : -INC SMCOORD 23 : -INC SMMODEL 24 : -INC SMINTE 25 : * segment deroulant le mcheml 26 : -INC DECHE 27 : SEGMENT INFO 28 : INTEGER INFELL(16) 29 : ENDSEGMENT 30 : * 31 : SEGMENT WRK2 32 : REAL*8 TRAC(LTRAC) 33 : ENDSEGMENT 34 : * 35 : SEGMENT MWRKXE 36 : REAL*8 XEL(3,NBNN) 37 : ENDSEGMENT 38 : * 39 : SEGMENT WRK3 40 : REAL*8 WORK(LW),WORK2(LW2bi) 41 : ENDSEGMENT 42 : * 43 : SEGMENT WRK6 44 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 45 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 46 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) 47 : ENDSEGMENT 48 : * 49 : SEGMENT WRK7 50 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 51 : ENDSEGMENT 52 : * 53 : SEGMENT WRK8 54 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 55 : REAL*8 DDINVp(NSTRS,NSTRS) 56 : ENDSEGMENT 57 : * 58 : SEGMENT WRK9 59 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 60 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 61 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 62 : REAL*8 SIGY(NSIGY) 63 : INTEGER NKX(NNKX) 64 : ENDSEGMENT 65 : * 66 : SEGMENT WRK91 67 : REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1) 68 : REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2) 69 : REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1) 70 : REAL*8 SIGY1(NSIGY1) 71 : ENDSEGMENT 72 : * 73 : SEGMENT WR10 74 : INTEGER IABLO1(NTABO1) 75 : REAL*8 TABLO2(NTABO2) 76 : ENDSEGMENT 77 : * 78 : SEGMENT WR11 79 : INTEGER IABLO3(NTABO3) 80 : REAL*8 TABLO4(NTABO4) 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 : segment wrkgur 95 : real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7 96 : real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6) 97 : real*8 wgur13(7), wgur14 98 : real*8 wgur15,wgur16,wgur17 99 : endsegment 100 : C 101 : C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant 102 : C l'integrateur externe specifique UMAT 103 : C 104 : SEGMENT WKUMAT 105 : C Entrees/sorties de la routine UMAT 106 : REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD, 107 : & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT, 108 : & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED), 109 : & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3) 110 : CHARACTER*16 CMNAME 111 : INTEGER NDI, NSHR, NSTATV, NPROPS, 112 : & LAYER, KSPT, KSTEP, KINC 113 : C Variables de travail 114 : LOGICAL LTEMP, LPRED, LVARI, LDFGRD 115 : INTEGER NSIG0, NPARE0, NGRAD0 116 : ENDSEGMENT 117 : C 118 : C Segment de travail pour les lois 'VISCO_EXTERNE' 119 : C 120 : SEGMENT WCREEP 121 : C Entrees/sorties constantes de la routine CREEP 122 : REAL*8 SERD 123 : CHARACTER*16 CMNAMC 124 : INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC 125 : C Entrees/sorties de la routine CREEP pouvant varier 126 : REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV), 127 : & STVP2(NSTV), STV12(NSTV), STVP3(NSTV), 128 : & STVP4(NSTV), STV13(NSTV), STVF(NSTV), 129 : & TMP12, TMP, TMP32, 130 : & DTMP12, DTMP, 131 : & PRD12(NPRD), PRD(NPRD), PRD32(NPRD), 132 : & DPRD12(NPRD), DPRD(NPRD) 133 : INTEGER KSTEPC 134 : C Autres indicateurs et variables de travail 135 : LOGICAL LTMP, LPRD, LSTV 136 : INTEGER IVIEX, NPAREC 137 : REAL*8 dTMPdt, dPRDdt(NPRD) 138 : ENDSEGMENT 139 : 140 : * Segment ECOU: sert de fourre-tout pour les tableaux 141 : * 142 : SEGMENT ECOU 143 : REAL*8 ecow00,ecow0, 144 : 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6), 145 : 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 146 : 2 ecow12(6), 147 : 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), 148 : 2 ecow17(6),ecow18(6),ecow19,ecow20 149 : ENDSEGMENT 150 : * 151 : * Segment NECOU utilisé dans ECOINC 152 : * 153 : SEGMENT NECOU 154 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 155 : . ITYP,IFOURB,IFLUAG, 156 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 157 : . JFLUAG,KFLUAG,LFLUAG, 158 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 159 : ENDSEGMENT 160 : * 161 : * Segment IECOU: sert de fourre-tout pour les initialisations 162 : * d'entiers 163 : * 164 : SEGMENT IECOU 165 : INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, 166 : . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, 167 : . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, 168 : . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, 169 : . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, 170 : . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, 171 : . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 172 : ENDSEGMENT 173 : * 174 : * Segment XECOU: sert de fourre-tout pour les initialisations 175 : * de réels 176 : * 177 : SEGMENT XECOU 178 : REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 179 : ENDSEGMENT 180 : 181 : character*16 modemo 182 : LOGICAL dimped, b_moda2 183 : * 184 : * Liste des formulations SIMPLES (cf. MODELI.eso et NOMATE.eso) 185 : * 186 : PARAMETER (MFORMU=17) 187 : CHARACTER*16 LISFOR(MFORMU) 188 : DATA LISFOR / 189 : & 'THERMIQUE ','MECANIQUE ','LIQUIDE ', 190 : & 'CONVECTION ','POREUX ','DARCY ', 191 : & 'FROTTEMENT ','RAYONNEMENT ','MAGNETODYNAMIQUE', 192 : & 'NAVIER_STOKES ','MELANGE ','EULER ', 193 : & 'FISSURE ','LIAISON ','THERMOHYDRIQUE ', 194 : & 'ELECTROSTATIQUE ','DIFFUSION ' 195 : & / 196 : * 197 : wrk6 = 0 198 : wrk8 = 0 199 : wr10 = 0 200 : wr11 = 0 201 : wrk12 = 0 202 : wrkgur=0 203 : wkumat = 0 204 : wcreep = 0 205 : * 206 : c wrk53 reste ouvert en ecriture 207 : SEGINI,wrk53 208 : iwrk53 = wrk53 209 : * 210 : ecou=0 211 : iecou=0 212 : necou=0 213 : xecou=0 214 : SEGINI,ecou,iecou,necou,xecou 215 : * write(ioimp,*) ' coml6 ecou ie ne xe',ecou,iecou,necou,xecou 216 : 217 : KERRE=0 218 : KERR1=0 219 : c 220 : c moterr(1:6) = 'COML6 ' 221 : c moterr(7:15) = 'IMODEL' 222 : c interr(1) = iqmod 222 : c call erreur(-329) 223 : *------------------------------------------- 224 : imodel = iqmod 225 : segact imodel*nomod 226 : * 227 : MELE=NEFMOD 228 : MELEME=IMAMOD 229 : melemb=meleme 230 : ipmail = imamod 231 : CONM = CONMOD 232 : segact meleme*nomod 233 : NBNNbi=NUM(/1) 234 : NBELMb=NUM(/2) 235 : nbnn2=nbnnbi 236 : nbelem2=nbelmb 237 : nbnn=nbnnbi 238 : nbelem=nbelmb 239 : c 240 : c coque integree ou pas ? 241 : c 242 : IF(INFMOD(/1).NE.0)THEN 243 : NPINT=INFMOD(1) 244 : ELSE 245 : NPINT=0 246 : ENDIF 247 : c 248 : NFOR=FORMOD(/2) 249 : NMAT=MATMOD(/2) 250 : c 251 : c Determination de la formulation du modele : 252 : c 253 : lformu = 0 254 : IF (NFOR.EQ.1) THEN 254 : CALL PLACE(LISFOR,MFORMU,lformu,FORMOD(1)) 255 : ENDIF 256 : * write(ioimp,*) 'formulation :',lformu,NFOR,FORMOD(1) 257 : if (lformu.eq.0) then 258 : write(ioimp,*) ' Arret dans coml6 : formulation non prevue ici' 258 : call erreur(5) 259 : return 260 : endif 261 : c 262 : c nature du materiau 263 : c 264 : CMATE = CMATEE 265 : MATE = IMATEE 266 : INPLAS = INATUU 267 : c 268 : dimped=.false. 269 : do jmot = 1,nmat 270 : if (matmod(jmot).eq.'IMPEDANCE') dimped = .true. 271 : enddo 272 : b_moda2 = cmate.EQ.'MODAL' .OR. cmate.EQ.'STATIQUE' .OR. dimped 273 : * 274 : * write(ioimp,*) ' coml6 inplas ' , inplas 275 : * 276 : c____________________________________________________________________ 277 : c 278 : c information sur l'element fini 279 : c____________________________________________________________________ 280 : if(ipinf.ne.0) then 281 : INFO=IPINF 282 : c* segact info 283 : MFRbi =INFELL(13) 284 : NBG =INFELL(6) 285 : NBGS =INFELL(4) 286 : NSTRS=INFELL(16) 287 : LRE =INFELL(9) 288 : LHOOK=INFELL(10) 289 : c* IF (MELE.EQ.96) NBNO = INFELL(8) 290 : IPORE=INFELL(8) 291 : MINTE=INFELL(11) 292 : else 293 : MFRbi =INFELE(13) 294 : NBG =INFELE(6) 295 : NBGS =INFELE(4) 296 : NSTRS=INFELE(16) 297 : LRE =INFELE(9) 298 : LHOOK=INFELE(10) 299 : c* IF (MELE.EQ.96) NBNO = INFELE(8) 300 : IPORE=INFELE(8) 301 : MINTE=INFMOD(2+insupp) 302 : endif 303 : * 304 : MFR=MFRbi 305 : nstrss=nstrs 306 : * On active une fois pour toutes le segment MINTE : 307 : IPMINT = MINTE 308 : IF (IPMINT.GT.0) SEGACT,MINTE 309 : * 310 : IF (MFRbi.EQ.3.AND.NPINT.NE.0) LHOOK=4 311 : LHOO2=LHOOK*LHOOK 312 : * 313 : IF (MFRbi.EQ.33) THEN 314 : NBNO=IPORE 315 : IPPORE=NBNNbi 316 : ELSE 317 : NBNO=NBNNE(NUMGEO(MELE)) 318 : IPPORE=0 319 : ENDIF 320 : * 321 : LW =200 322 : LW2bi =150 323 : LW2=150 324 : *------------------------------------------------- 325 : * 326 : NBPTEL=NBGS 327 : NEL=NBELMb 328 : * 329 : N1PTEL=NBPTEL 330 : N1EL=NEL 331 : N2PTEL=0 332 : N2EL=0 333 : 334 : c pour les variables internes seules 335 : IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN 336 : IF (CMATE.EQ.'SECTION') THEN 337 : C* IF (MATE.EQ.11) THEN <- Test equivalent ? 338 : N2PTEL=NBPTEL 339 : N2EL=NEL 340 : ENDIF 341 : ENDIF 342 : *------------------------------------------------- 343 : * ouverture de tous les melval 344 : * creation wrk52 qui reste ouvert en ecriture 345 : *------------------------------------------------- 345 : CALL COMOUW(iqmod,ipcon,indeso,ipil,iwrk52,iwrk53,iretou,iwr522) 346 : 347 : *------------------------------------------------- 348 : * complete wrk53 349 : *------------------------------------------------- 350 : wrk52 = iwrk52 351 : c segact wrk52 352 : nmatt = xmat(/1) 353 : NUMAT = nmatt 354 : * ncarr = xcarb(/1) 355 : * NUCAR = ncarr 356 : nvart = var0(/1) 357 : C------------------------------------------------- 358 : C Petits tests de compatibilite des donnees 359 : C pour les lois externes 360 : C------------------------------------------------- 361 : IF (INPLAS.LT.0) THEN 362 : NTURE0 = TURE0(/1) 363 : IF (NTURE0.NE.0.AND.NTURE0.GT.1) THEN 364 : * write(ioimp,*) 'COML6 : test NTURE0 enleve',NTURE0 364 : c* CALL ERREUR(963) 365 : c* RETURN 366 : ENDIF 367 : IF (INPLAS.EQ.-1) THEN 368 : NSIGM0 = SIG0(/1) 369 : NEPST0 = EPST0(/1) 370 : IF (NSIGM0.GT.0.AND.NEPST0.GT.0.AND.NSIGM0.NE.NEPST0) THEN 370 : CALL ERREUR(963) 371 : RETURN 372 : ENDIF 373 : ENDIF 374 : ENDIF 375 : *------------------------------------------------- 376 : * creation des deche en sortie 377 : *------------------------------------------------- 377 : CALL COMCRI(iqmod,ipcon,IPMINT,indeso,ipil,insupp,iwrk53,iretou) 378 : if (ierr.ne.0) return 379 : c liluc = ipil 380 : 381 : * pas de calcul de caracteristiques pour le melange parallele 382 : C* if (formod(1).eq.'MELANGE'.and.cmate.eq.'PARALLEL') goto 1998 383 : if (lformu.eq.11) then 384 : if (cmate.eq.'PARALLEL') goto 1998 385 : endif 386 : 387 : *------------------------------------------------- 388 : * verification du type des champs 389 : *------------------------------------------------- 389 : CALL COMTRI(iqmod,ipil,wrk53) 390 : if (ierr.ne.0) return 391 : c 392 : *------------------------------------------------- 393 : c Initialisations de variables 394 : *------------------------------------------------- 395 : c - mise à zéro des variables du commun NECOU si besoin 396 : c - modèles viscoplastiques: 397 : c . on récupère le pas de temps 398 : c . on récupère le nombre maximal de sous-pas 399 : c . on met IND=1 400 : c - initialisation des dimensions des tableaux des segments 401 : c Sorties: en plus du commun NECOU, on range les autres données 402 : c initialisées dans les COMMON IECOU et XECOU 402 : CALL COMDEF(iwrk53,necou,iecou,xecou) 403 : IF (KERRE.EQ.999) RETURN 404 : c 405 : * write(ioimp,*) ' coml6 ,cmate,mfrbi,nbno,mele,npint' 406 : * & ,cmate,mfrbi,nbno,mele,npint 407 : 408 : IPTR1 = 0 409 : IF (MFRbi.EQ. 1 .OR. MFRbi.EQ.31 .OR. MFRbi.EQ.33 .OR. 410 : & MFRbi.EQ.71 .OR. MFRbi.EQ.73) THEN 411 : IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 412 : 1 CMATE.EQ.'UNIDIREC') THEN 413 : C* IF (MATE.EQ.2 .OR. MATE.EQ.3 .OR. MATE.EQ.4) THEN <- Test equivalent ? 414 : mele1 = MELE 415 : npint1 = NPINT 416 : nbno1 = NBNO 417 : ielei=iele 417 : CALL RESHPT(1,nbno1,IELEi,mele1,npint1,IPTR1,IRT1) 418 : if (ierr.ne.0) return 419 : MINTE2=IPTR1 420 : SEGACT MINTE2 421 : ENDIF 422 : ENDIF 423 : * 424 : * initialisation des segments de travail 425 : * 426 : SEGINI WRK2,WRK3 427 : 428 : NBNN = nbnn2 429 : SEGINI,MWRKXE 430 : 431 : IF (LOGVIS) SEGINI WRK8 432 : IF(INPLAS.EQ.26)THEN 433 : SEGINI WRK6 434 : ENDIF 435 : c 436 : segini wrk54 437 : iwrk54 = wrk54 438 : c ouverture du segment wrk12 ne sert que pour le modele beinsa inplas=66 439 : if(inplas.eq.66) segini wrk12 440 : C ouverture de wrkgur pour modele de gurson inplas=38 441 : if(inplas.eq.38) segini wrkgur 442 : 443 : C Pour les modeles autres que non lineaires externes : 444 : C pas besoin des coordonnees du point d'integration courant 445 : c Pas besoin de la longueur caracteristique de l'element courant 446 : C On les met a zero une fois pour toutes 447 : COORGA(1)=0.0D0 448 : COORGA(2)=0.0D0 449 : COORGA(3)=0.0D0 450 : LCARAC=0.0D0 451 : 452 : C Objets de travail pour une loi non lineaire externe 453 : IF (INPLAS.LT.0) THEN 454 : IF (INPLAS.EQ.-1) THEN 455 : NTENS=SIG0(/1) 456 : NPRED=PAREX0(/1) 457 : SEGINI,WKUMAT 458 : IFORB=IFOURB 458 : CALL WKUMA0 ( iqmod, iwrk52, wkumat, IFORB ) 459 : C* ELSE IF (INPLAS.EQ.-2) THEN 460 : ELSE 461 : NSTV=VAR0(/1)-4 462 : IF (NSTV.EQ.0) NSTV=1 463 : NPRD=PAREX0(/1) 464 : SEGINI,WCREEP 464 : CALL WCREE0 ( iqmod, iwrk52, wcreep ) 465 : ENDIF 466 : C*TMP Deb On met dans wrk53.jecher le pointeur de la fonction externe 467 : C*TMP Voir plus tard pour affiner via segment wkumat/wcreep... 468 : wrk53.jecher = 0 469 : nobmod = ivamod(/1) 470 : if (nobmod.gt.0) then 471 : noblib = 0 471 : CALL PLACE(tymode,nobmod,noblib,'LMEEXT ') 472 : if (noblib.ne.0) then 473 : wrk53.jecher = ivamod(noblib) 474 : endif 475 : endif 476 : C*TMP Fin 477 : ENDIF 478 : * 479 : * write(6,*)'coml6 ,nel,nbptel,inplas,mfrbi,cmate,mate,ifour,mele' 480 : * write(6,*)'coml6 ',nel,nbptel,inplas,mfrbi,cmate,mate,ifour,mele 481 : * boucles 482 : ncourb=0 483 : segini wrk7 484 : NYOG=0 485 : NYNU=0 486 : NYALFA=0 487 : NYSMAX=0 488 : NYN=0 489 : NYM=0 490 : NYKK=0 491 : NYALF1=0 492 : NYBET1=0 493 : NYR=0 494 : NYA=0 495 : NYKX=0 496 : NYRHO=0 497 : NSIGY=0 498 : NNKX=0 499 : segini wrk9 500 : NYOG1=0 501 : NYNU1=0 502 : NYALFT1=0 503 : NYSMAX1=0 504 : NYN1=0 505 : NYM1=0 506 : NYKK1=0 507 : NYALF2=0 508 : NYBET2=0 509 : NYR1=0 510 : NYA1=0 511 : NYQ1=0 512 : NYRHO1=0 513 : NSIGY1=0 514 : segini wrk91 515 : 516 : do 1000 ib=1,nel 517 : 518 : * (MWRKXE) Recuperation des coordonnees des noeuds de l'element 518 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL) 519 : 520 : * (WRK54) calcul des axes locaux 520 : CALL COMROT(iwrk53,IB,IPTR1,MWRKXE,iwrk54) 521 : if (ierr.ne.0) return 522 : 523 : * CALCUL DE LA LONGUEUR CARACTERISTIQUE DE L'éLéMENT COURANT 524 : * POUR MODèLE BETON URGC INSA 525 : IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR. 526 : 1 (INPLAS.GE.120.AND.INPLAS.LE.122)) THEN 526 : CALL LONGCA(IPMAIL,IB,BID(1)) 527 : ENDIF 528 : 529 : * Modeles non lineaires externes 'NON_LINEAIRE' 'UTILISATEUR' : 530 : * - Releve des coordonnees des noeuds de l'element courant, 531 : * - Calcul de la longueur caracteristique de l'element courant 532 : * - Releve de la matrice de passage DROT du repere local de l'element 533 : * fini massif au repere general du maillage 534 : IF (INPLAS.EQ.-1) THEN 535 : IF (IPTR1.NE.0) THEN 536 : DO 200 J=1,IDIM 537 : DO 200 I=1,IDIM 538 : DROT(I,J)=TXR(I,J) 539 : 200 CONTINUE 540 : ENDIF 540 : CALL LOCARA(IDIM,NBNN,XEL,LCARAC) 541 : ENDIF 542 : 543 : DO 100 igau =1,nbptel 544 : 545 : * -recuperation de valmat et de valcar 546 : * -on recupere les contraintes initiales 547 : * -on recupere les variables internes 548 : * -on recupere les deformations inelastiques initiales si besoin 549 : * -on recupere les increments de deformations totales 550 : * -on cherche la section de l'element ib 551 : * -prise en compte de l'epaisseur et de l'excentrement 552 : * dans le cas des coques minces avec ou sans cisaillement 553 : * transverse 554 : * 555 : * on recupere les constantes du materiau 556 : * calcul des contraintes effectives en milieu poreux 557 : * 558 : * --- remplissage de wrk52 559 : * on recupere les caracteristiques geometriques 559 : CALL COMVAL(iqmod,indeso,ipil,iwrk52,iwrk53,ib,igau, 560 : & necou,iecou,xecou,iwr522) 561 : if (ierr.ne.0) return 562 : * 563 : *---- quelques arrangements 563 : CALL COMARA(IQMOD,IWRK52,IWRK53,IWRK54,wrk2,wr10,ib,igau, 564 : & iretou,necou,iecou,xecou,itruli) 565 : if (ierr.ne.0) return 566 : if (iretou.ne.0) goto 1990 567 : * >>>>>>>>>> fin du traitement du materiau 568 : * 569 : C Pour les modeles non lineaires externes : calcul des coordonnees 570 : C du point d'integration courant 571 : IF (INPLAS.LT.0) THEN 572 : DO 101 IX=1,IDIM 573 : r_z = 0.0D0 574 : DO 102 INO=1,NBNN 575 : r_z = r_z +XEL(IX,INO)*SHPTOT(1,INO,IGAU) 576 : 102 CONTINUE 577 : COORGA(IX) = r_z 578 : 101 CONTINUE 579 : ENDIF 580 : * 581 : * lois au point d integration 582 : c 583 : c traitement du modele 584 : c 585 : c Branchement suivant la formulation : 586 : c 587 : GOTO (9999,9002,9999,9999,9002,9999,9999,9999,9999,9999,9011,9999, 588 : & 9999,9014,9999,9999,9017),lformu 589 : 590 : 9999 CONTINUE 591 : c---- FORMULATION : THERMIQUE / LIQUIDE / CONVECTION / 592 : c DARCY / FROTTEMENT / RAYONNEMENT / 593 : c MAGNETODYNAMIQUE / NAVIER_STOKES / 594 : c EULER / FISSURE / THERMOHYDRIQUE / 595 : c ELECTROSTATIQUE / 596 : * write(ioimp,*) 'Formulation non implementee' 597 : RETURN 598 : c 599 : c---- FORMULATION : MECANIQUE / POREUX 600 : 9002 CONTINUE 601 : 602 : IF (b_moda2) THEN 603 : iforb=ifourb 604 : nbgmab=nbgmat 605 : nlmatb=nelmat 606 : xdt = dt 606 : CALL cmoda2(wrk52,wrk53,xdt,ib,igau,nbpgau,nbgmab,nlmatb,iforb) 607 : ifourb=iforb 608 : nbgmat=nbgmab 609 : nelmat=nlmatb 610 : ELSE 611 : jnppla=inplas+3 612 : * Cas VISCO_EXTERNE (inplas = -2) et UMAT (inplas = -1) 613 : GOTO( 8, 8, 614 : * inplas 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 615 : $ 7,7, 8, 7, 7, 7,111, 7,111, 8,111,111, 7,111, 8, 7, 616 : * 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 617 : $ 8, 7, 8, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 618 : * 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 619 : $ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, 7, 620 : * 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 621 : $ 111, 8, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8, 8, 622 : * 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 623 : $ 7, 8, 7, 8, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, 624 : * 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 625 : $ 7, 7, 8, 8, 8,111, 7,111, 7, 7, 7, 7, 8, 8, 7, 626 : * 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 627 : $ 8, 8, 8, 7, 7, 8, 8, 8, 7, 7, 7, 7, 7, 8, 7, 628 : * 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 629 : $ 8, 7, 8,111,111, 7, 7, 7,111,111,111,111, 8, 8, 7, 630 : * 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 631 : $ 7, 7,111,111, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, 632 : * 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 633 : $ 7, 7, 7, 7, 8, 8, 8, 8, 12, 12, 12, 8, 111,111, 8, 634 : * 151 152 153 154 155 156 157 158 159 160 635 : $ 8, 8, 12, 12, 8, 8, 12, 12, 12, 12 636 : $ )jnppla 637 : 111 continue 638 : write(ioimp,*) ' stop dans coml6 : comportement pas prevu ici' 639 : write(ioimp,*) ' inplas jnppla ',inplas,jnppla 639 : CALL erreur(5) 640 : return 641 : 7 continue 642 : * if(ib.eq.1.and.igau.eq.1) write(ioimp,*) 'appel coml7' 642 : CALL coml7(iqmod,iwrk52,iwrk53,iwrk54,ib,igau, 643 : & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, 644 : & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) 645 : go to 2000 646 : 8 continue 647 : * if(ib.eq.1.and.igau.eq.1) write(ioimp,*) ' appel coml8' 647 : CALL coml8(iqmod,iwrk52,iwrk53,iwrk54,ib,igau, 648 : & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, 649 : & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) 650 : go to 2000 651 : 12 continue 652 : C if(ib.eq.1.and.igau.eq.1) write(ioimp,*) ' appel coml12' 652 : CALL coml12(iqmod,iwrk52,iwrk53,iwrk54,ib,igau, 653 : & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, 654 : & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) 655 : go to 2000 656 : ENDIF 657 : GOTO 2000 658 : 659 : c---- FORMULATION : MELANGE (microstructures) 660 : 9011 CONTINUE 661 : * 662 : IF (CMATE.EQ.'MGRAIN') THEN 662 : CALL mgrain(xmat0,ture0,xmatf,turef) 663 : 664 : ELSE if (CMATE.EQ.'CEREM') then 665 : * constituer en cas de besoin les nuages d interpolation 666 : ipnua1 = int(xmat0(16)) 667 : modemo = 'CEREMREFR' 667 : CALL copret(ipnua1,ilent1,modemo) 668 : if (ilent1.eq.0) then 668 : CALL chist(ipnua1,ilent1,iwrk52,modemo) 669 : if (ierr.ne.0) return 669 : call compre(ipnua1,ilent1,modemo) 670 : endif 671 : * 672 : modemo = 'CEREMCHAU' 673 : ipnua1 = int(xmat0(17)) 673 : call copret(ipnua1,ilent2,modemo) 674 : if (ilent2.eq.0) then 674 : call chist(ipnua1,ilent2,iwrk52,modemo) 675 : if (ierr.ne.0) return 675 : call compre(ipnua1,ilent2,modemo) 676 : endif 677 : * 677 : call CRPHA3(iwrk52,iwrk53,ilent1,ilent2,IB,igau) 678 : * 679 : ELSE if (CMATE.EQ.'LEBLOND') then 679 : call clebl3(iwrk52,IB,igau) 680 : * 681 : ELSE if (CMATE.EQ.'ZTMAX') then 681 : call cztmax(iwrk52,iwrk53, ib,igau) 682 : * 683 : ELSE if (CMATE.EQ.'TMM_LMT2') then 683 : call t4m(iwrk52,iwrk53, ib,igau) 684 : * 685 : ENDIF 686 : GOTO 2000 687 : 688 : c---- FORMULATION : LIAISON 689 : 9014 CONTINUE 690 : if (itruli.le.0) then 691 : write(ioimp,*) ' stop dans coml6 : itruli <= 0' 691 : call erreur(5) 692 : return 693 : endif 694 : if (mate.ge.23) then 694 : call coml11(iqmod,wrk52,wrk53,ib,igau,itruli,iretou) 695 : else 695 : call coml10(iqmod,wrk52,wrk53,ib,igau,itruli,iretou) 696 : endif 697 : GOTO 2000 698 : 699 : c----- FORMULATION : DIFFUSION 700 : 9017 CONTINUE 701 : write(ioimp,*) 'DIFFUSION : a faire !!!' 702 : GOTO 2000 703 : 704 : * Erreurs 705 : * 706 : 2000 continue 707 : if (ierr.ne.0) return 708 : * 709 : * - problèmes de convergence 710 : * 711 : interr(3) = inplas 711 : CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC) 712 : if (ierr.ne.0) return 713 : * 714 : * - autres problèmes 715 : * 716 : 1990 CONTINUE 717 : IF (kerre.NE.0) THEN 718 : jnplas = inplas 719 : jmfr = mfrbi 720 : jmele = mele 721 : jkerr1 = kerr1 722 : jkerre = kerre 723 : if (jnplas.LT.0) MOTERR(5:20) = wkumat.cmname(1:16) 723 : CALL DEFER2(JNPLAS,JMFR,JMELE,IB,IGAU, jkerr1,jkerre) 724 : if (ierr.ne.0) return 725 : ENDIF 726 : c 727 : c remplissage des melval contenant les contraintes a la fin 728 : * ( rearrangement pour milieu poreux ), 729 : c les variables internes finales 730 : c et les increments de deformations plastiques 731 : c stocke pas de temps optimal 732 : c 732 : CALL COMSOR(iqmod,ipil,iwrk52,iwrk53,iwrk54,ib,igau,iecou,xecou) 733 : if (ierr.ne.0) return 734 : c 735 : C----------------------------------------------------------------------- 736 : c fin de la boucle sur les points de gauss 737 : 100 continue 738 : C----------------------------------------------------------------------- 739 : c 740 : c special poutres et tuyaux sauf timoschenko 741 : c 742 : if (.not.dimped) then 742 : CALL COMPOU(IB,mwrkxe,ipil,iwrk53) 743 : if (ierr.ne.0) return 744 : endif 745 : C----------------------------------------------------------------------- 746 : c fin de la boucle sur les elements 747 : 1000 continue 748 : C----------------------------------------------------------------------- 749 : * 750 : C Desactivation de segments 751 : IF (IPMINT.GT.0) SEGDES,MINTE 752 : IF (IPTR1.NE.0) THEN 753 : C* IF (MFRbi.EQ. 1 .OR. MFRbi.EQ.31 .OR. MFRbi.EQ.33 .OR. 754 : C* & MFRbi.EQ.71 .OR. MFRbi.EQ.73) THEN 755 : C* IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 756 : C* 1 CMATE.EQ.'UNIDIREC') THEN 757 : C*C* IF (MATE.EQ.2 .OR. MATE.EQ.3 .OR. MATE.EQ.4) THEN <- Test equivalent ? 758 : SEGDES MINTE2 759 : C* ENDIF 760 : ENDIF 761 : c Destruction des segments de travail 762 : SEGSUP wrk7,wrk9,wrk91 763 : SEGSUP WRK2,WRK3 764 : SEGSUP MWRKXE 765 : IF (wrk6.NE.0) SEGSUP,WRK6 766 : IF (LOGVIS) SEGSUP,WRK8 767 : if (wr10.ne.0) segsup wr10 768 : if (wr11.ne.0) segsup wr11 769 : if (wrk12.ne.0) segsup wrk12 770 : if (wrkgur.ne.0) segsup wrkgur 771 : IF (wkumat.ne.0) SEGSUP,WKUMAT 772 : IF (wcreep.ne.0) SEGSUP,WCREEP 773 : segsup wrk54 774 : 1998 CONTINUE 775 : segsup wrk53 776 : segsup ecou,iecou,necou,xecou 777 : c Fermeture des melval & destruction des segments associes 777 : CALL COMFIN(ipil,iwrk52,iwr522) 778 : 779 : return 780 : end 781 : 782 :
© Cast3M 2003 - All rights reserved.
Disclaimer