C CHAFLU SOURCE CHAT 05/01/12 21:54:10 5004 SUBROUTINE CHAFLU(YUNG,XNU,IA,EI,SSTAR, 1 XMAT,ALPHA1,IBOU,SI,DEPS,EPST,EPSTAR,AMTRI, 2 ALPHA2,DPSM1,DPSM2,KERRE,NUMCHA,ecou,necou) C C INTEGRATION MODELE DE CHABOCHE EN FLUAGE C IMPLICIT INTEGER(I-N) IMPLICIT REAL *8(A-H,O-Z) DIMENSION XMAT(*),EI(*),ALPHA1(*),ALPHA2(*) DIMENSION AMTRI(18,7),DELT(6) C * Commun ECOU: sert de fourre-tout pour les tableaux * SEGMENT ECOU *** COMMON/ECOU/TEST,ALFAH, REAL*8 TEST, ALFAH, 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 1 DALPHA(6),DSIGO(6),E(12),XINV(3), 2 SIPLAD(6),DSIGP0(6),TET,TETI ENDSEGMENT C COMMON/ECOU/TEST,ALFAH, C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), C 1 DALPHA(6),DSIGO(6),E(12),XINV(3), C 2 SIPLAD(6),DSIGP0(6),TET,TETI C * Commun NECOU utilisé dans ECOINC * SEGMENT NECOU * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, . ITYP,IFOUR,IFLUAG, . ICINE,ITHER,IFLUPL,ICYCL,IBI, . JFLUAG,KFLUAG,LFLUAG, . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF ENDSEGMENT C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, C . ITYP,IFOUR,IFLUAG, C . ICINE,ITHER,IFLUPL,ICYCL,IBI, C . JFLUAG,KFLUAG,LFLUAG, C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF C C JFLUAG = 1 ON FLUE AVEC SIGMA ET ON RECUPERE SIGMA EN ENTREE C JFLUAG = 2 ON FLUE AVEC (SIG-X) ET ON RECUPERE (SIG-X) EN ENTREE C LFLUAG = 0 ON ECROUIT EN CAS DE FLUAGE C LFLUAG = 1 ON N'ECROUIT PAS EN CAS DE FLUAGE C IFLU=0 IF(JFLUAG.GT.1.AND.LFLUAG.EQ.0) IFLU=1 C A2=0. C2=0. B=0. PHI=1.D00 ICOD=0 CALL CHALIM(EPSTAR,R,XMAT,TET,ICOD,A1,C1,A2,C2,R0,RM,B, . PHI,PSI,OME,ICENT2,IDIAM,NUMCHA) ELT=YUNG/(1.+XNU) IF(ITHER.NE.0) ELT=ELT*EI(IA)/YUNG G=ELT*0.5 SAC1=A1*C1*PHI AC1=SAC1*0.66666667 SAC2=A2*C2*PHI AC2=SAC2*0.66666667 SAC12=SAC1+SAC2 AC12=AC1+AC2 GO TO (101,102,103,104,105,103,107,104,109,999,999,999, . 103,101),ITYP 101 NPLEIN=3 IBO=1 E(1)=ELT+AC12*IFLU E(2)=-0.5*E(1) E(3)=1.5*E(1) E(4)=-AC1 E(5)=0.5*AC1 E(6)=-1.5*AC1 IF(ICENT2.EQ.0) GO TO 200 E(7)=-AC2 E(8)=0.5*AC2 E(9)=-1.5*AC2 GO TO 200 102 IBO=2 GO TO 121 103 IBO=1 121 NPLEIN=2 E(1)=G*(2.-XNU)/(1.-XNU)+SAC12*IFLU E(2)=G*(2.*XNU-1.)/(1.-XNU) E(3)=1.5*(ELT+AC12*IFLU) E(4)=-SAC1 E(5)=0. E(6)=-SAC1 IF(ICENT2.EQ.0) GO TO 200 E(7)=-SAC2 E(8)=0. E(9)=-SAC2 GO TO 200 104 IBO=1 GO TO 125 107 IBO=2 125 DUM=YUNG NPLEIN=1 IF(ITHER.NE.0) DUM=DUM*EI(IA)/YUNG DUM=DUM+SAC12*IFLU E(1)=DUM E(4)=-SAC1 IF(ICENT2.NE.0) E(7)=-SAC2 GO TO 200 105 CONTINUE 109 CONTINUE 200 IBOU1=IBOU+1 TAUX=0. TIME=TEMPS-HPAS ICLFLU=0 IF(IT.NE.1) GO TO 201 C C MODIFS POUR LA 1-ERE ITERATION C ECOULEMENT SELON SIGMA C S0=VONMIS(SIGEL,ITYP,ALFAH,COVNMS) CALL CRPLAW(VI0,EPSTAR,S0,TET,TIME,HPAS,ICLFLU,NCOURB) DPSM1=VI0 EPST=EPSTAR+HPAS*VI0 CALL CRPLAW(VIF,EPST,SSTAR,TET,TEMPS,HPAS,ICLFLU,NCOURB) DPSM2=SSTAR SF=SSTAR DEPS=(VI0+VIF)*0.5D0*HPAS EPST=EPSTAR+DEPS C C TEST POUR LES CAS DE FLUAGE A SIGMA NON CTE ET AVEC SEUIL C IF(DEPS.EQ.0.) GO TO 1380 DEPSUR=0. IF(SF.NE.0.) DEPSUR=DEPS/SF CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO) IF(IFLU.EQ.0) GO TO 1531 CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO) IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU, . NPLEIN,E(7),DEPSUR,IBO) DO 1334 IB=1,IBOU AMTRI(IB,7)=0.D0 IB1=IB+IBOU IF(ICENT2.NE.0) GO TO 1335 AMTRI(IB1,7)=ALPHA1(IB) GO TO 1334 1335 AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB) AMTRI(IB1+IBOU,7)=ALPHA2(IB) 1334 CONTINUE CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2, . C1,C2,DEPS,IBO,IFLU,1,LFLUAG,KERRE) IF(KERRE.NE.0) RETURN DO 1532 I=1,IBOU DSIGP(I)=-AMTRI(I,7) DO 1533 J=1,IBOU 1533 DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J) 1532 STOT(I)=SIGEL(I)+DSIGP(I) GO TO 222 1531 DO 304 I=1,IBOU DSIGP(I)=0. DO 305 J=1,IBOU 305 DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J) 304 STOT(I)=SIGEL(I)+DSIGP(I) GO TO 221 201 CONTINUE VI0=DPSM1 SF=DPSM2 EPST=EPSTAR+HPAS*VI0 CALL CRPLAW(VIF,EPST,SF,TET,TEMPS,HPAS,ICLFLU,NCOURB) DEPS=(VI0+VIF)*0.5*HPAS EPST=EPSTAR+DEPS 1380 CONTINUE DEPSUR=0. IF(SF.NE.0.) DEPSUR=DEPS/SF 222 CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO) 221 IF(LFLUAG.EQ.1) GO TO 1240 CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO) IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU, . NPLEIN,E(7),DEPSUR,IBO) 1240 DO 202 I=1,IBOU 202 AMTRI(I,I)=AMTRI(I,I)+1. C C SECOND MEMBRE C DO 134 IB=1,IBOU AMTRI(IB,7)=STOT(IB) IF(LFLUAG.EQ.1) GO TO 134 IB1=IB+IBOU IF(ICENT2.NE.0) GO TO 135 AMTRI(IB1,7)=ALPHA1(IB) GO TO 134 135 AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB) AMTRI(IB1+IBOU,7)=ALPHA2(IB) 134 CONTINUE CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2,C1,C2, . DEPS,IBO,IFLU,0,LFLUAG,KERRE) IF(KERRE.NE.0) RETURN 300 SI=VONMIS(AMTRI(1,7),ITYP,ALFAH,COVNMS) DPSM2=SI DO 301 I=1,IBOU SIGEL(I)=AMTRI(I,7) IF(LFLUAG.EQ.1) GO TO 301 DALPHA(I)=AMTRI(IBOU+I,7)-ALPHA1(I) IF(ICENT2.EQ.0) GO TO 301 DALPHA(I)=DALPHA(I)+AMTRI(IBOU+IBOU+I,7) 301 CONTINUE C C LES DEUX CENTRES SONT CUMULES DANS ALPHA1 C IF(LFLUAG.EQ.1) RETURN C C MISE A JOUR DES CENTRES DES SPHERES C DO 303 I=1,IBOU ALPHA1(I)=AMTRI(IBOU+I,7) IF(ICENT2.EQ.0) GO TO 303 ALPHA1(I)=ALPHA1(I)+AMTRI(IBOU+IBOU+I,7) ALPHA2(I)=AMTRI(IBOU+IBOU+I,7) 303 CONTINUE RETURN 999 WRITE(6,7999) 7999 FORMAT('0 CHAFLU - CAS NON IMPLEMENTE ' /) RETURN END