C MTC0J2    SOURCE    CHAT      05/01/13    01:53:26     5004           
CCC
C **********************************************************************
CCC
      SUBROUTINE MTC0J2 (K,NDIMK,X,NDIMS,NDIMV,LAM,
     .                   nescri,ues,kerre)
      IMPLICIT INTEGER(I-N)
      integer ndims,nescri,ues,ndimv,ifi,jc,i,j,kerre,ifl,ndimk
      real*8  x(ndims),lam,void,K(ndimk,ndimk),g
      real*8  Amat(36),Gmat(36),vecn(6),vecm(6),Avecm(6),vecntA(6)
      kerre=0
      void =0.D0
        do i=1,6
         Avecm(i)=0.D0
         vecntA(i)=0.D0
         vecn(i)=0.D0
         vecm(i)=0.D0
        enddo
        do i=1,36
         amat(i)=0.D0
         gmat(i)=0.D0
        enddo
      ifl=-1
      call mathok(Gmat,ndims,ndims,ifl)
      call vflsigJ2(x,ndims,void,ndimv,vecm)
      call vyisigJ2(x,ndims,void,ndimv,vecn)
      call HessFlsigJ2(x,ndims,void,ndimv,Amat,ndims)
      do i=1,ndims*ndims
         Amat(i)=Gmat(i)+lam*Amat(i)
      enddo
      call DescLU(Amat,ndims)
      call LUinv(Amat,Gmat,ndims)
      g=0.D0
      do i=1,ndims
         do j=1,ndims
             g=g+vecn(i)*Gmat(i+ndims*(j-1))*vecm(j)
         enddo
      enddo
      do i=1,ndims
         do j=1,ndims
           Avecm(i)=Avecm(i)+Gmat(i+ndims*(j-1))*vecm(j)
           vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndims*(i-1))
         enddo
      enddo
      do ifi=1,ndims
         do jc=1,ndims
            K(ifi,jc)=Gmat((jc-1)*ndims+ifi)-Avecm(ifi)*vecntA(jc)/g
         enddo
      enddo
      return
      end