Télécharger heflp2.eso

Retour à la liste

Numérotation des lignes :

  1. C HEFLP2 SOURCE CB215821 16/04/21 21:17:02 8920
  2.  
  3.  
  4. SUBROUTINE HESSFLPOWDER2 (SIG,VAR,AMAT,NDIMA)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. integer ndima,i,j
  8. real*8 sig(3),var,amat(ndima,ndima),daux1,
  9. . aux3,aux4
  10. real*8 vecm(3),aux1,aux2,xj2,xi1,x22(6,6),x33(6,6)
  11. real*8 nn1,nn2,eta0,aa1,aa2,bb1,bb2,
  12. . pia,pib,sigy0,pcc,rrr
  13. common /poder2_data/ nn1,nn2,eta0,aa1,aa2,bb1,bb2,
  14. . pia,pib,sigy0,pcc,rrr
  15. call DDINIJ(sig,x22,x33,3)
  16. call Invari_I1(sig,3,xi1)
  17. if (xi1.lt.pia) then
  18. do i=1,3
  19. do j=1,3
  20. amat(i,j)=x22(i,j)+2.D0/rrr**2
  21. enddo
  22. enddo
  23. else
  24. aux1 = (pia-xi1)/(pia-pcc)
  25. daux1 = -1.D0/(pia-pcc)
  26. if (aux1.gt.1.D0) then
  27. aux1 =1.D0
  28. daux1=0.D0
  29. endif
  30. aux2 = bb1/3.D0
  31. call Invari_J2(sig,3,xj2)
  32. call desviador(sig,vecm,3)
  33. aux3 = 1.D0 / SQRT(2.D0*xj2)
  34. aux4 = -1.D0 / SQRT((2.D0*xj2)**3)
  35. aux5 = xj2/(aa2*sigy0**2/3.D0)
  36. daux5 = 1.D0/(aa2*sigy0**2/3.D0)
  37. if (aux5.gt.1.D0) then
  38. aux5=1.D0
  39. daux5 = 0.D0
  40. endif
  41. ****** D-P Meschke examples
  42. * aux5= 1.D0
  43. * daux5=0.D0
  44. * aux1 =1.D0
  45. * daux1=0.D0
  46. ****** D-P Meschke examples
  47. do i=1,3
  48. do j=1,3
  49. amat(i,j)=aux5*(aux3*x22(i,j)+aux4*vecm(i)*vecm(j))+
  50. . daux5*(aux3*vecm(i)*vecm(j))+
  51. . aux2*daux1
  52. enddo
  53. enddo
  54. endif
  55. return
  56. end
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  

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