Télécharger act_la.eso

Retour à la liste

Numérotation des lignes :

  1. C ACT_LA SOURCE CB215821 16/04/21 21:15:02 8920
  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
  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=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.  

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