Télécharger jac21.eso

Retour à la liste

Numérotation des lignes :

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

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