Télécharger dezoma.eso

Retour à la liste

Numérotation des lignes :

  1. C DEZOMA SOURCE CHAT 05/01/12 22:47:58 5004
  2. CCC
  3. C **********************************************************************
  4. CCC
  5. SUBROUTINE DETERZONAMAC(SIGTRI,NDIMS,VARINT,IPLCON,IPLCAP,IPLAPEX,
  6. . nescri,ues)
  7. IMPLICIT INTEGER(I-N)
  8. integer ndims,iplcon,iplcap,iplapex,nescri,ues
  9. real*8 sigtri(ndims),varint(2),siginvari(3),Eauxp,Eauxq,
  10. . Yicon,Yicap,p,q,t,xco,xca,psepara,aux3,qcor,Nr_qfunc,
  11. . vecp,vecq,pcap,prodesc,wwfunc,etaconfunc,pcapfunc
  12. real*8 exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
  13. . exl,xnn,aaa,bbb,pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,
  14. . exm2,eww2,cpr,cpm,cfr,you,xnu
  15. common /elasdata/ you,xnu
  16. common /MRScone/ exm,qaa,pcc,eww,xk1,xk2,etb,exv,xep,paa,cco,
  17. . exl,xnn,aaa,bbb
  18. common /MRScapp/ pc0,exr,cca,phi,alp,pcc2,paa2,qaa2,exm2,eww2,
  19. . cpr,cpm,cfr
  20. iplcon =0
  21. iplcap =0
  22. iplapex=0
  23. do i=1,3
  24. siginvari(i)=0.D0
  25. enddo
  26. call InvariantesPQT(sigtri,ndims,siginvari)
  27. p=siginvari(1)
  28. q=siginvari(2)
  29. t=siginvari(3)
  30. xco=varint(1)
  31. xca=varint(2)
  32. Eauxp=you/(1.D0-2.d0*xnu)/9.D0
  33. Eauxq=you/(1.d0+xnu)/2.D0
  34. call yieldcoMAC(siginvari,xco,Yicon)
  35. call yieldcaMAC(siginvari,xca,xco,Yicap)
  36. pcap=pcapfunc(xca)
  37. psepara=alp*pcap
  38. aux3=etaconfunc(xco)*(psepara-pcc)/wwfunc(t,eww)
  39. qcor=NR_qfunc(aux3,qaa,exm,aux3,1.D-10)
  40. if(nescri.eq.1) then
  41. write(ues,999) ' Invari : ',p,q,t
  42. write(ues,999) ' Var int: ',xco,xca
  43. write(ues,999) ' Yicon : ',yicon
  44. write(ues,999) ' Yicap : ',yicap
  45. write(ues,999) ' Sep.p_q: ',psepara,qcor
  46. 999 format(a12,3(E15.9,1x))
  47. endif
  48. c zona del cone
  49. If (p.le.psepara) then
  50. If (Yicon.le.0.D0) return
  51. iplcon=1
  52. c mirar si es apex
  53. vecp=-xnn*etaconfunc(xco)*(pcc-alp*pcap)/(pcc+alp*pcap)
  54. vecq=wwfunc(t,eww)*Eauxq/Eauxp
  55. prodesc=((p-pcc)*(-vecq)+q*(vecp))
  56. if (nescri.eq.1) then
  57. write(ues,999)' CONE GrApex: ', vecp,vecq,xnn
  58. write(ues,999)' PtApex: ', pcc,0.D0
  59. write(ues,999)' Prodes: ', prodesc
  60. endif
  61. if (prodesc.gt.0.D0) then
  62. iplapex=1
  63. return
  64. endif
  65. c zona del cap
  66. else
  67. If (Yicap.le.0.D0) return
  68. iplcap=1
  69. endif
  70. return
  71. end
  72.  
  73.  
  74.  
  75.  

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