Télécharger jac0rh.eso

Retour à la liste

Numérotation des lignes :

  1. C JAC0RH SOURCE CHAT 05/01/13 00:47:56 5004
  2. CCC
  3. C **********************************************************************
  4. CCC
  5. SUBROUTINE JAC0RHMC (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. * write(6,*) ' dans jac0rhmc ',ndimk,x,ndims,ndimv,lam,nescri,ues,
  13. * > kerre
  14. kerre=0
  15. void =0.D0
  16. do i=1,6
  17. Avecm(i)=0.D0
  18. vecntA(i)=0.D0
  19. vecn(i)=0.D0
  20. vecm(i)=0.D0
  21. vecEm(i)=0.D0
  22. enddo
  23. do i=1,36
  24. amat(i)=0.D0
  25. gmat(i)=0.D0
  26. hmat(i)=0.D0
  27. enddo
  28. c m
  29. call vflsigRHMC(x,ndims,void,ndimv,vecm)
  30. c n
  31. call vyisigRHMC(x,ndims,void,ndimv,vecn)
  32. c H
  33. call HessFlsigRHMC(x,ndims,void,ndimv,Hmat,ndims)
  34. c G=E
  35. call MatGenHook(Gmat,ndims,ndims)
  36. * write (6,*) ' jac0 1'
  37. c Em = E*m
  38. do i=1,ndims
  39. do j=1,ndims
  40. vecEm(i)=vecEm(i)+Gmat(ndims*(j-1)+i)*vecm(j)
  41. enddo
  42. enddo
  43. * write (6,*) ' jac0 1a'
  44. c A = I+l*E*H
  45. do i=1,ndims
  46. do j=1,ndims
  47. i1=ndims*(j-1)+i
  48.  
  49. do k=1,ndims
  50. Amat(i1)=Amat(i1)+
  51. . Gmat(ndims*(k-1)+i)*Hmat(ndims*(j-1)+k)
  52. enddo
  53. Amat(i1)=lam*Amat(i1)
  54. enddo
  55. Amat(ndims*(i-1)+i)=1.D0+Amat(ndims*(i-1)+i)
  56. enddo
  57. c G = A-1
  58. * write (6,*) ' jac0 2'
  59. call DescLU(Amat,ndims)
  60. call LUinv(Amat,Gmat,ndims)
  61. c g = nt*A-1*Em
  62. g=0.D0
  63. do i=1,ndims
  64. do j=1,ndims
  65. g=g+vecn(i)*Gmat(i+ndims*(j-1))*vecEm(j)
  66. enddo
  67. enddo
  68. c G*Em; nt*G
  69. do i=1,ndims
  70. do j=1,ndims
  71. Avecm(i)=Avecm(i)+Gmat(i+ndims*(j-1))*vecEm(j)
  72. vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndims*(i-1))
  73. enddo
  74. enddo
  75. * write (6,*) ' jac0 3'
  76. c K = G-(G*m * nt*G)/g
  77. do i=1,ndims
  78. do j=1,ndims
  79. Kmat(i,j)=Gmat((j-1)*ndims+i)-Avecm(i)*vecntA(j)/g
  80. enddo
  81. enddo
  82. return
  83. end
  84.  
  85.  
  86.  
  87.  

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