Télécharger mtc1j2.eso

Retour à la liste

Numérotation des lignes :

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

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