Télécharger la plaquette Cast3M


fr en

Télécharger dlamd.eso

Retour à la liste

Numérotation des lignes : 

dlamd

  1. C DLAMD     SOURCE    CHAT      05/01/12    22:52:44     5004
  2.       SUBROUTINE DLAMD(TENS,DTENS,XLAM31,XLAM32,RDP,ADP,HDP,ITEST)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.       DIMENSION TENS(3),DTENS(3)
  6.       ITEST=0
  7.       XLAM3=0.D0
  8. C
  9. C--------------------------------------------------------
  10. C     CETTE ROUTINE PERMET DE CALCULER LA VALEUR
  11. C     DU DLAMDA ASSOCIE AU DRUCKER-PRAGER
  12. C--------------------------------------------------------
  13. C
  14.       A=ADP*(DTENS(1)+DTENS(2))+HDP
  15.       A=-A*A
  16.       A=A+DTENS(1)*DTENS(1)+DTENS(2)*DTENS(2)+3.D0*DTENS(3)*DTENS(3)
  17.      1 -DTENS(1)*DTENS(2)
  18.       B=2.D0*(ADP*(DTENS(1)+DTENS(2))+HDP)*(RDP-ADP*(TENS(1)+TENS(2)))
  19.      1 +2.D0*DTENS(1)*TENS(1)+2.D0*DTENS(2)*TENS(2)+
  20.      1 6.D0*DTENS(3)*TENS(3)-DTENS(1)*TENS(2)-DTENS(2)*TENS(1)
  21.       C=RDP-ADP*(TENS(1)+TENS(2))
  22.       C=C*C
  23.       C=-C+TENS(1)*TENS(1)+TENS(2)*TENS(2)+3.D0*TENS(3)*TENS(3)
  24.      1 -TENS(2)*TENS(1)
  25.       X1=0.D0
  26.       X2=0.D0
  27.       IF(A.EQ.0.D0) GOTO 1000
  28.       B=B/A
  29.       C=C/A
  30.       A=1.D0
  31.       DIS=B*B-4.D0*A*C
  32.       ADIS=ABS(DIS)
  33.       IF(DIS.GE.0.D0) THEN
  34.       DIS=SQRT(ADIS)
  35.       X2=(-B+DIS)/2.D0
  36.       X1=(-B-DIS)/2.D0
  37.       GOTO 2000
  38.       ENDIF
  39.       ITEST=1
  40.       RETURN
  41.  1000 IF(B.EQ.0.D0) THEN
  42.       X1=0.D0
  43.       X2=0.D0
  44.       GOTO 2000
  45.       ENDIF
  46.       X1=-C/B
  47.       X2=X1
  48.  2000 CONTINUE
  49.       S1=RDP-ADP*(TENS(1)+TENS(2)+X1*(DTENS(1)+DTENS(2)))-HDP*X1
  50.       S2=RDP-ADP*(TENS(1)+TENS(2)+X2*(DTENS(1)+DTENS(2)))-HDP*X2
  51.       IF(RDP.NE.0.D0) THEN
  52.       S1=S1/RDP
  53.       S2=S2/RDP
  54.       ENDIF
  55.       IF(S1.GE.-1.E-10.AND.S2.GE.-1.E-10) THEN
  56.       XLAM31=MIN(X1,X2)
  57.       XLAM32=MAX(X1,X2)
  58.       IF(XLAM31.LT.-1.D-10) XLAM31=XLAM32
  59.       RETURN
  60.       ENDIF
  61.       IF(S1.GE.-1.E-10.AND.S2.LT.-1.E-10) THEN
  62.       XLAM31=X1
  63.       XLAM32=X1
  64.       RETURN
  65.       ENDIF
  66.       IF(S1.LT.-1.E-10.AND.S2.GE.-1.E-10) THEN
  67.       XLAM31=X2
  68.       XLAM32=X2
  69.       RETURN
  70.       ENDIF
  71.       IF(S1.LT.-1.E-10.AND.S2.LT.-1.E-10) THEN
  72.       XLAM31=0.D0
  73.       XLAM32=0.D0
  74.       RETURN
  75.       ENDIF
  76.       END
  77.  
  78.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales