Esope source files

   1 : C DSDRUCKE  SOURCE    AM        12/02/28    21:15:09     7291           
   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 = dsqrt (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 : 
  32 :       call mulAB(P2,sigma,vloc,i6,i6,i6,i1)             
  33 : c         [6;1]=[6;6]x[6;1]
  34 :       do iloc=1,6
  35 :         vloc2(iloc) = vloc(iloc)
  36 :       end do 
  36 :       call mulATB(sigma,vloc,vloc1,i6,i1,i6,i1)     
  37 : c         [1]=[1;6]x[6;1]
  38 :       rloc = (r1/r2)* vloc1(i1)
  39 :       if (rloc.le.0.d0) then
  40 :         psi2 = 0.d0
  41 :       else
  42 :         psi2 = dsqrt(rloc)
  43 : c       psi2 = dsqrt(3 * J2)
  44 :       endif
  45 :      
  45 :       call mulATB(pi2,sigma,vloc1,i6,i1,i6,i1)          
  46 : c         [1]=[1;6]x[6;1]
  47 :       test = alpha*vloc1(i1)
  48 : c     test = alpha*I1
  49 : 
  50 :       psi2lim=max(1.E-7*test,1.d-3)
  51 :       f_compr = DPfunc(sigma,alpha)
  52 :       if (dabs(psi2).le.psi2lim) then
  53 :         do iloc=i1,i6
  54 :           dfc(iloc) = alpha * pi2(iloc)
  55 :         enddo        
  56 :       else if (dabs(f_compr).le.100.) then
  57 : c       APEX of the Drucker-Prager surface
  58 :         do iloc=i1,i6
  59 :           dfc(iloc) = 10.E+12 * vloc2(iloc)
  60 :         end do
  61 :       else
  62 :         do iloc=i1,i6
  63 :           dfc(iloc) = ((vloc2(iloc)/(2.*psi2)) + alpha * pi2(iloc))
  64 :         end do
  65 :       endif
  66 : 
  67 :       RETURN
  68 :       END
  69 : 
  70 : 
  71 : 
  72 :       
  73 :