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