C HEFLP2    SOURCE    CB215821  16/04/21    21:17:02     8920


      SUBROUTINE HESSFLPOWDER2 (SIG,VAR,AMAT,NDIMA)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      integer ndima,i,j
      real*8  sig(3),var,amat(ndima,ndima),daux1,
     .        aux3,aux4
      real*8  vecm(3),aux1,aux2,xj2,xi1,x22(6,6),x33(6,6)
      real*8               nn1,nn2,eta0,aa1,aa2,bb1,bb2,
     .                     pia,pib,sigy0,pcc,rrr
      common /poder2_data/ nn1,nn2,eta0,aa1,aa2,bb1,bb2,
     .                     pia,pib,sigy0,pcc,rrr
      call DDINIJ(sig,x22,x33,3)
      call Invari_I1(sig,3,xi1)
      if (xi1.lt.pia) then
         do i=1,3
           do j=1,3
             amat(i,j)=x22(i,j)+2.D0/rrr**2
           enddo
         enddo
      else
         aux1 = (pia-xi1)/(pia-pcc)
         daux1 = -1.D0/(pia-pcc)
         if (aux1.gt.1.D0) then
            aux1 =1.D0
            daux1=0.D0
         endif
         aux2 = bb1/3.D0
         call Invari_J2(sig,3,xj2)
         call desviador(sig,vecm,3)
         aux3 = 1.D0 / SQRT(2.D0*xj2)
         aux4 = -1.D0 / SQRT((2.D0*xj2)**3)
         aux5 = xj2/(aa2*sigy0**2/3.D0)
         daux5 = 1.D0/(aa2*sigy0**2/3.D0)
         if (aux5.gt.1.D0) then
             aux5=1.D0
             daux5 = 0.D0
         endif
****** D-P Meschke examples
*         aux5= 1.D0
*         daux5=0.D0
*         aux1 =1.D0
*         daux1=0.D0
****** D-P Meschke examples
         do i=1,3
           do j=1,3
             amat(i,j)=aux5*(aux3*x22(i,j)+aux4*vecm(i)*vecm(j))+
     .                 daux5*(aux3*vecm(i)*vecm(j))+
     .                 aux2*daux1
           enddo
         enddo
      endif
      return
      end