Download crilam.eso

Back to the list

   1 : C CRILAM    SOURCE    CHAT      05/01/12    22:30:27     5004           
   2 :       SUBROUTINE CRILAM(I,ST,S,DS,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,P1,
   3 :      .P2,P3,YUNG,XNU,DGLAMP,DGLAMM,DGLAM,DL,DI,ISOMET,KERRE)
   4 : C
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)
   7 : -INC CCOPTIO
   8 : C
   9 :       DIMENSION S(*),DS(*),ST(*)
  10 : C
  11 :       ZR=0.D0
  12 :       ISOMET=0
  13 : C
  14 :       GO TO (100,200,300,400,500),I
  15 :       WRITE(IOIMP,10)I
  16 :       KERRE=640
  17 :       RETURN
  18 : C
  19 : C CAS DU CRITERE DE LA POROSITE (1)
  20 : C
  21 :   100 A=-0.33333333333333333333333333333333333D0
  22 :       IB=0
  23 :       H=P3
  24 :       GO TO 1
  25 : C
  26 : C CAS DU CRITERE DE DRUCKER DUCTILE (2)
  27 : C
  28 :   200 A=ALFV
  29 :       IB=1
  30 :       H=0.D0
  31 :       GO TO 1
  32 : C
  33 : C CAS DU CRITERE DE VON MISES (3)
  34 : C
  35 :   300 A=0.D0
  36 :       IB=1
  37 :       H=P1
  38 :       GO TO 1
  39 : C
  40 : C CAS DU CRITERE DE DRUCKER FRAGILE (4)
  41 : C
  42 :   400 A=ALF1
  43 :       IB=1
  44 :       H=0.
  45 :       GO TO 1
  46 : C
  47 : C CAS DU CRITERE DE DRUCKER FRAGILE ECROUI. (5)
  48 : C
  49 :   500 A=ALF2
  50 :       IB=1
  51 :       H=P2
  52 :       GO TO 1
  53 : C
  54 :     1 SU=1.5D0*YUNG/(1.D0+XNU)
  55 :       DU=3.D0*YUNG/(1.D0-2.D0*XNU)
  56 : C
  57 : C CALCUL DU: DEN
  58 : C
  59 :       DEN=H
  60 :       IF(IB.NE.0)   DEN=DEN+SU
  61 :       IF(A.NE.0.D0) DEN=DEN+A*A*DU
  62 :       IF(DEN.NE.0.D0) GO TO 2
  63 :       WRITE(IOIMP,11)
  64 :       KERRE=640
  65 :       RETURN
  66 : C
  66 :     2 CALL KRITER(I,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,P1,
  67 :      .P2,P3,ZR,ST,FSIG,FCRIT,KERRE)
  68 :       DGLAMM=FCRIT/DEN
  68 :       CALL KRITER(I,ALFV,ALF1,ALF2,VOM,DPD,DF1,DF2,POR,P1,
  69 :      .P2,P3,ZR,S,FSIG,FCRIT,KERRE)
  70 :       DI=FCRIT/DEN
  71 :       TRDS=DS(1)+DS(2)+DS(3)
  72 :       X=A*TRDS
  73 :       IF(A.EQ.0.D0) X=0.D0
  74 :       IF(IB.EQ.0)GO TO 3
  75 :       TRS=S(1)+S(2)+S(3)
  76 :       SIGEQ2=AVM(S,S)
  77 :       SIGEQ=DSQRT(SIGEQ2)
  78 :       IF(SIGEQ.NE.0.D0) GO TO 5
  79 :       ISOMET=1
  80 :       DGLAM=TRDS*A/DEN
  81 :       GO TO 6
  82 :     5 FF=S(1)*DS(1)+S(2)*DS(2)+S(3)*DS(3)
  83 :       ZZ=2.D0*(S(4)*DS(4)+S(5)*DS(5)+S(6)*DS(6))
  84 :       TRSDS=FF+ZZ-TRS*TRDS/3.D0
  85 :       X=X+1.5D0*TRSDS/SIGEQ
  86 :     3 DGLAM=X/DEN
  87 :     6 X=A*TRDS
  88 :       IF(A.EQ.0.D0) X=0.D0
  89 :       IF(IB.EQ.0)GO TO 4
  90 :       TRS=ST(1)+ST(2)+ST(3)
  91 :       SIGEQ2=AVM(ST,ST)
  92 :       SIGEQ=DSQRT(SIGEQ2)
  93 :       IF(SIGEQ.NE.0.D0) GO TO 7
  94 :       ISOMET=1
  95 :       DGLAMP=TRDS*A/DEN
  96 :       GO TO 8
  97 :     7 FF=ST(1)*DS(1)+ST(2)*DS(2)+ST(3)*DS(3)
  98 :       ZZ=2.D0*(ST(4)*DS(4)+ST(5)*DS(5)+ST(6)*DS(6))
  99 :       TRSDS=FF+ZZ-TRS*TRDS/3.D0
 100 :       X=X+1.5D0*TRSDS/SIGEQ
 101 :     4 DGLAMP=X/DEN
 102 :     8 DL=DGLAMM-0.5D0*DGLAMP
 103 : C
 104 :    10 FORMAT(1X,'ERREUR DANS CRILAM  I=',I4)
 105 :    11 FORMAT(1X,'ERREUR DANS CRILAM  DEN EGAL A ZERO')
 106 : C
 107 :       RETURN
 108 :       END
 109 :  

© Cast3M 2003 - All rights reserved.
Disclaimer