Télécharger jac1j2.eso

Retour à la liste

Numérotation des lignes :

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

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