Télécharger mtc0rh.eso

Retour à la liste

Numérotation des lignes :

  1. C MTC0RH SOURCE CHAT 05/01/13 01:53:30 5004
  2. CCC
  3. C **********************************************************************
  4. CCC
  5. SUBROUTINE MTC0RHMC (K,NDIMK,X,NDIMS,NDIMV,LAM,
  6. . nescri,ues,kerre)
  7. IMPLICIT INTEGER(I-N)
  8. integer ndims,nescri,ues,ndimv,ifi,jc,i,j,kerre,ifl,ndimk
  9. real*8 x(ndims),lam,void,K(ndimk,ndimk),g
  10. real*8 Amat(36),Gmat(36),vecn(6),vecm(6),Avecm(6),vecntA(6)
  11. kerre=0
  12. void =0.D0
  13. do i=1,6
  14. Avecm(i)=0.D0
  15. vecntA(i)=0.D0
  16. vecn(i)=0.D0
  17. vecm(i)=0.D0
  18. enddo
  19. do i=1,36
  20. amat(i)=0.D0
  21. gmat(i)=0.D0
  22. enddo
  23. ifl=-1
  24. call MatHok(Gmat,ndims,ndims,ifl)
  25. call vflsigRHMC(x,ndims,void,ndimv,vecm)
  26. call vyisigRHMC(x,ndims,void,ndimv,vecn)
  27. call HessFlsigRHMC(x,ndims,void,ndimv,Amat,ndims)
  28. do i=1,ndims*ndims
  29. Amat(i)=Gmat(i)+lam*Amat(i)
  30. enddo
  31. call DescLU(Amat,ndims)
  32. call LUinv(Amat,Gmat,ndims)
  33. g=0.D0
  34. do i=1,ndims
  35. do j=1,ndims
  36. g=g+vecn(i)*Gmat(i+ndims*(j-1))*vecm(j)
  37. enddo
  38. enddo
  39. do i=1,ndims
  40. do j=1,ndims
  41. Avecm(i)=Avecm(i)+Gmat(i+ndims*(j-1))*vecm(j)
  42. vecntA(i)=vecntA(i)+vecn(j)*Gmat(j+ndims*(i-1))
  43. enddo
  44. enddo
  45. do ifi=1,ndims
  46. do jc=1,ndims
  47. K(ifi,jc)=Gmat((jc-1)*ndims+ifi)-Avecm(ifi)*vecntA(jc)/g
  48. enddo
  49. enddo
  50. return
  51. end
  52.  
  53.  
  54.  
  55.  

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