Télécharger la plaquette Cast3M


fr en

Télécharger act_la.eso

Retour à la liste

Numérotation des lignes : 

act_la

  1. C ACT_LA    SOURCE    PV        22/04/19    16:17:58     11344          
  2.  
  3.       SUBROUTINE ACTUALIZA_LAMBDA(X,NDIMX,NMODEL,LAM,DLA,DLB)
  4.       IMPLICIT INTEGER(I-N)
  5.       integer n,i,j,k,ndims,ndimv,nmodel,nnumer,ndimx
  6.       real*8  x(ndimx),deltax,sig(3),vecm(4)
  7.       real*8  vecnaux(4),vecn(4),amat(16),vtLUiw,void(1)
  8.       real*8  aamat(16),eemat(16),dla,dlb,lam
  9.       integer             augla
  10.       real*8                    c
  11.       common /auglagrang1/ augla
  12.       common /auglagrang2/ c
  13.       real*8  bbmat(16),res
  14.       call zzero(amat ,16)
  15.       call zzero(aamat,16)
  16.       call zzero(bbmat,16)
  17.       call zzero(eemat,16)
  18.       void(1)=0.D0
  19.       ndimv=1
  20.       ndims=3
  21. c conseguir sig
  22.       call der_enerelas_dpral(x,sig,nmodel)
  23. c n, m , A
  24.       if (ndimx.eq.3) then
  25.        call yieldd(sig,ndims,void,ndimv,dla,nmodel)
  26.        call vflsig(sig,ndims,void,ndimv,vecm,nmodel)
  27.        call vyisig(sig,ndims,void,ndimv,vecnaux,nmodel)
  28.        call HessFlsig(sig,ndims,void,ndimv,amat,ndimx,nmodel)
  29.       else if (ndimx.eq.4) then
  30.        call yieldd(sig,ndims,x(ndimx),ndimv,dla,nmodel)
  31.        call vflsig(sig,ndims,x(ndimx),ndimv,vecm,nmodel)
  32.        call vflvar(sig,ndims,x(ndimx),ndimv,vecm(ndimx),nmodel)
  33.        call vyisig(sig,ndims,x(ndimx),ndimv,vecnaux,nmodel)
  34.        call vyivar(sig,ndims,x(ndimx),ndimv,vecnaux(ndimx),nmodel)
  35.        call HessFlsig(sig,ndims,x(ndimx),ndimv,amat,ndimx,nmodel)
  36.       endif
  37. c E=d2_ener (ampliada de 3 a ndimx con 1 en la diagonal)
  38.       call der2_enerelas_dpral(x,eemat,ndimx,nmodel)
  39. c n^T=n^T*E
  40. c AA=A*E
  41.       do i=1,ndimx
  42.        vecn(i)=0.D0
  43.        do j=1,ndimx
  44.          vecn(i)=vecn(i)+vecnaux(j)*eemat(j+(i-1)*ndimx)
  45.          aamat(i+(j-1)*ndimx)=0.D0
  46.          do k=1,ndimx
  47.           aamat(i+(j-1)*ndimx)=aamat(i+(j-1)*ndimx)+
  48.      .                         amat(i+(k-1)*ndimx)*eemat(k+(j-1)*ndimx)
  49.          enddo
  50.        enddo
  51.       enddo
  52. **
  53.       if ((augla.eq.1)) then
  54. c BB=n*n^T*E
  55.       do i=1,ndimx
  56.        do j=1,ndimx
  57.          bbmat(i+(j-1)*ndimx)=0.D0
  58.          do k=1,ndimx
  59.           bbmat(i+(j-1)*ndimx)=bbmat(i+(j-1)*ndimx)+
  60.      .                      vecnaux(i)*vecnaux(k)*eemat(k+(j-1)*ndimx)
  61.          enddo
  62.        enddo
  63.       enddo
  64.       endif
  65. **
  66.       call zzero(amat,16 )
  67. c A=I+l*AA
  68.       do i=1,ndimx
  69.        amat(i+(i-1)*ndimx)=1.D0
  70.        do j=1,ndimx
  71. c         amat(i+(j-1)*ndimx)=amat(i+(j-1)*ndimx)+
  72. c     .                       lam*aamat(i+(j-1)*ndimx)
  73. **
  74.          amat(i+(j-1)*ndimx)=amat(i+(j-1)*ndimx)+
  75.      .                       ABS(lam+c*dla)*aamat(i+(j-1)*ndimx)+
  76.      .                       c*bbmat(i+(j-1)*ndimx)
  77. **
  78.        enddo
  79.       enddo
  80.       call DescLU(Amat,ndimx)
  81.       dlb=-vtLUiw(vecn,Amat,vecm,ndimx)
  82.       return
  83.       end
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales