Télécharger la plaquette Cast3M


fr en

Télécharger dsdrucke.eso

Retour à la liste

Numérotation des lignes : 

dsdrucke

  1. C DSDRUCKE  SOURCE    CB215821  16/04/21    21:16:32     8920
  2.       SUBROUTINE dsigDrucker(fc,fb,sigma,dfc,alpha,P2,pi2,i1,i6,lcp)
  3.  
  4. c     This subroutine calculates the derivative of the Drucker Prager
  5. c     plastic function with respect to sigma
  6. c
  7. c     fc = SQRT(3 J2) + alpha I1  with  J2 : 2nd invariant of the deviatoric stress
  8. c                                    and  I1 : 1st invariant of the stress
  9.  
  10.       IMPLICIT REAL*8 (A-B,D-H,O-Z)
  11.       implicit integer (I-K,M,N)
  12.       implicit logical (L)
  13.       implicit character*10 (C)
  14.  
  15. ****  dimension vloc(i6),sigma(i6),P2(i6,i6),pi2(i6)
  16.       dimension vloc(6),sigma(i6),P2(i6,i6),pi2(i6)
  17. ****  dimension dfc(i6),vloc1(i1),vloc2(i6)
  18.       dimension dfc(6),vloc1(1),vloc2(6)
  19.  
  20.  
  21. *****
  22. *     MESSAGES D'ERREUR ( SUPPRESSION DES AUTOMATIC OBJECTS)
  23.       IF(I1.GT.1) PRINT *, ' DSIGDRUCKER - ERREUR  I1 = ', I1, ' > 1 '
  24.       IF(I6.GT.6) PRINT *, ' DSIGDRUCKER - ERREUR  I6 = ', I6, ' > 6 '
  25. *****
  26.  
  27.  
  28.       r1 = 1.
  29.       r2 = 2.
  30.       i3 = 3
  31.       alpha  = (fb-fc)/(2.*fb-fc)
  32.  
  33.       call mulAB(P2,sigma,vloc,i6,i6,i6,i1)
  34. c         [6;1]=[6;6]x[6;1]
  35.       do iloc=1,6
  36.         vloc2(iloc) = vloc(iloc)
  37.       end do
  38.       call mulATB(sigma,vloc,vloc1,i6,i1,i6,i1)
  39. c         [1]=[1;6]x[6;1]
  40.       rloc = (r1/r2)* vloc1(i1)
  41.       if (rloc.le.0.d0) then
  42.         psi2 = 0.d0
  43.       else
  44.         psi2 = SQRT(rloc)
  45. c       psi2 = SQRT(3 * J2)
  46.       endif
  47.  
  48.       call mulATB(pi2,sigma,vloc1,i6,i1,i6,i1)
  49. c         [1]=[1;6]x[6;1]
  50.       test = alpha*vloc1(i1)
  51. c     test = alpha*I1
  52.  
  53.       psi2lim=max(1.E-7*test,1.d-3)
  54.       f_compr = DPfunc(sigma,alpha)
  55.       if (ABS(psi2).le.psi2lim) then
  56.         do iloc=i1,i6
  57.           dfc(iloc) = alpha * pi2(iloc)
  58.         enddo
  59.       else if (ABS(f_compr).le.100.) then
  60. c       APEX of the Drucker-Prager surface
  61.         do iloc=i1,i6
  62.           dfc(iloc) = 10.E+12 * vloc2(iloc)
  63.         end do
  64.       else
  65.         do iloc=i1,i6
  66.           dfc(iloc) = ((vloc2(iloc)/(2.*psi2)) + alpha * pi2(iloc))
  67.         end do
  68.       endif
  69.  
  70.       RETURN
  71.       END
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  

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