C DSIGGC    SOURCE    AM        12/02/28    00:04:15     7289           
      SUBROUTINE dsiggc(sigma,dgc,ag,P2,pi2,i1,i6,fc,fb,lcp)

c     This subroutine calculates the derivative of the plastic potential in compression
c     (necessary for the calculation of the plastic strain in compression)                                               
c                                           
c     Plastic potential: gc = dsqrt (3 J2) + ag I1  with  J2 : 2nd invariant of the deviatoric stress                                                 
c                                                   and   I1 : 1st invariant of the stress

      IMPLICIT REAL*8 (A-B,D-H,O-Z)
      implicit integer (I-K,M,N)
      implicit logical (L)
      implicit character*10 (C)      

****  dimension vloc(i6),vloc1(i1),pi2(i6),vloc2(i6)
      dimension vloc(6),vloc1(1),pi2(I6),vloc2(6)
      dimension dgc(i6),p2(i6,i6),sigma(i6)



*****
*     MESSAGES D'ERREUR ( SUPPRESSION DES AUTOMATIC OBJECTS)
      IF(I1.GT.1) PRINT *, ' DSIGGC - ERREUR  I1 = ', I1, ' > 1 '
      IF(I6.GT.6) PRINT *, ' DSIGGC - ERREUR  I6 = ', I6, ' > 6 '
*****




      r1 = 1.
      r2 = 2.
      alpha  = (fb-fc)/(2*fb-fc)
      
      call mulAB(P2,sigma,vloc,i6,i6,i6,i1)             
c          [6;1]=[6;6]x[6;1]
      do iloc=1,6
        vloc2(iloc) = vloc(iloc)
      end do 
      call mulATB(sigma,vloc,vloc1,i6,i1,i6,i1)         
c          [1]=[1;6]x[6;1]
      rloc = (r1/r2)* vloc1(i1)

      if (rloc.le.0.d0) then
        psi2 = 0.d0
      else
        psi2 = dsqrt(rloc)
c       psi2 = dsqrt (3 * J2)
      endif
     
      call mulATB(pi2,sigma,vloc1,i6,i1,i6,i1)          
c          [1]=[1;6]x[6;1]
      test = alpha*vloc1(i1)
c     test = alpha * I1

      psi2lim=max(dabs(1.E-7*test),1.d-3)
      f_compr = DPfunc(sigma,alpha)
      if (dabs(psi2).le.psi2lim) then
        do iloc=i1,i6
          dgc(iloc) = ((vloc2(iloc)/(2.*psi2lim)) + ag * pi2(iloc))
        end do
      else if (dabs(f_compr).le.100.) then      
c       APEX of the Drucker-Prager surface
        do iloc=i1,i6
          dgc(iloc) = ((vloc2(iloc)/(2.*psi2)) + ag * pi2(iloc))
        end do
      else
        do iloc=i1,i6
          dgc(iloc) = ((vloc2(iloc)/(2.*psi2)) + ag * pi2(iloc))
        end do
      endif

      RETURN
      END