Télécharger heflmi.eso

Retour à la liste

Numérotation des lignes :

  1. C HEFLMI SOURCE CHAT 05/01/13 00:23:41 5004
  2.  
  3. SUBROUTINE HESSFLMIEHE (SIG,VAR,AMAT,NDIMA)
  4. IMPLICIT INTEGER(I-N)
  5. integer ndima,m,i,j
  6. real*8 sig(3),var,amat(ndima,ndima)
  7. real*8 desv(3),aux1,aux2,alpha1,alpha2,alpha3,amataux(3,3)
  8. real*8 valor
  9. real*8 sigy0,kiso,siginf,velo,cpar,mpar
  10. common /miehdata/ sigy0,kiso,siginf,velo,cpar,mpar
  11. call zzero(amat,ndima*ndima)
  12. m=nint(mpar)
  13. call yieldmieheb(sig,valor)
  14. aux1=valor**(1-2*m)/2.D0*sqrt(2.D0/3.D0)
  15. aux2=aux1*cpar*3.D0**(2*m)/(2.D0**(2*m-1)+1.D0)*float(2*m-1)
  16. aux1=aux1*(1.D0-cpar)*float(2*m-1)
  17. call Desviador(sig,desv,3)
  18. if (m.gt.1) then
  19. alpha1=(desv(1)-desv(2))**(2*m-2)
  20. alpha2=(desv(2)-desv(3))**(2*m-2)
  21. alpha3=(desv(3)-desv(1))**(2*m-2)
  22. else
  23. alpha1=1.D0
  24. alpha2=1.D0
  25. alpha3=1.D0
  26. endif
  27. amat(1,1)=alpha1+alpha3
  28. amat(2,2)=alpha1+alpha2
  29. amat(3,3)=alpha2+alpha3
  30. amat(1,2)=-alpha1*aux1
  31. amat(1,3)=-alpha3*aux1
  32. amat(2,3)=-alpha2*aux1
  33. amat(2,1)=amat(1,2)
  34. amat(3,1)=amat(1,3)
  35. amat(3,2)=amat(2,3)
  36. if (m.gt.1) then
  37. do i=1,3
  38. amat(i,i)=aux1*amat(i,i)+aux2*desv(i)**(2*m-2)
  39. enddo
  40. else
  41. do i=1,3
  42. amat(i,i)=aux1*amat(i,i)+aux2
  43. enddo
  44. endif
  45. c desviador de columnas
  46. do i=1,3
  47. call Desviador(amat(1,i),amataux(1,i),3)
  48. enddo
  49. c trasponer amat
  50. aux1=amataux(1,2)
  51. amataux(1,2)=amataux(2,1)
  52. amataux(2,1)=aux1
  53. aux1=amataux(1,3)
  54. amataux(1,3)=amataux(3,1)
  55. amataux(3,1)=aux1
  56. aux1=amataux(2,3)
  57. amataux(2,3)=amataux(3,2)
  58. amataux(3,2)=aux1
  59. c desviador de columnas
  60. do i=1,3
  61. call Desviador(amataux(1,i),amat(1,i),3)
  62. enddo
  63. c no se traspone otra vez pq es simetrica
  64. call vflsigmiehe(sig,amataux(1,1))
  65. aux2=float(1-2*m)/valor*sqrt(3.D0/2.D0)
  66. do i=1,3
  67. do j=1,3
  68. amat(i,j)=amat(i,j)+amataux(i,1)*amataux(j,1)*aux2
  69. enddo
  70. enddo
  71. return
  72. end
  73.  
  74.  
  75.  
  76.  

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