Télécharger bb403.eso

Retour à la liste

Numérotation des lignes :

  1. C BB403 SOURCE CHAT 05/01/12 21:35:58 5004
  2. SUBROUTINE BB403(X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C CALCULE LES FONCTIONS DE FORME D'UN : TET5 (TET4 + Bulle)
  8. C
  9. C***********************************************************************
  10. REAL*8 X(NPG),Y(NPG),Z(NPG)
  11. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  12. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  13. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  14. CO=6.D0 ** (1.D0/3.D0)
  15. ALFA=(4.D0/CO)**4.D0
  16. C
  17. IF(NPG.EQ.1)THEN
  18. XXXX=0.25D0*CO
  19. C
  20. X(1)=XXXX
  21. Y(1)=XXXX
  22. Z(1)=XXXX
  23. PG(1)=1.D0
  24. ENDIF
  25. IF(NPG.EQ.4)THEN
  26. AL=.5854101966249684D0*CO
  27. BE=.1381966011250105D0*CO
  28. C
  29. X(1)=BE
  30. Y(1)=BE
  31. Z(1)=BE
  32. PG(1)=0.25D0
  33. C
  34. X(2)=AL
  35. Y(2)=BE
  36. Z(2)=BE
  37. PG(2)=0.25D0
  38. C
  39. X(3)=BE
  40. Y(3)=AL
  41. Z(3)=BE
  42. PG(3)=0.25D0
  43. C
  44. X(4)=BE
  45. Y(4)=BE
  46. Z(4)=AL
  47. PG(4)=0.25D0
  48. C
  49. ENDIF
  50. C
  51. UNSCO=1.D0/CO
  52. XXXX=-CO
  53. DO 1 L=1,NPG
  54. BB=(CO-X(L)-Y(L)-Z(L))*X(L)*Y(L)*Z(L)*ALFA
  55. BX=ALFA*(Y(L)*Z(L)*(CO-X(L)-Y(L)-Z(L))-(X(L)*Y(L)*Z(L)))
  56. BY=ALFA*(X(L)*Z(L)*(CO-X(L)-Y(L)-Z(L))-(X(L)*Y(L)*Z(L)))
  57. BZ=ALFA*(X(L)*Y(L)*(CO-X(L)-Y(L)-Z(L))-(X(L)*Y(L)*Z(L)))
  58. C
  59. FM(1,L)=1.D0-(X(L)+Y(L)+Z(L))*UNSCO
  60. FM(2,L)=X(L)*UNSCO
  61. FM(3,L)=Y(L)*UNSCO
  62. FM(4,L)=Z(L)*UNSCO
  63. C
  64. FN(1,L)=FM(1,L)*(1.D0-BB)
  65. FN(2,L)=FM(2,L)*(1.D0-BB)
  66. FN(3,L)=FM(3,L)*(1.D0-BB)
  67. FN(4,L)=FM(4,L)*(1.D0-BB)
  68. FN(5,L)=BB
  69. C
  70. GR(1,1,L)=-UNSCO*(1.D0-BB)-BX*FM(1,L)
  71. GR(2,1,L)=-UNSCO*(1.D0-BB)-BY*FM(1,L)
  72. GR(3,1,L)=-UNSCO*(1.D0-BB)-BZ*FM(1,L)
  73. C
  74. GR(1,2,L)=UNSCO*(1.D0-BB)-BX*FM(2,L)
  75. GR(2,2,L)=-BY*FM(2,L)
  76. GR(3,2,L)=-BZ*FM(2,L)
  77. C
  78. GR(1,3,L)=-BX*FM(3,L)
  79. GR(2,3,L)=UNSCO*(1.D0-BB)-BY*FM(3,L)
  80. GR(3,3,L)=-BZ*FM(3,L)
  81. C
  82. GR(1,4,L)=-BX*FM(4,L)
  83. GR(2,4,L)=-BY*FM(4,L)
  84. GR(3,4,L)=UNSCO*(1.D0-BB)-BZ*FM(4,L)
  85. C
  86. GR(1,5,L)=BX
  87. GR(2,5,L)=BY
  88. GR(3,5,L)=BZ
  89. C
  90. GM(1,1,L)=-UNSCO
  91. GM(2,1,L)=-UNSCO
  92. GM(3,1,L)=-UNSCO
  93. C
  94. GM(1,2,L)=UNSCO
  95. GM(2,2,L)=0.D0
  96. GM(3,2,L)=0.D0
  97. C
  98. GM(1,3,L)=0.D0
  99. GM(2,3,L)=UNSCO
  100. GM(3,3,L)=0.D0
  101. C
  102. GM(1,4,L)=0.D0
  103. GM(2,4,L)=0.D0
  104. GM(3,4,L)=UNSCO
  105. C
  106.  
  107. 1 CONTINUE
  108.  
  109. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  110. C WRITE(6,100)
  111. C WRITE(6,101)
  112. C WRITE(6,1002)FN
  113. C WRITE(6,1002)GR
  114. C WRITE(6,101)
  115. RETURN
  116. 1002 FORMAT(10(1X,1PD11.4))
  117. 1001 FORMAT(20(1X,I5))
  118. 100 FORMAT(1H1)
  119. 101 FORMAT(1X,'... SUB PB403 ... FN,GR,FOM,GM ',9(10H..........)/)
  120. END
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  

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