Télécharger jac0j2.eso

Retour à la liste

Numérotation des lignes :

  1. C JAC0J2 SOURCE CHAT 05/01/13 00:47:53 5004
  2. CCC
  3. C **********************************************************************
  4. CCC
  5. SUBROUTINE JAC0J2 (KMAT,NDIMK,X,NDIMS,NDIMV,LAM,
  6. . nescri,ues,kerre)
  7. IMPLICIT INTEGER(I-N)
  8. integer ndims,nescri,ues,ndimv,i,j,k,kerre,ndimk
  9. real*8 x(ndims),lam,void,Kmat(ndimk,ndimk),g
  10. real*8 Amat(36),Gmat(36),vecn(6),vecm(6),Avecm(6),vecntA(6),
  11. . vecEm(6),Hmat(36)
  12. kerre=0
  13. void =0.D0
  14. do i=1,6
  15. Avecm(i)=0.D0
  16. vecntA(i)=0.D0
  17. vecn(i)=0.D0
  18. vecm(i)=0.D0
  19. vecEm(i)=0.D0
  20. enddo
  21. do i=1,36
  22. amat(i)=0.D0
  23. gmat(i)=0.D0
  24. hmat(i)=0.D0
  25. enddo
  26. c m
  27. call vflsigJ2(x,ndims,void,ndimv,vecm)
  28. c n
  29. call vyisigJ2(x,ndims,void,ndimv,vecn)
  30. c H
  31. call HessFlsigJ2(x,ndims,void,ndimv,Hmat,ndims)
  32. c G=E
  33. call MatGenHook(Gmat,ndims,ndims)
  34. c Em = E*m
  35. do i=1,ndims
  36. do j=1,ndims
  37. vecEm(i)=vecEm(i)+Gmat(ndims*(j-1)+i)*vecm(j)
  38. enddo
  39. enddo
  40. c A = I+l*E*H
  41. do i=1,ndims
  42. do j=1,ndims
  43. do k=1,ndims
  44. Amat(ndims*(j-1)+i)=Amat(ndims*(j-1)+i)+
  45. . Gmat(ndims*(k-1)+i)*Hmat(ndims*(j-1)+k)
  46. enddo
  47. Amat(ndims*(j-1)+i)=lam*Amat(ndims*(j-1)+i)
  48. enddo
  49. Amat(ndims*(i-1)+i)=1.D0+Amat(ndims*(i-1)+i)
  50. enddo
  51. c G = A-1
  52. call DescLU(Amat,ndims)
  53. call LUinv(Amat,Gmat,ndims)
  54. c g = nt*A-1*Em
  55. g=0.D0
  56. do i=1,ndims
  57. do j=1,ndims
  58. g=g+vecn(i)*Gmat(i+ndims*(j-1))*vecEm(j)
  59. enddo
  60. enddo
  61. c G*Em; nt*G
  62. do i=1,ndims
  63. do j=1,ndims
  64. Avecm(i)=Avecm(i)+Gmat(i+ndims*(j-1))*vecEm(j)
  65. vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndims*(i-1))
  66. enddo
  67. enddo
  68. c K = G-(G*m * nt*G)/g
  69. do i=1,ndims
  70. do j=1,ndims
  71. Kmat(i,j)=Gmat((j-1)*ndims+i)-Avecm(i)*vecntA(j)/g
  72. enddo
  73. enddo
  74. return
  75. end
  76.  
  77.  
  78.  

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