Télécharger pb1503.eso

Retour à la liste

Numérotation des lignes :

pb1503
  1. C PB1503 SOURCE MAGN 10/05/31 21:15:12 6679
  2. SUBROUTINE PB1503(XREF,XCOPG,XPOPG,
  3. $ FFPGV,DFFPGV,
  4. $ FFPGP,DFFPGP,
  5. $ X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. C************************************************************************
  9. C
  10. C CALCULE LES FONCTIONS DE FORME D'UN : TE15
  11. C************************************************************************
  12. * Entrées
  13. INTEGER ND,NP,MP,NPG
  14. *
  15. REAL*8 XREF(ND,NP)
  16. REAL*8 XCOPG(ND,NPG)
  17. REAL*8 XPOPG(NPG)
  18. REAL*8 FFPGV(NP,NPG)
  19. REAL*8 DFFPGV(NP,ND,NPG)
  20. REAL*8 FFPGP(MP,NPG)
  21. REAL*8 DFFPGP(MP,ND,NPG)
  22. * Sorties
  23. REAL*8 X(NPG),Y(NPG),Z(NPG)
  24. REAL*8 PG(NPG)
  25. REAL*8 FN(NP,NPG),GR(ND,NP,NPG)
  26. REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
  27. * Travail
  28. INTEGER IPG,IP,ID
  29. REAL*8 UNSVOL,USVUSD
  30. C***
  31. * magn veut que les volumes de ses éléments fasse 1
  32. UNSVOL=6.D0
  33. USVUSD=UNSVOL**(1.D0/DBLE(ND))
  34. * Coordonnées des noeuds de l'élément de référence
  35. R2=SQRT(2.D0)
  36. XREF(1,1)=0.D0
  37. XREF(2,1)=0.D0
  38. XREF(3,1)=0.D0
  39.  
  40. XREF(1,2)=R2/2.D0
  41. XREF(2,2)=0.D0
  42. XREF(3,2)=0.D0
  43.  
  44. XREF(1,3)=R2
  45. XREF(2,3)=0.D0
  46. XREF(3,3)=0.D0
  47.  
  48. XREF(1,4)=R2/2.D0
  49. XREF(2,4)=R2/2.D0
  50. XREF(3,4)=0.D0
  51.  
  52. XREF(1,5)=0.D0
  53. XREF(2,5)=R2
  54. XREF(3,5)=0.D0
  55.  
  56. XREF(1,6)=0.D0
  57. XREF(2,6)=R2/2.D0
  58. XREF(3,6)=0.D0
  59.  
  60. XREF(1,7)=0.D0
  61. XREF(2,7)=0.D0
  62. XREF(3,7)=R2/2.D0
  63.  
  64. XREF(1,8)=R2/2.D0
  65. XREF(2,8)=0.D0
  66. XREF(3,8)=R2/2.D0
  67.  
  68. XREF(1,9)=0.D0
  69. XREF(2,9)=R2/2.D0
  70. XREF(3,9)=R2/2.D0
  71.  
  72. XREF(1,10)=0.D0
  73. XREF(2,10)=0.D0
  74. XREF(3,10)=R2
  75.  
  76. XREF(1,11)=R2/3.D0
  77. XREF(2,11)=R2/3.D0
  78. XREF(3,11)=0.D0
  79.  
  80. XREF(1,12)=R2/3.D0
  81. XREF(2,12)=0.D0
  82. XREF(3,12)=R2/3.D0
  83.  
  84. XREF(1,13)=R2/3.D0
  85. XREF(2,13)=R2/3.D0
  86. XREF(3,13)=R2/3.D0
  87.  
  88. XREF(1,14)=0.D0
  89. XREF(2,14)=R2/3.D0
  90. XREF(3,14)=R2/3.D0
  91.  
  92. XREF(1,15)=R2/4.D0
  93. XREF(2,15)=R2/4.D0
  94. XREF(3,15)=R2/4.D0
  95.  
  96. * Recopie des points de Gauss
  97. DO 1 IPG=1,NPG
  98. X(IPG)=XCOPG(1,IPG)*USVUSD
  99. Y(IPG)=XCOPG(2,IPG)*USVUSD
  100. Z(IPG)=XCOPG(3,IPG)*USVUSD
  101. PG(IPG)=XPOPG(IPG)*UNSVOL
  102. 1 CONTINUE
  103. * Recopie des fns. de forme vitesse
  104. DO 3 IPG=1,NPG
  105. DO 32 IP=1,NP
  106. FN(IP,IPG)=FFPGV(IP,IPG)
  107. DO 322 ID=1,ND
  108. GR(ID,IP,IPG)=DFFPGV(IP,ID,IPG)
  109. 322 CONTINUE
  110. 32 CONTINUE
  111. 3 CONTINUE
  112. * Recopie des fns. de forme pression
  113. DO 5 IPG=1,NPG
  114. DO 52 IP=1,MP
  115. FM(IP,IPG)=FFPGP(IP,IPG)
  116. DO 522 ID=1,ND
  117. GM(ID,IP,IPG)=DFFPGP(IP,ID,IPG)
  118. 522 CONTINUE
  119. 52 CONTINUE
  120. 5 CONTINUE
  121. C WRITE(6,101)
  122. C WRITE(6,1002)FM
  123. C WRITE(6,1002)GM
  124. C write(6,*)' FN'
  125. C WRITE(6,1002)FN
  126. C write(6,*)' GR'
  127. C WRITE(6,1002)GR
  128. C WRITE(6,101)
  129. RETURN
  130. 1002 FORMAT(10(1X,1PD11.4))
  131. 1001 FORMAT(20(1X,I5))
  132. 101 FORMAT(1X,'... SUBPB2103 ... FM,GM,FN,GR ',9(10H..........)/)
  133. C
  134. END
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  

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