C CRILAM SOURCE CB215821 16/04/21 21:16:10 8920 SUBROUTINE CRILAM(I,ST,S,DS,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,P1, .P2,P3,YUNG,XNU,DGLAMP,DGLAMM,DGLAM,DL,DI,ISOMET,KERRE) C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO C DIMENSION S(*),DS(*),ST(*) C ZR=0.D0 ISOMET=0 C GO TO (100,200,300,400,500),I WRITE(IOIMP,10)I KERRE=640 RETURN C C CAS DU CRITERE DE LA POROSITE (1) C 100 A=-0.33333333333333333333333333333333333D0 IB=0 H=P3 GO TO 1 C C CAS DU CRITERE DE DRUCKER DUCTILE (2) C 200 A=ALFV IB=1 H=0.D0 GO TO 1 C C CAS DU CRITERE DE VON MISES (3) C 300 A=0.D0 IB=1 H=P1 GO TO 1 C C CAS DU CRITERE DE DRUCKER FRAGILE (4) C 400 A=ALF1 IB=1 H=0. GO TO 1 C C CAS DU CRITERE DE DRUCKER FRAGILE ECROUI. (5) C 500 A=ALF2 IB=1 H=P2 GO TO 1 C 1 SU=1.5D0*YUNG/(1.D0+XNU) DU=3.D0*YUNG/(1.D0-2.D0*XNU) C C CALCUL DU: DEN C DEN=H IF(IB.NE.0) DEN=DEN+SU IF(A.NE.0.D0) DEN=DEN+A*A*DU IF(DEN.NE.0.D0) GO TO 2 WRITE(IOIMP,11) KERRE=640 RETURN C 2 CALL KRITER(I,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,P1, .P2,P3,ZR,ST,FSIG,FCRIT,KERRE) DGLAMM=FCRIT/DEN CALL KRITER(I,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,P1, .P2,P3,ZR,S,FSIG,FCRIT,KERRE) DI=FCRIT/DEN TRDS=DS(1)+DS(2)+DS(3) X=A*TRDS IF(A.EQ.0.D0) X=0.D0 IF(IB.EQ.0)GO TO 3 TRS=S(1)+S(2)+S(3) SIGEQ2=AVM(S,S) SIGEQ=SQRT(SIGEQ2) IF(SIGEQ.NE.0.D0) GO TO 5 ISOMET=1 DGLAM=TRDS*A/DEN GO TO 6 5 FF=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3) ZZ=2.D0*(S(4)*DS(4)+S(5)*DS(5)+S(6)*DS(6)) TRSDS=FF+ZZ-TRS*TRDS/3.D0 X=X+1.5D0*TRSDS/SIGEQ 3 DGLAM=X/DEN 6 X=A*TRDS IF(A.EQ.0.D0) X=0.D0 IF(IB.EQ.0)GO TO 4 TRS=ST(1)+ST(2)+ST(3) SIGEQ2=AVM(ST,ST) SIGEQ=SQRT(SIGEQ2) IF(SIGEQ.NE.0.D0) GO TO 7 ISOMET=1 DGLAMP=TRDS*A/DEN GO TO 8 7 FF=ST(1)*DS(1)+ST(2)*DS(2)+ST(3)*DS(3) ZZ=2.D0*(ST(4)*DS(4)+ST(5)*DS(5)+ST(6)*DS(6)) TRSDS=FF+ZZ-TRS*TRDS/3.D0 X=X+1.5D0*TRSDS/SIGEQ 4 DGLAMP=X/DEN 8 DL=DGLAMM-0.5D0*DGLAMP C 10 FORMAT(1X,'ERREUR DANS CRILAM I=',I4) 11 FORMAT(1X,'ERREUR DANS CRILAM DEN EGAL A ZERO') C RETURN END