Download ddsiggc.eso

Back to the list

   1 : C DDSIGGC   SOURCE    AM        12/02/27    23:15:31     7289           
   2 :       SUBROUTINE ddsiggc(sigma,d2gc,ag,P2,pi2,i1,i6,fc,fb,lcp)
   3 : 
   4 : c     This subroutine calculates the second derivative of the plastic potential in compression                                               
   5 : c                                           
   6 : c     Plastic potential: gc = dsqrt (3 J2) + ag I1  with  J2 : 2nd invariant of the deviatoric stress                                                  
   7 : c                                                   and   I1 : 1st invariant of the stress
   8 : 
   9 :       IMPLICIT REAL*8 (A-B,D-H,O-Z)
  10 :       implicit integer (I-K,M,N)
  11 :       implicit logical (L)
  12 :       implicit character*10 (C)       
  13 : 
  14 :       dimension vloc(6),vloc1(1),pi2(6),vloc2(1,6)
  15 :       dimension d2gc(6,6),p2(i6,i6),sigma(6),vloc6(6,6)
  16 : 
  17 :       r1 = 1.
  18 :       r2 = 2.
  19 :       
  20 :       do jloc=1,6
  21 :         do iloc=1,6
  22 :           d2gc(iloc,jloc) = 0.d0
  23 :         enddo
  24 :       enddo
  24 :       call mulAB(P2,sigma,vloc,6,6,6,1)
  24 :       call mulATB(sigma,vloc,vloc1,6,1,6,1)
  25 :       rloc = 0.5d0 * vloc1(1)
  26 :       if (rloc.le.0.d0) then
  27 :         psi2 = 0.d0
  28 :       else
  29 :         psi2 = dsqrt(rloc)
  30 :       endif
  30 :       call mulATB(sigma,P2,vloc2,6,1,6,6)
  30 :       call mulAB(vloc,vloc2,vloc6,6,1,1,6)
  31 :       test = ag*(sigma(1)+sigma(2)+sigma(3))
  32 :       psi2lim=max(1.E-7*test,1.d-3)
  33 :       if (dabs(psi2).le.psi2lim) then
  34 :         continue
  35 : c       d2gc = 0
  36 :       else
  37 :         do jloc=1,6
  38 :           do iloc=1,6
  39 :             d2gc(iloc,jloc)=(P2(iloc,jloc)/(2.0d0*psi2)) 
  40 :      .                     - (vloc6(iloc,jloc)/(4.0d0*psi2*psi2*psi2))
  41 :           enddo
  42 :         enddo
  43 :       endif  
  44 : 
  45 :       RETURN
  46 :       END
  47 : 
  48 : 
  49 :       
  50 : 
  51 : 
  52 : 
  53 :       
  54 :  

© Cast3M 2003 - All rights reserved.
Disclaimer