C COML8 SOURCE FANDEUR 14/01/22 21:15:05 7891 SUBROUTINE COML8(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2, & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) *---------------------------------------------------------------- * lois locales pour la mecanique * decrites au point d integration *---------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO -INC CCGEOME -INC CCHAMP -INC SMMODEL -INC SMELEME -INC SMINTE -INC SMCOORD * segment deroulant le mcheml -INC DECHE * SEGMENT WRK2 REAL*8 TRAC(LTRAC) ENDSEGMENT * SEGMENT WRK3 REAL*8 WORK(LW),WORK2(LW2) ENDSEGMENT * SEGMENT MWRKXE REAL*8 XE(3,NBNNbi) ENDSEGMENT * SEGMENT WRK6 REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) ENDSEGMENT * SEGMENT WRK7 REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) ENDSEGMENT * SEGMENT WRK8 REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) REAL*8 DDINVp(NSTRS,NSTRS) ENDSEGMENT * SEGMENT WRK9 REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) REAL*8 SIGY(NSIGY) INTEGER NKX(NNKX) ENDSEGMENT * SEGMENT WRK91 REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1) REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2) REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1) REAL*8 SIGY1(NSIGY1) ENDSEGMENT * SEGMENT WR10 INTEGER IABLO1(NTABO1) REAL*8 TABLO2(NTABO2) ENDSEGMENT * SEGMENT WR11 INTEGER IABLO3(NTABO3) REAL*8 TABLO4(NTABO4) ENDSEGMENT * SEGMENT WR12 REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) REAL*8 SM8(NSTRS) ENDSEGMENT SEGMENT WRK12 real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9 real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17 real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25 real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33 real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41 real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49 real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55 integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8 integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16 ENDSEGMENT segment wrkgur real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7 real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6) real*8 wgur13(7), wgur14 real*8 wgur15,wgur16,wgur17 endsegment C C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant C l'integrateur externe specifique UMAT C SEGMENT WKUMAT C Entrees/sorties de la routine UMAT REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD, & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT, & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED), & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3) CHARACTER*16 CMNAME INTEGER NDI, NSHR, NSTATV, NPROPS, & LAYER, KSPT, KSTEP, KINC C Variables de travail LOGICAL LTEMP, LPRED, LVARI, LDFGRD INTEGER NSIG0, NPARE0, NGRAD0 ENDSEGMENT C C Segment de travail pour les lois 'VISCO_EXTERNE' C SEGMENT WCREEP C Entrees/sorties constantes de la routine CREEP REAL*8 SERD CHARACTER*16 CMNAMC INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC C Entrees/sorties de la routine CREEP pouvant varier REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV), & STVP2(NSTV), STV12(NSTV), STVP3(NSTV), & STVP4(NSTV), STV13(NSTV), STVF(NSTV), & TMP12, TMP, TMP32, & DTMP12, DTMP, & PRD12(NPRD), PRD(NPRD), PRD32(NPRD), & DPRD12(NPRD), DPRD(NPRD) INTEGER KSTEPC C Autres indicateurs et variables de travail LOGICAL LTMP, LPRD, LSTV INTEGER IVIEX, NPAREC REAL*8 dTMPdt, dPRDdt(NPRD) ENDSEGMENT * SEGMENT ENDO0 REAL*8 ENDO(LENDO),RAPP(LENDO) ENDSEGMENT * character*16 modemo REAL*8 CRIGI(12),CMASS(12) DIMENSION NWA(9) DIMENSION SIG01(8),VAR01(37) DIMENSION EPSFLU(8) SEGMENT ECOU REAL*8 ecow00,ecow0, C REAL*8 TEST, ALFAH, 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6), C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 2 ecow12(6), C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 2 ecow17(6),ecow18(6),ecow19,ecow20 C 2 SIPLAD(6),DSIGP0(6),TET,TETI ENDSEGMENT * * Segment NECOU utilisé dans ECOINC * SEGMENT NECOU INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, . ITYP,IFOURB,IFLUAG, . ICINE,ITHER,IFLUPL,ICYCL,IBI, . JFLUAG,KFLUAG,LFLUAG, . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF ENDSEGMENT * * Segment IECOU: sert de fourre-tout pour les initialisations * d'entiers * SEGMENT IECOU INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 ENDSEGMENT * * Segment XECOU: sert de fourre-tout pour les initialisations * de réels * SEGMENT XECOU REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 ENDSEGMENT C----------------------------------------------------------------------- C c moterr(1:6) = 'COML8 ' c moterr(7:15) = 'element ' c interr(1) = ib c interr(2) = igau c call erreur(-329) * write(6,*) ' entrée dans coml8 iecou ', iecou imodel = iqmod c c traitement du modele c c NFOR=FORMOD(/2) c NMAT=MATMOD(/2) c NBPGAU = nbgs NVARI = NVART TETA1 = ture0(1) TETA2 = turef(1) SUCC1 = -1.E35 SUCC2 = -1.E35 nexo = exova0(/1) if (nexo.gt.0) then do 1296 inex = 1,nexo if ((nomexo(inex).eq.'SUCC').and.(conexo(inex).eq.CONM)) then SUCC1 = exova0(inex) SUCC2 = exova1(inex) goto 1295 endif 1296 continue endif 1295 continue jnplas = inplas + 3 * inplas -2 -1 0 GOTO ( 898, 899, 900, * inplas 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 $ 900,302,900,900,900,900,900,900,309,900,900,900,900,314,900, $ 316,900,318,900,900,900,900,900,900,900,326,327,328,329,330, * 31 $ 331,332,333,334,335,336,337,338,339,340,341,342,900,900,900, $ 900,347,348,349,350,351,352,900,354,355,356,357,358,359,360, * 61 $ 900,362,900,364,365,366,367,368,369,900,371,372,373,374,375, $ 900,900,378,379,380,900,900,900,900,900,900,900,388,389,900, * 91 $ 391,392,393,900,900,396,397,398,900,900,900,900,900,404,900, $ 406,900,408,900,900,900,900,900,900,900,900,900,418,419,900, * 121 $ 900,900,900,900,425,900,427,428,429,900,431,432,433,434,435, $ 900,900,900,900,440,441,442,443,900,900,900,447,900,900,450, * 151 152 155 156 157 158 159 160 $ 451,452,900,900,455,456,900,900,900,900 $ ) JNPLAS 900 continue write(6,*) ' erreur d aiguillage coml8' call erreur (5) return *--------------------------------------------------------------------- * modeles de viscoplasticite integres par consti * avec endommagement *--------------------------------------------------------------------- 329 continue * IF (INPLAS .EQ. 29) THEN ntabo1 = iablo1(/1) ntabo2 = tablo2(/1) * NYOG=IABLO1(1) NYNU=IABLO1(2) NYALFA=IABLO1(3) NYSMAX=IABLO1(4) NYN=IABLO1(5) NYM=IABLO1(6) NYKK=IABLO1(7) NYALF1=IABLO1(8) NYBET1=IABLO1(9) NYR=IABLO1(10) NYA=IABLO1(11) C INTMAT=NMATT C IF (NTABO1.EQ.INTMAT) THEN NNKX=1 NYKX=IABLO1(12) ELSE NNKX=IABLO1(12) NYKX=0 DO 1881 I=1,NNKX 1881 NYKX=NYKX+(2*IABLO1(12+I)) NYKX=NYKX+NNKX ENDIF NYRHO=IABLO1(NTABO1) NSIGY=1 SEGINI WRK9 inplas2 = INPLAS ifour2 = IFOUR mfr2 = MFRbi CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2) SEGSUP WR10 IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN NCOURB=2*NKX(1) ELSE NCOURB=NKX(1) DO 1882 I=1,NNKX 1882 IF (NKX(I).GE.NCOURB) NCOURB=NKX(I) NCOURB=2*NCOURB ENDIF SEGINI WRK7 *** IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN IF (VAR0(3).GE.0.96) THEN CALL ZDANUL(SIGF,NSTRS) DO 1883 I=1,NVARI VARF(I) = VAR0(I) 1883 CONTINUE VARF(3) = 1.D0 DO 1884 I=1,NSTRS EPINF(I) = EPIN0(I) 1884 CONTINUE ELSE FI1=0.D0 FI2=0.D0 dtbi=dt iforb=ifourb nccor = ncourb CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91, 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2, 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou) ifourb=iforb ncourb=nccor c *** IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN IF (TLIFE.GE.0.D0) THEN INTERR(1)=IB INTERR(2)=IGAU REAERR(1)=TLIFE CALL ERREUR(-279) ENDIF DTOPTI = MIN(DTOPTI,DTT) NINCMA = MAX(NINCMA,NSSINC) NCOMP = NCOMP + 1 TSOM = TSOM + DTT NSOM = NSOM + NSSINC NINV = NINV + INV TCAR = TCAR + DTT* DTT IF (KERRE.NE.0) THEN KERR1=1 ENDIF ENDIF SEGSUP WRK7 SEGSUP WRK9 RETURN C 442 continue * ELSEIF (INPLAS .EQ. 142) THEN ntabo1 = iablo1(/1) ntabo2 = tablo2(/1) * NYOG1=IABLO1(1) NYNU1=IABLO1(2) NYALFT1=IABLO1(3) NYSMAX1=IABLO1(4) NYN1=IABLO1(5) NYM1=IABLO1(6) NYKK1=IABLO1(7) NYALF2=IABLO1(8) NYBET2=IABLO1(9) NYR1=IABLO1(10) NYA1=IABLO1(11) NYQ1=IABLO1(12) NYRHO1=IABLO1(NTABO1) NSIGY1=1 SEGINI WRK91 inplas2 = INPLAS ifour2 = IFOUR mfr2 = MFRbi CALL MAT142(WR10,WRK91,inplas2,ifour2,mfr2) SEGSUP WR10 SEGINI WRK7 IF (VAR0(8).GE.0.96) THEN CALL ZDANUL(SIGF,NSTRS) DO I=1,NVARI VARF(I) = VAR0(I) ENDDO VARF(8) = 1.D0 DO I=1,NSTRS EPINF(I) = EPIN0(I) ENDDO ELSE FI1=0.D0 FI2=0.D0 dtbi=dt iforb=ifourb nccor = ncourb CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91, 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2, 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou) segact necou*mod ifourb=iforb ncourb=nccor c IF (TLIFE.GE.0.D0) THEN INTERR(1)=IB INTERR(2)=IGAU REAERR(1)=TLIFE CALL ERREUR(-279) ENDIF DTOPTI = MIN(DTOPTI,DTT) NINCMA = MAX(NINCMA,NSSINC) NCOMP = NCOMP + 1 TSOM = TSOM + DTT NSOM = NSOM + NSSINC NINV = NINV + INV TCAR = TCAR + DTT* DTT IF (KERRE.NE.0) THEN KERR1=1 ENDIF ENDIF SEGSUP WRK7 SEGSUP WRK91 RETURN c c modele plastique d'endommagement de lemaitre c ++++++++++++++++++++++++++++++++++++++++++++ c traitement du materiau qui depend eventuellement de la temperature c ------------------------------------------------------------------ 326 continue * ELSE IF (INPLAS.EQ.26) THEN ntabo1 = iablo1(/1) ntabo2 = tablo2(/1) NYOG=IABLO1(1) NYNU=IABLO1(2) NYRHO=IABLO1(3) NYALFA=IABLO1(4) c IF ((MFRbi.EQ.1.OR.MFRbi.EQ.31.OR.MFRbi.EQ.33).AND.IFOUR.EQ.-2) c & THEN c+DC INTMAT=9 c INTMAT=10 c ELSE c+DC INTMAT=8 c INTMAT=9 c ENDIF INTMAT=NMATT IF (NTABO1.EQ.INTMAT) THEN NNKX=1 NYKX=IABLO1(5) IEPS=0 ELSE NNKX=IABLO1(5) NYKX=0 DO 1789 I=1,NNKX 1789 NYKX=NYKX+(2*IABLO1(5+I)) NYKX=NYKX+NNKX IEPS=1 ENDIF IORIGI=6+(IEPS*NNKX) NYN=IABLO1(IORIGI) NYM=IABLO1(IORIGI+1) NYKK=IABLO1(IORIGI+2) NYSMAX=0 NYALF1=0 NYBET1=0 NYR=0 NYA=0 NSIGY=0 SEGINI WRK9 inplas2 = INPLAS ifour2 = IFOUR mfr2 = MFRbi * write(6,*) ' coml8 inplas2 ifour2 mfr2 ifourb' * write(6,*) inplas2,ifour2,mfr2,ifourb CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2) * write(6,*) ' sortier de mat29 kerre',kerre SEGSUP WR10 c c *** si le pt. de gauss est ruine, les contr. sont annulees et c *** on n' ecoule pas c CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP) IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN DO 1115 IEN=1,NVARI VARF(IEN)=VAR0(IEN) 1115 continue VARF(3)=1.D0 CALL ZDANUL(SIGF,NSTRS) CALL ZDANUL(DEFP,NSTRS) ELSE c ---------------------------------------------------------------------- c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d c p est en supplement c ---------------------------------------------------------------------- NNVARI=2 IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN nccor=ncourb CALL CCOTRA(WRK52,WRK2,Nccor,WRK53) NCOURB=2*NKX(1) ELSE NCOURB=NKX(1) DO 1119 I=1,NNKX 1119 if (nkx(i).ge.ncourb) ncourb=nkx(i) NCOURB=4*NCOURB ENDIF IF (KERRE.EQ.0) THEN SEGINI WRK7 trefab=trefa iforb=ifourb nccor=ncourb CALL CENDOM(wrk52,wrk53,wrk54,WRK6,WRK7,WRK8,WRK9, 1 NVARI, TETA1,TETA2,TREFAb,IB,IGAU,iforb,nccor,iecou) ifourb=iforb ncourb=nccor trefa=trefab SEGSUP WRK7 IF (KERRE.GT.200) THEN KERR1=1 ENDIF ENDIF ENDIF SEGSUP WRK9 RETURN * ELSE c KERRE = 99 * ENDIF * *--------------------------------------------------------------------- * * ecoulement selon les modeles plastique avec endommagement * *--------------------------------------------------------------------- c c modeles implantes dans ecoinc c 351 continue * IF (INPLAS.EQ.51) THEN c SEGINI ENDO0 c cas de la plasticite isotrope ecrouissable avec un c endommagement de type P/Y c c on recupere la courbe de traction et la courbe de début d'endommagement c nccor=ncourb CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP) ncourb=nccor INPLS0 = 51 INPLAS = 5 IF (VAR0(7).GE.1.D-10) THEN DO 110 I=1,NSTRS SIG0(I)=SIG0(I)/VAR0(7) 110 CONTINUE ENDIF c c calcul des contraintes plastiquement admissibles c IF (KERRE .EQ. 0) THEN DO 1114 IC=1,ICARA WORK(IC)=xcarb(IC) 1114 continue BID(1)=0.D00 BID(2)=0.D00 BID(3)=0.D00 CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, & NBPGAU,ecou,necou,iecou) ENDIF c retour au modèle d'endommagement P/Y c c calcul des contraintes endommagées c CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP, & NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE) segsup ENDO0 INPLAS = 51 RETURN c 362 continue * ELSE IF (INPLAS.EQ.62) THEN c c Modèle d'endommagement de Rousselier c - on recupère la courbe de traction c nccor=ncourb CALL CCOTRA(wrk52,WRK2,NCcor,wrk53) ncourb=nccor c c - appel au modèle C IF (KERRE.EQ.0) THEN CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0, & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE, & necou) IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN KERR1=1 ENDIF ENDIF RETURN c 364 continue * ELSE IF (INPLAS.EQ.64) THEN c c Modèle d'endommagement de Gurson modifié Needleman Tvergaard c - on recupère la courbe de traction c nccor=ncourb CALL CCOTRA(wrk52,WRK2,NCcor,wrk53) ncourb=nccor c c - appel au modèle c IF (KERRE.EQ.0) THEN CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0, & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE, & necou) IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN KERR1=1 ENDIF ENDIF RETURN c 375 continue * ELSE IF (INPLAS.EQ.75) THEN c c Modèle d'endommagement de Dragon c CALL CDRAGO(wrk52,wrk53,wrk54) c c RETURN 433 continue * ELSE IF (INPLAS.EQ.133) THEN c c Modèle viscoplastique viscoendommageable pour la dynamique rapide du LMT c CALL DYNAR(wrk52,wrk53,wrk54,iecou) RETURN c * ELSE c KERRE = 99 * ENDIF *--------------------------------------------------------------------- * * ecoulement selon les modeles (endommageables) * *--------------------------------------------------------------------- * 330 continue * IF (INPLAS .EQ. 30) THEN c c modele d'endommagement mazars ( beton ) c c CALL MAZZZ(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, c & ICARA,MFR1) CALL CMAZZZ(WRK52,WRK53,WRK54,NVARI,Iecou) RETURN c 331 continue * ELSE IF (INPLAS .EQ. 31) THEN c c modele d'endommagement unilateral ( beton ) c c CALL CLBBBB(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP, c & ICARA,KERRE,MFR1,IFOURB) CALL COLBBB(WRK52,WRK53,WRK54,NVARI,Iecou,necou) RETURN c 337 continue * ELSE IF (INPLAS .EQ. 37) THEN c c modele rotating crack c nstrbi=nstrss icarbi=icara CALL COTATI(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi) nstrss=nstrbi icara=icarbi RETURN c 388 continue * ELSE IF (INPLAS .EQ. 88) THEN c modele SIC_SIC c CALL CICSIC(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou & ,iecou) RETURN c 389 continue * ELSE IF (INPLAS .EQ. 89) THEN C HINTE C MODELE INTERFACE 2D CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,xcarb,SIGF, & VARF,DEFP,PRECIS,MFR1,KERRE) RETURN C 396 continue * ELSE IF (INPLAS .EQ. 96) THEN C C MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS C CALL CMICRO(WRK52,WRK53,WRK54,NVARI,Iecou) RETURN * 397 continue * ELSE IF (INPLAS .EQ. 97) THEN C C MODELE D'ENDOMMAGEMENT VISCOUNILATERAL ( BETON ) C icarbi=icara CALL CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou) RETURN * 398 continue * ELSE IF (INPLAS .EQ. 98) THEN C C MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS C CALL CMICRI(WRK52,WRK53,WRK54,NVARI,Iecou) RETURN * 418 continue * ELSE IF (INPLAS.EQ.118) THEN C C modified von mises model C CALL CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou) RETURN c 431 continue * ELSE IF (INPLAS .EQ. 131) THEN c modele SIC_SIC c CALL SICSCAL(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou & ,iecou) RETURN c 432 continue * ELSE IF (INPLAS .EQ. 132) THEN c modele SIC_SIC c CALL SICTENS(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou & ,iecou) RETURN C 434 continue * ELSE IF (INPLAS.EQ.134) THEN C C Modele de DESMORAT C CALL DESMOR(wrk52,wrk53,wrk54,nvari,iecou) RETURN * ELSE c KERRE = 99 * ENDIF * *--------------------------------------------------------------------- * * ecoulement selon les modeles (plastique hors moule ccoinXX) * *--------------------------------------------------------------------- c c modele linespring c 302 continue 327 continue * IF (INPLAS.EQ.2.OR.INPLAS.EQ.27) THEN * write(6,*) ' coml8 ifour avant appel calsig', ifour CALL CLISPP(wrk52,wrk53,wrk54,WRK2,IFOUR,IB,IGAU, & NBPGAU,iecou) RETURN c c modele beton c 309 continue * ELSE IF (INPLAS.EQ.9) THEN CALL BETON(SIG0 ,DEPST,VAR0,XMAT,ivalma,NMATT,xcarb, 1 DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB, 2 IGAU,EPAIST,MELE,NPINT, SECT,LHOOK, 3 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT, 4 SIGF,VARF,DEFP, NBPGAU,KERRE,ecou,necou,iecou) IF (KERRE.GT.200) THEN KERR1=1 ENDIF RETURN c c tuyau fissure c 314 continue 318 continue * ELSE IF (INPLAS.EQ.14.OR.INPLAS.EQ.18) THEN iforb=ifourb CALL CTUFPL(wrk52,wrk53,wrk54,WRK2,IFORB,IB,IGAU, & NBPGAU,iecou) ifourb=iforb c pas de materiau 18 dans nomate 02/01 Kich if (inplas.eq.18) inplas = 14 c c modele gauvain c RETURN 316 continue * ELSE IF (INPLAS.EQ.16) THEN c c on recupere les courbes moment-courbure c nccor=ncourb CALL CCOTR2(wrk52,wrk53,WRK2,NCcor) ncourb=nccor IF (KERRE.NE.0) RETURN iforb=ifourb nccor=ncourb mfr1bi=mfr1 nbgmab=nbgmat nlmatb=nelmat nstrbi=nstrs CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,MFR1bi,IFORB, 1 IB,IGAU,EPAIST,MELE,NPINT,NBGMAb,NLMATb,SECT, 2 LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI, 3 SIG0,NSTRbi,DEPST,VAR0,XMAT,NCOMAT,xcarb,TRAC, 4 NCcor,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE) ifourb=iforb ncourb=nccor mfr1=mfr1bi nbgmat=nbgmab nelmat=nlmatb nstrs=nstrbi IF (KERRE.GT.200) THEN KERR1=1 ENDIF * ENDIF RETURN c c modele ubiquitous c 328 continue * ELSE IF (INPLAS .EQ.28) THEN CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB, 1 IGAU,EPAIST,MELE,NPINT ,SECT,LHOOK, 2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0, 3 DEPST,VAR0,XMAT,NBPGAU,NMATT,xcarb,DSIGT, 4 SIGF,VARF,DEFP,KERRE,ecou,necou,iecou) IF (KERRE.GT.200) THEN KERR1=1 ENDIF RETURN c c modele global c 332 continue * ELSE IF (INPLAS.EQ.32) THEN iforb=ifourb CALL CCOTR3(wrk52,wrk53,wrk54,IFORB,IB,IGAU, & NBPGAU,iecou) ifourb=iforb IF (KERRE.LT.0) THEN INTERR(1)=IB INTERR(2)=IGAU IF (KERRE.LE.(-4)) THEN MOTERR(5:16) = 'CISAILLEMENT' CALL ERREUR(-283) KERRE = KERRE + 4 ENDIF IF (KERRE.LE.(-2)) THEN MOTERR(5:16) = 'FLEXION' CALL ERREUR(-283) KERRE = KERRE + 2 ENDIF IF (KERRE.LT.0) THEN MOTERR(5:16) = 'COMPRESSION' CALL ERREUR(-283) KERRE = 0 ENDIF ENDIF RETURN c c modele cam-clay c 333 continue * ELSE IF (INPLAS.EQ.33) THEN CALL CAMCLA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF, & VARF,DEFP,PRECIS,MFR1,KERRE) RETURN c 334 continue * ELSE IF (INPLAS .EQ. 34) THEN c c modele de mohr coulomb pour les joints c IF (MFR.EQ.35) THEN IF (IFOUR.EQ.2) THEN c c --------------------joints 3d c CALL COUL3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) ELSE c c --------------------joints 2d c CALL COUL2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) ENDIF c c --------------------joints JOI1 c ELSE IF (MFR.EQ.75) THEN CALL COUL1(IB,IGAU,NSTRS,SIG0,EPST0,EPIN0,VAR0,NVARI,DEPST, & IFOURB,XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) ENDIF RETURN c 335 continue * ELSE IF (INPLAS .EQ. 35) THEN c c modele de coulomb_dilatant pour les joints 2d c IF (IFOUR.NE.2) THEN CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE) ENDIF RETURN c c modele de gurson c 338 continue * ELSE IF (INPLAS .EQ. 38) THEN nstrbi=nstrss icarbi=icara CALL PRGURS(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi, & NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur) nstrss=nstrbi icara=icarbi RETURN c 336 continue * ELSE IF (INPLAS .EQ. 36) THEN c c modele beton_axi c nstrbi=nstrss CALL BETAXI(SIG0,NSTRbi,DSIGT,VAR0,XMAT,ivalma,NMATT,xcarb, & SIGF,VARF,DEFP,MFR1,KERRE,ecou,necou) nstrss=nstrbi IF (KERRE.GT.200) THEN KERR1=1 ENDIF RETURN c 339 continue * ELSE IF ((INPLAS .EQ. 39) .AND. (MFRbi .EQ. 27)) THEN c c modele beton_uni pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARBET(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) RETURN c 404 continue * ELSE IF ((INPLAS .EQ. 104) .AND. (MFRbi .EQ. 27)) THEN c c modele beton unilateral pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARLAB(XMAT,XCARB,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) RETURN c 393 continue * ELSE IF ((INPLAS .EQ. 93) .AND. (MFRbi .EQ. 27)) THEN c c c modele ancrage_acier pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARSTA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) RETURN c 378 continue * ELSE IF ((INPLAS .EQ. 78) .AND. (MFRbi .EQ. 27)) THEN c c modele fragile_uni pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARFRA(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP) RETURN c 379 continue * ELSE IF ((INPLAS .EQ. 79) .AND. (MFRbi .EQ. 27)) THEN c c modele beton_bael pour les elements unidirectionels (barre ..) c KERR1=0 CALL BABAEL(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP) RETURN c 392 continue * ELSE IF ((INPLAS .EQ. 92) .AND. (MFRbi .EQ. 27)) THEN c c c modele ancrage_parfait pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARPAA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) RETURN c c 380 continue * ELSE IF ((INPLAS .EQ. 80) .AND. (MFRbi .EQ. 27)) THEN c c modele parfait_uni pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARPAR(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) c * IF (KERRE.NE.0) return RETURN c c modele acier_uni pour les materiau unidirectionel c c 340 continue * ELSE IF ((INPLAS .EQ. 40) .AND. (MFRbi .EQ. 27)) THEN IF(MFRbi .EQ. 27)then c c modele acier_uni pour les elements unidirectionels (barre ..) c KERR1=0 CALL BARSTE(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP) RETURN elseif(MATE.EQ.4) then * ELSE IF (INPLAS .EQ. 40 .AND. MATE.EQ.4) THEN nstrbi=nstrss mfr1bi=mfr1 CALL CUNIAC(wrk52,wrk53,wrk54,NSTRbi,MFR1bi) nstrss=nstrbi mfr1=mfr1bi RETURN endif c c modele poutre en formulation section c 341 continue * ELSE IF (INPLAS.EQ.41.AND.MFRbi.EQ.7) THEN c nstrbi=nstrss icarbi=icara CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi) nstrss=nstrbi icara=icarbi RETURN c 350 continue * ELSE IF (INPLAS .EQ. 50) THEN c c cas du modele de zerilli armstrong c c on recupere le pas de temps dt : voir comval c kich : fixe dt = 0. pour plasticite dtk1 = dt dt = 0.d0 c IF (KERRE .EQ. 0) THEN DO 1124 IC=1,ICARA WORK(IC)=xcarb(IC) 1124 continue BID(1)=0.D00 BID(2)=0.D00 BID(3)=0.D00 CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, & NBPGAU,necou,ecou,iecou,xecou) ENDIF dt = dtk1 RETURN c c modele de steinberg cochran guinan c 349 continue * ELSE IF (INPLAS.EQ.49) THEN CALL STEINB(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0, 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2, 2 KERRE) IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN KERR1=1 ENDIF RETURN c c modele hujeux c 348 continue * ELSE IF (INPLAS.EQ.48) THEN CALL HUJEUX(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF, & VARF,DEFP,PRECIS,MFR1,KERRE) RETURN c c modele ottosen c 342 continue * ELSE IF (INPLAS.EQ.42) THEN CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,NMATT, 1 xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,IB, 2 IGAU) RETURN c 347 continue * ELSE IF (INPLAS.EQ.47) THEN c c modele de amadei-saeb pour les joints c C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi IF (IFOUR.EQ.2) THEN c c --------------------joints 3d c CALL AMADE3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE) ELSE c c --------------------joints 2d c CALL AMADE2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE) ENDIF RETURN c 352 continue * ELSE IF (INPLAS.EQ.52) THEN c c modèle Preston-Tonks-Wallace c c on recupere le pas de temps dt : voir comval c kich : fixe dt = 0. pour plasticite dtk1 = dt dt = 0.d0 c CALL PRESTO(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0, 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2, 2 KERRE,DT) IF (KERRE.NE.0) THEN KERR1=1 ENDIF dt = dtk1 RETURN c 354 continue * ELSE IF (INPLAS.EQ.54) THEN c c modele BETOCYCL C C ON VERIFIE LES CONTRAINTES PLANES C IF (IFOUR.EQ.-2) THEN C C ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION C IPOS1=1 CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT) NTRAT=NPOINT/2 IPOS2=IPOS1+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT) NTRAC=NPOINT/2 IF (KERRE.EQ.0) THEN CALL CBETOC(wrk52,wrk53,wrk54,WRK2,NTRAT,NTRAC) ENDIF ELSE KERRE = 99 ENDIF RETURN C 355 continue * ELSE IF (INPLAS.EQ.55) THEN C C MODELE ROTATING CRACK C C ON VERIFIE LES CONTRAINTES PLANES C IF (IFOUR.EQ.-2) THEN IF (KERRE.EQ.0) THEN CALL CROTAT(wrk52,wrk53,wrk54) ENDIF ELSE KERRE = 99 ENDIF RETURN c 356 continue * ELSE IF (INPLAS.EQ.56) THEN C C MODELE JOINT_SOFT C C C ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR C C C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est C 6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et C 'ALFA' a la place 3 et 4 dans defmat.eso C IPOS1=1 CALL COTRAJ(wrk52,wrk53,WRK2,8, IPOS1,1, NPOINT) NTRAC=NPOINT/2 IPOS2=IPOS1+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2,9, IPOS2,1, NPOINT) NTRAS=NPOINT/2 IPOS3=IPOS2+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS3,1, NPOINT) NTRAT=NPOINT/2 C IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN IF(KERRE.EQ.0) THEN C CALL SJONL2(SIG0,DEPST,VAR0,XMAT, . TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS, . TRAC(IPOS3),NTRAT, . SIGF,VARF,DEFP,KERRE) END IF ELSEIF(IFOUR.EQ.2)THEN IF(KERRE.EQ.0) THEN C CALL SJONL3(SIG0,DEPST,VAR0,XMAT, . TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT, . TRAC(IPOS3),NTRAC, . SIGF,VARF,DEFP,KERRE) END IF C END IF RETURN C 419 continue * ELSE IF (INPLAS.EQ.119)THEN C C MODELE JOINT_COAT C C ON RECUPERE LA COURBE DE SHEAR C C Note: La courbe a maintenant l'indices 4 alors que c'est C 2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et C 'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...) C IPOS1=1 CALL COTRAJ(wrk52,wrk53,WRK2,4,IPOS1,1, NPOINT) NTRAS=NPOINT/2 C IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN IF(KERRE.EQ.0) THEN C CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS, . SIGF,VARF,DEFP,KERRE) END IF ELSEIF(IFOUR.EQ.2)THEN IF(KERRE.EQ.0) THEN END IF C END IF RETURN C 425 continue * ELSE IF (INPLAS.EQ.125)THEN IF(MFR.EQ.1)THEN CALL DAMATC(IFOUR,XMAT,DDHOOK,LHOOK,SIG0,VAR0, & DEPST,DSIGT,EPST0,EPIN0, SIGF,VARF,DEFP) ENDIF RETURN 435 continue * ELSE IF (INPLAS.EQ.135) THEN CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0, & SIGF,DEPST,NSTRS,KERRE,ISTEP) RETURN C C 426 continue * ELSE IF (INPLAS.EQ.126)THEN C C MODELE MUR_SHEAR C POUR LE MOMENT, ELEMENT DE POUTRE C MAIS ON AJOUTE MAINTENANT LE MACRO ELEMENT C IF(MFR.EQ.7.OR.MFR.EQ.61)THEN C C ON RECUPERE LES COURBES C C Note: Les courbes ont maintenant les indices 5 a 10 alors que C c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a C incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso C IPOS1=1 CALL COTRAJ(wrk52,wrk53,WRK2, 5,IPOS1,0, NPOINT) NCURFP=NPOINT/2 IPOS2=IPOS1+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2, 6,IPOS2,0, NPOINT) NCURKP=NPOINT/2 IPOS3=IPOS2+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2, 7,IPOS3,0, NPOINT) NCURLP=NPOINT/2 IPOS4=IPOS3+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2, 8,IPOS4,0, NPOINT) NCURFM=NPOINT/2 IPOS5=IPOS4+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2, 9,IPOS5,0, NPOINT) NCURKM=NPOINT/2 IPOS6=IPOS5+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS6,0, NPOINT) NCURLM=NPOINT/2 C IF(KERRE.EQ.0) THEN C+PPM IF(MFR.EQ.7)THEN C+PPM CALL MSHETI(wrk52,wrk53,WRK2, > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM, > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6, > KERR2) KERRE = KERR2 C+PPM ELSE IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN CALL MASHEJ(wrk52,wrk53,WRK2, > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM, > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6) ELSE KERRE=99 ENDIF ENDIF C+PPM END IF C END IF RETURN C C c 391 continue * ELSE IF (INPLAS.EQ.91) THEN C C MODELE ANCRAGE_ELIGEHAUSEN C IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN C CALL ANCREL(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE) ENDIF RETURN c 357 continue * ELSE IF (INPLAS.EQ.57) THEN C C MODELE BILI_MOMY C KERRE=0 CALL BILIPO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP) RETURN c 358 continue * ELSE IF (INPLAS.EQ.58) THEN C C MODELE BILI_EFFZ C KERRE=0 CALL BILIFO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP) RETURN c 359 continue * ELSE IF (INPLAS.EQ.59) THEN C C MODELE TAKEMO_MOMY C C ON RECUPERE LES COURBES MOMENT-COURBURE C nccor=ncourb CALL COTRAF(wrk52,wrk53,WRK2,NCcOR) ncourb=nccor IF (KERRE.EQ.0) THEN C IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, & NCOURB,SIGF,VARF,DEFP,KERRE) ELSE CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, & NCOURB,SIGF,VARF,DEFP,KERRE) ENDIF ENDIF RETURN 447 continue * ELSE IF (INPLAS.EQ.73) THEN C C MODELE BA1D C CALL BA1D(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, & NCOURB,SIGF,VARF,DEFP,KERRE) RETURN c 360 continue * ELSE IF (INPLAS.EQ.60) THEN C C MODELE TAKEMO_EFFZ C C C ON RECUPERE LES COURBES MOMENT-COURBURE C nccor=ncourb CALL COTRAF(wrk52,wrk53,WRK2,NCcor) ncourb=nccor IF (KERRE.EQ.0) THEN C IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, & NCOURB,SIGF,VARF,DEFP,KERRE) ELSE CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC, & NCOURB,SIGF,VARF,DEFP,KERRE) ENDIF C ENDIF RETURN c 440 continue * ELSE IF (INPLAS.EQ.140) THEN * * modele DRUCKER_PRAGER2 * XLCARA=0.D0 NEXO = EXOVA0(/1) DO INEX=1,NEXO IF ((NOMEXO(INEX).EQ.'LCAR').AND.(CONEXO(INEX).EQ.CONM)) THEN XLCARA=EXOVA0(INEX) ENDIF ENDDO CALL DRUCK2(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVALMA, & NMATT,XCARB,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE, & IB,IGAU,IFOURB,XLCARA,MELE) RETURN 441 continue * ELSE IF (INPLAS.EQ.141) THEN * Fatigue damage model (fatsin) * print*,'appel a cfattt dans coml8' CALL CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou) RETURN * ELSE * KERRE=99 * ENDIF * *--------------------------------------------------------------------- * * ecoulement selon les modeles (plastique hors ccoinXX) suite * *--------------------------------------------------------------------- * 366 continue * IF (INPLAS.EQ.66) THEN C C C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES, C DEFORMATION PLANES ET AXISYMETRIE C nstrbi=nstrss iwpoi1=wrk12 CALL BEINSA(SIG0,NSTRbi,DEPST,VAR0,XMAT,ivalma,NMATT,SIGF,VARF, 1 KERRE,MELE,IFOURB,NVARI,xcarb,NCARR,MFRbi,EPIN0, 2 EPINF,DT,XE,NBNNbi,CMATE,IB,IGAU,iwpoi1) RETURN C C 367 continue * ELSEIF (INPLAS.EQ.67) THEN C C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE) C MVEL1= nint(XMAT(NMATR) ) nccor=ncourb CALL CCOTRO(wrk52,wrk53,WRK2,NCcor,MVEL1) ncourb=nccor LT1=NCOURB*2 CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC, & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB) RETURN * * 368 continue * ELSEIF (INPLAS.EQ.68) THEN C C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE) C NCOURB=3 KERRE = 0 TRAC(1)=0.D0 TRAC(2)=0.D0 TRAC(3)=XMAT(NMATR) TRAC(4)=XMAT(NMATR)/XMAT(1) TRAC(5)=XMAT(NMATR) TRAC(6)=1.D0 IF (XMAT(NMATR).EQ.0.D0) KERRE = 33 LT1=NCOURB*2 CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC, & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB) RETURN C 369 continue * ELSEIF (INPLAS.EQ.69) THEN C C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO C **************************** * SPECIAL SUCCION * CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0, & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou) IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN KERR1=1 ENDIF RETURN C 371 continue * ELSEIF (INPLAS.EQ.71) THEN C C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD C CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0, & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou) IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN KERR1=1 ENDIF RETURN **************************** C 372 continue * ELSEIF (INPLAS.EQ.72) THEN C C MODELE INFILL_UNI C IF (MFRbi.EQ.27) THEN C C ON RECUPERE LA COURBE FORCE-DEPLACEMENT C CALL COTRAJ(wrk52,wrk53,WRK2,12,1,0, NPOINT) NCOURB=NPOINT/2 IF (KERRE.EQ.0) THEN nccor=ncourb CALL CINFIL(wrk52,wrk53,wrk54,WRK2,NCcor) ncourb=nccor ENDIF ELSE KERRE = 99 ENDIF RETURN C 373 continue * ELSE IF (INPLAS.EQ.73) THEN C C MODELE ETAGE C pour le moment, element de barre * IF (MFRbi.EQ.7) THEN C C ON RECUPERE LA COURBE FORCE-DEPLACEMENT C IPOS1=1 CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT) NTRAP=NPOINT/2 IPOS2=IPOS1+NPOINT CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT) NTRAN=NPOINT/2 IF (KERRE.EQ.0) THEN CALL CETAG(wrk52,wrk53,wrk54,WRK2,NTRAP,NTRAN) ENDIF ELSE KERRE = 99 ENDIF RETURN C * ELSE c KERRE=99 * ENDIF * *--------------------------------------------------------------------- * ceramique caroline, couplage gatt_monerie ottosen, * maxwell, couplage maxwell ottosen *--------------------------------------------------------------------- 365 continue * IF (INPLAS.EQ.65) THEN * IF ((MFRbi.EQ.1).AND.(IFOMOD.EQ.2)) THEN IBIDO = 19 ELSE IBIDO = 14 ENDIF * * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION * CAD LORSQUE TTRAN = 0 * IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN * * si le point de gauss est déjà endommagé par endommagement généralisé * on le traite simplement par ccerac * IF (VAR0(NVARI-1).EQ.1) THEN iforb=ifourb CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) IND=1 ELSE * * si le point de gauss n'a pas un endommagement généralisé * on regarde si il a été fissuré * par ottosen et si non on applique le fluage puis ottosen * si oui on le traite par ottosen * CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi) IF (ITOTO.EQ.0) THEN iforb=ifourb CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) ifourb=iforb IND=1 * Ligne suivante à supprimer * IF (IND.EQ.0) THEN * on regarde si on a eu endommagement généralisé * si on n'a pas eu endommagement généralisé on appelle ottosen IF (VARF(NVARI-1).NE.1) THEN DO 161 I = 1,NVARI VAR01(I) = VARF(I) 161 CONTINUE DO 835 I=1,NSTRS * PRINT *,'DEPST EPINF-EPIN0 ', * 1 I,DEPST(I),(EPINF(I)-EPIN0(I)) DEPST(I) = DEPST(I) - (EPINF(I)-EPIN0(I)) C on remplace SIGF par SIG0 SIG01(I) = SIG0(I) 835 CONTINUE CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT, 1 ivalma,NMATT,xcarb,ICARA,NVARI,SIGF,VARF, 2 DEFP,MFR1,KERRE,IB,IGAU) C on met à jour la variable interne EPSE commune aux deux modèles VARF(1) = VARF(1)+VARF(NVARI) C DO 537 I=1,NSTRS C IF (SIGF(I).NE.SIG01(I)) THEN C PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I) C ENDIF C537 CONTINUE C DO 538 I=1,NVARI C IF (VARF(I).NE.VAR01(I)) THEN C PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I) C ENDIF C 538 CONTINUE C on calcule l'increment de déformation du pas de temps DO 836 I=1,NSTRS C IF (DEFP(I).NE.0.) PRINT *,'DEFP',DEFP(I) DEFP(I) = DEFP(I)+(EPINF(I)-EPIN0(I)) 836 CONTINUE IND=0 ENDIF C Ligne suivante à supprimer C ENDIF ELSE CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma, 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1, 2 KERRE,IB,IGAU) VARF(1) = VARF(1)+VARF(NVARI) IND=0 ENDIF ENDIF C ELSE * * CAS OU ON PREND EN COMPTE LA TEMPERATURE DE TRANSITION * IF (TETA2.GE.XMAT(IBIDO)) THEN CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi) IF (ITOTO.EQ.0) THEN iforb=ifourb CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) ifourb=iforb IND=1 ELSE CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma, 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1, 2 KERRE,IB,IGAU) VARF(1) = VARF(1)+VARF(NVARI) IND=0 ENDIF ELSE IF (VAR0(NVARI-1).EQ.1) THEN iforb=ifourb CALL CCERAC(wrk52,wrk53,wrk54,NVARI, 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou) ifourb=iforb IND=1 ELSE CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma, 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1, 2 KERRE,IB,IGAU) VARF(1) = VARF(1)+VARF(NVARI) IND=0 ENDIF ENDIF ENDIF IF (MFR1.EQ.17) THEN IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN CALL ERREUR(KERREU1) ENDIF ENDIF C DTOPTI = MIN(DTOPTI,DTT) NINCMA = MAX(NINCMA,NSSINC) NCOMP = NCOMP + 1 TSOM = TSOM + DTT NSOM = NSOM + NSSINC NINV = NINV + INV TCAR = TCAR + DTT* DTT IF (KERRE.NE.0.AND.KERRE.NE.99) THEN KERR1=1 ENDIF RETURN C 408 continue * ELSEIF (INPLAS.EQ.108) THEN C IND=0 FI1 = 0.D0 FI2 = 0.D0 nexo = exova0(/1) do 2050 inex = 1,nexo if ((nomexo(inex).eq.'DFIS').and. & (conexo(inex).eq.CONM)) then fi1 = exova0(inex) fi2 = exova1(inex) goto 2001 endif 2050 continue 2001 continue C C NSIMP pointe sur la caracteristique de fissuration facult. qui C indique le type de resolution souhaite C IF (IFOMOD.EQ.2.AND.MFR1.EQ.1) THEN NSIMP=71 ELSE NSIMP=66 IF(MFR1.EQ.1.AND.IFOUR.EQ.-2) NSIMP=62 IF(MFR1.EQ.3.OR.MFR1.EQ.9) NSIMP=61 ENDIF XSIMP=XMAT(NSIMP) C IF (XSIMP.EQ.0.D0) THEN C resolution complete C CALL UO2OTO(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA, 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS, 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE) ELSE C resolution simplifiee C CALL UO2OT2(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA, 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS, 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE) ENDIF IF (KERRE.NE.0.AND.KERRE.NE.99) KERR1=1 RETURN C 374 continue * ELSE IF (INPLAS.EQ.74) THEN * * CHAINE DE MAXWELL * * on commence par recuperer le nombre d'elements dans la chaine * et les proprietes et variables internes associees a des objets * nbgmab=nbgmat nlmatb=nelmat CALL CMAXTA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMbT,NLMATb,NWA, & NCHAIN) nbgmat=nbgmab nelmat=nlmatb IF (IERR.NE.0) THEN SEGSUP WR12 return ENDIF C IF (MFRbi.EQ.3.OR.MFRbi.EQ.39) THEN dtbi=dt CALL CMAXGE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA) dt=dtbi ELSE C * * MLR 10/08/99 * * ON PASSE LE SEGMENT DE TRAVAIL WTRAV dtbi=dt CALL CMAXWE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA) dt=dtbi ENDIF * * ici gerer les erreurs * CALL CMAXTB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN) SEGSUP WR12 RETURN *---------------------------------------------------------- * modele maxott *---------------------------------------------------------- 406 continue * ELSE IF (INPLAS.EQ.106) THEN * * on commence par recuperer le nombre d'elements dans la chaine * et les proprietes et variables internes associees a des objets * nbgmab=nbgmat nlmatb=nelmat CALL CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAb,NLMATb,NWA, & NCHAIN,EPSFLU) nbgmat=nbgmab nelmat=nlmatb IF (IERR.NE.0) THEN SEGSUP WR12 RETURN ENDIF * * modele maxott * dtbi=dt CALL CMAXOT(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA, & EPSFLU) dt=dtbi * * stockage des variables internes et des proprietes * CALL CMAXOB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN,EPSFLU) SEGSUP WR12 RETURN * *---------------------------------------------------------- * modeles FBB1 et FBB2 *---------------------------------------------------------- * 427 continue 428 continue * ELSE IF (INPLAS.EQ.127.OR.INPLAS.EQ.128) THEN * LEPLAS = INPLAS CALL CFBB(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU, & IECOU,LEPLAS) RETURN * *---------------------------------------------------------- * modele INCO *---------------------------------------------------------- 429 continue * ELSE IF (INPLAS .EQ. 129) THEN * * modele INCO * CALL INCO(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU) RETURN * *---------------------------------------------------------- * modele FLUTRA *---------------------------------------------------------- 443 continue * ELSE IF (INPLAS .EQ. 143) THEN * * modele FLUTRA * NMATER = NMATT + 3 LWTRA = NMATER + (8*NSTRS) + (3*NSTRS*NSTRS) IF(LW.LT.LWTRA) THEN LW = LWTRA SEGADJ WRK3 ENDIF * LA1 = 1 LA2 = LA1 + NMATER LA3 = LA2 + NSTRS LA4 = LA3 + NSTRS LA5 = LA4 + NSTRS LA6 = LA5 + NSTRS*NSTRS LA7 = LA6 + NSTRS LA8 = LA7 + NSTRS LA9 = LA8 + NSTRS LA10 = LA9 + NSTRS LA11 = LA10 + NSTRS LA12 = LA11 + NSTRS*NSTRS * CALL FLUTRA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NMATT, & IFOUR,DT,IB,IGAU,TETA1,TETA2,ITHER,NMATER, & SIGF,VARF,WORK(LA1),WORK(LA2),WORK(LA3), & WORK(LA4),WORK(LA5),WORK(LA6),WORK(LA7), & WORK(LA8),WORK(LA9),WORK(LA10),WORK(LA11), & WORK(LA12),KERRE) RETURN * 450 continue * ELSE IF (INPLAS.EQ.150) THEN C C MODELE BILIN_EFFX C KERRE=0 CALL BREVA1(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP) RETURN * 451 continue * ELSE IF (INPLAS.EQ.151) THEN C C MODELE ISS_GRANGE C KERRE=0 CALL ISSGRA(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU) IF (KERRE.EQ.22) THEN INTERR(1)=IB MOTERR(1:4) = 'JOI1' INTERR(2)=IGAU INTERR(3)=INPLAS CALL ERREUR(268) ENDIF IF (KERRE.EQ.23) THEN CALL ERREUR(1016) ENDIF IF (KERRE.EQ.25) THEN CALL ERREUR(1017) ENDIF RETURN * 452 continue * ELSE IF (INPLAS.EQ.152) THEN C C MODELE RUP_THER C KERRE=0 CALL RUPTHE(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU) IF (KERRE.EQ.22) THEN INTERR(1)=IB MOTERR(1:4) = 'JOI1' INTERR(2)=IGAU INTERR(3)=INPLAS CALL ERREUR(268) ENDIF RETURN * 455 continue * ELSE IF (INPLAS.EQ.155) THEN C C MODELE GERNAY C KERRE=0 CALL GERNAY(WRK52,WRK53,WRK54,WRK3,IB,IGAU,NBPGAU) RETURN 456 continue * ELSE IF (INPLAS.EQ.156) THEN C C MODELE WELLS C CALL WELLS(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU) RETURN C C----------------------------------------------------------------------- C Modele 'NON_LINEAIRE' 'UTILISATEUR' : integrateur externe C specifique UMAT C----------------------------------------------------------------------- 899 continue * ELSE IF (INPLAS.EQ.-1) THEN C KERR1 = 0 C C Pointeur (>0) sur fonction externe si definie m_ptre = wrk53.jecher C C Preparation des entrees de la routine UMAT C N.B. Les arguments pointeurs sont reperes par des C caracteres minuscules C CALL WKUMA1 ( wrk52, wkumat ) C C Integration de la loi externe au point courant C N.B. Les entrees/sorties non actives ou non exploitees sont C reperees par des caracteres minuscules C IF (m_ptre.LE.0) THEN C C Appel a UMAT standard de Cast3M CALL UMAT ( SIGF, VARF, ddsdde, sse, spd, scd, & rpl, ddsddt, drplde, drpldt, & EPST0, DEPST, TIME, DTIME, & TEMP, DTEMP, PAREX0, DPRED, & CMNAME, ndi, nshr, NSIG0, NSTATV, & XMATF, NPROPS, COORGA, & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1, & IB, IGAU, layer, kspt, kstep, KINC ) C ELSE C C Branchement a la loi externe pointee par m_ptre C* CALL EXTLOI(m_ptre,...) KINC = 251 C*TMP Option non disponible pour l'instant (cf. modeli.eso) C ENDIF C IF (KINC.NE.1) THEN IF (KINC.EQ.0) THEN ISIGN = 1 ELSE ISIGN = ABS(KINC)/KINC ENDIF KERRE = ISIGN*92 KERR1 = -1-ABS(KINC) ENDIF C C Releve du pas de temps optimal pour l'iteration suivante C DTOPTI=PNEWDT*DTIME RETURN C C----------------------------------------------------------------------- C Modeles 'VISCO_EXTERNE' : integres par CCREEP C----------------------------------------------------------------------- 898 continue * ELSE IF (INPLAS.EQ.-2) THEN C KERR1 = 0 C C Pointeur (>0) sur fonction externe si definie m_ptre = wrk53.jecher C IF (m_ptre.LE.0) THEN C C Appel a CCREEP standard de Cast3M IFORB = IFOURB CALL CCREEP ( wrk52, wrk53, wrk54, & IFORB, IB, IGAU, NBPGAU, & wcreep, iecou, xecou ) C ELSE C C Branchement a la loi externe pointee par m_ptre C* CALL EXTLOI(m_ptre,...) KSTEPC = 251 C*TMP Option non disponible pour l'instant (cf. modeli.eso) C ENDIF C Erreur detectee par l'integrateur CCREEP C IF (KERRE.NE.0) THEN KERR1 = 1 RETURN ENDIF C C Erreur lors d'un appel au module utilisateur CREEP C IF (KSTEPC.NE.1) THEN IF (KSTEPC.EQ.0) THEN ISIGN = 1 ELSE ISIGN = ABS(KSTEPC)/KSTEPC ENDIF KERRE = ISIGN*93 KERR1 = -1-ABS(KSTEPC) ENDIF C RETURN C C----------------------------------------------------------------------- C----------------------------------------------------------------------- * ELSE * KERRE = 99 * ENDIF * RETURN END