Télécharger pb403.eso

Retour à la liste

Numérotation des lignes :

  1. C PB403 SOURCE MAGN 10/05/19 21:15:07 6676
  2. SUBROUTINE PB403(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2)
  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 : TET4
  8. C
  9. C***********************************************************************
  10. CHARACTER*4 NOM2
  11. REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
  12. DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
  13. DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
  14. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  15. CO=6.D0 ** (1.D0/3.D0)
  16. UNSCO=1.D0/CO
  17. XXXX=-1.D0*UNSCO
  18. C
  19. XREF(1,1)=0.D0
  20. XREF(2,1)=0.D0
  21. XREF(3,1)=0.D0
  22.  
  23. XREF(1,2)=CO
  24. XREF(2,2)=0.D0
  25. XREF(3,2)=0.D0
  26.  
  27. XREF(1,3)=0.D0
  28. XREF(2,3)=CO
  29. XREF(3,3)=0.D0
  30.  
  31. XREF(1,4)=0.D0
  32. XREF(2,4)=0.D0
  33. XREF(3,4)=CO
  34. C
  35.  
  36. C Verification des coordonnées
  37. C IF(.TRUE.)THEN
  38. IF(.FALSE.)THEN
  39. DO 11 L=1,NP
  40. X(L)=XREF(1,L)
  41. Y(L)=XREF(2,L)
  42. Z(L)=XREF(3,L)
  43. 11 CONTINUE
  44.  
  45. DO 12 L=1,NP
  46. C
  47. FN(1,L)=1.D0-(X(L)+Y(L)+Z(L))*UNSCO
  48. FN(2,L)=X(L)*UNSCO
  49. FN(3,L)=Y(L)*UNSCO
  50. FN(4,L)=Z(L)*UNSCO
  51. C
  52. write(6,1033)L,FN(1,L),FN(2,L),FN(3,L),FN(4,L)
  53. 12 CONTINUE
  54. 1033 FORMAT(1X,I4,' FN',10(1X,1PD11.4))
  55. ENDIF
  56. C Fin Vérification
  57.  
  58. IF(NPG.EQ.1)THEN
  59. XXXX=0.25D0*CO
  60. C
  61. X(1)=XXXX
  62. Y(1)=XXXX
  63. Z(1)=XXXX
  64. PG(1)=1.D0
  65. ENDIF
  66. IF(NPG.EQ.4)THEN
  67. AL=.5854101966249684D0*CO
  68. BE=.1381966011250105D0*CO
  69. C
  70. X(1)=BE
  71. Y(1)=BE
  72. Z(1)=BE
  73. PG(1)=0.25D0
  74. C
  75. X(2)=AL
  76. Y(2)=BE
  77. Z(2)=BE
  78. PG(2)=0.25D0
  79. C
  80. X(3)=BE
  81. Y(3)=AL
  82. Z(3)=BE
  83. PG(3)=0.25D0
  84. C
  85. X(4)=BE
  86. Y(4)=BE
  87. Z(4)=AL
  88. PG(4)=0.25D0
  89. C
  90. ENDIF
  91. C
  92. DO 1 L=1,NPG
  93. C
  94. FN(1,L)=1.D0-(X(L)+Y(L)+Z(L))*UNSCO
  95. FN(2,L)=X(L)*UNSCO
  96. FN(3,L)=Y(L)*UNSCO
  97. FN(4,L)=Z(L)*UNSCO
  98. C
  99. GR(1,1,L)=XXXX
  100. GR(2,1,L)=XXXX
  101. GR(3,1,L)=XXXX
  102. C
  103. GR(1,2,L)=UNSCO
  104. GR(2,2,L)=0.D0
  105. GR(3,2,L)=0.D0
  106. C
  107. GR(1,3,L)=0.D0
  108. GR(2,3,L)=UNSCO
  109. GR(3,3,L)=0.D0
  110. C
  111. GR(1,4,L)=0.D0
  112. GR(2,4,L)=0.D0
  113. GR(3,4,L)=UNSCO
  114. C
  115.  
  116. IF(NOM2.EQ.'P1P1')THEN
  117. FM(1,L)=FN(1,L)
  118. FM(2,L)=FN(2,L)
  119. FM(3,L)=FN(3,L)
  120. FM(4,L)=FN(4,L)
  121. C
  122. GM(1,1,L)=XXXX
  123. GM(2,1,L)=XXXX
  124. GM(3,1,L)=XXXX
  125. C
  126. GM(1,2,L)=UNSCO
  127. GM(2,2,L)=0.D0
  128. GM(3,2,L)=0.D0
  129. C
  130. GM(1,3,L)=0.D0
  131. GM(2,3,L)=UNSCO
  132. GM(3,3,L)=0.D0
  133. C
  134. GM(1,4,L)=0.D0
  135. GM(2,4,L)=0.D0
  136. GM(3,4,L)=UNSCO
  137. C
  138. ELSE
  139. FM(1,L)=1.D0
  140. GM(1,1,L)=0.D0
  141. GM(2,1,L)=0.D0
  142. GM(3,1,L)=0.D0
  143. ENDIF
  144.  
  145. 1 CONTINUE
  146.  
  147. C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  148. C WRITE(6,100)
  149. C WRITE(6,101)
  150. C WRITE(6,1002)FN
  151. C WRITE(6,1002)GR
  152. C WRITE(6,101)
  153. RETURN
  154. 1002 FORMAT(10(1X,1PD11.4))
  155. 1001 FORMAT(20(1X,I5))
  156. 100 FORMAT(1H1)
  157. 101 FORMAT(1X,'... SUB PB403 ... FN,GR,FOM,GM ',9(10H..........)/)
  158. END
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  

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