C ACT_LA    SOURCE    PV        22/04/19    16:17:58     11344          

      SUBROUTINE ACTUALIZA_LAMBDA(X,NDIMX,NMODEL,LAM,DLA,DLB)
      IMPLICIT INTEGER(I-N)
      integer n,i,j,k,ndims,ndimv,nmodel,nnumer,ndimx
      real*8  x(ndimx),deltax,sig(3),vecm(4)
      real*8  vecnaux(4),vecn(4),amat(16),vtLUiw,void(1)
      real*8  aamat(16),eemat(16),dla,dlb,lam
      integer             augla
      real*8                    c
      common /auglagrang1/ augla
      common /auglagrang2/ c
      real*8  bbmat(16),res
      call zzero(amat ,16)
      call zzero(aamat,16)
      call zzero(bbmat,16)
      call zzero(eemat,16)
      void(1)=0.D0
      ndimv=1
      ndims=3
c conseguir sig
      call der_enerelas_dpral(x,sig,nmodel)
c n, m , A
      if (ndimx.eq.3) then
       call yieldd(sig,ndims,void,ndimv,dla,nmodel)
       call vflsig(sig,ndims,void,ndimv,vecm,nmodel)
       call vyisig(sig,ndims,void,ndimv,vecnaux,nmodel)
       call HessFlsig(sig,ndims,void,ndimv,amat,ndimx,nmodel)
      else if (ndimx.eq.4) then
       call yieldd(sig,ndims,x(ndimx),ndimv,dla,nmodel)
       call vflsig(sig,ndims,x(ndimx),ndimv,vecm,nmodel)
       call vflvar(sig,ndims,x(ndimx),ndimv,vecm(ndimx),nmodel)
       call vyisig(sig,ndims,x(ndimx),ndimv,vecnaux,nmodel)
       call vyivar(sig,ndims,x(ndimx),ndimv,vecnaux(ndimx),nmodel)
       call HessFlsig(sig,ndims,x(ndimx),ndimv,amat,ndimx,nmodel)
      endif
c E=d2_ener (ampliada de 3 a ndimx con 1 en la diagonal)
      call der2_enerelas_dpral(x,eemat,ndimx,nmodel)
c n^T=n^T*E
c AA=A*E
      do i=1,ndimx
       vecn(i)=0.D0
       do j=1,ndimx
         vecn(i)=vecn(i)+vecnaux(j)*eemat(j+(i-1)*ndimx)
         aamat(i+(j-1)*ndimx)=0.D0
         do k=1,ndimx
          aamat(i+(j-1)*ndimx)=aamat(i+(j-1)*ndimx)+
     .                         amat(i+(k-1)*ndimx)*eemat(k+(j-1)*ndimx)
         enddo
       enddo
      enddo
**
      if ((augla.eq.1)) then
c BB=n*n^T*E
      do i=1,ndimx
       do j=1,ndimx
         bbmat(i+(j-1)*ndimx)=0.D0
         do k=1,ndimx
          bbmat(i+(j-1)*ndimx)=bbmat(i+(j-1)*ndimx)+
     .                      vecnaux(i)*vecnaux(k)*eemat(k+(j-1)*ndimx)
         enddo
       enddo
      enddo
      endif
**
      call zzero(amat,16 )
c A=I+l*AA
      do i=1,ndimx
       amat(i+(i-1)*ndimx)=1.D0
       do j=1,ndimx
c         amat(i+(j-1)*ndimx)=amat(i+(j-1)*ndimx)+
c     .                       lam*aamat(i+(j-1)*ndimx)
**
         amat(i+(j-1)*ndimx)=amat(i+(j-1)*ndimx)+
     .                       ABS(lam+c*dla)*aamat(i+(j-1)*ndimx)+
     .                       c*bbmat(i+(j-1)*ndimx)
**
       enddo
      enddo
      call DescLU(Amat,ndimx)
      dlb=-vtLUiw(vecn,Amat,vecm,ndimx)
      return
      end