Télécharger bprima.eso

Retour à la liste

Numérotation des lignes :

  1. C BPRIMA SOURCE CHAT 05/01/12 21:42:30 5004
  2. SUBROUTINE BPRIMA(IGAU,ITEL,MFR,NBNO,LRE,IFOU,NST,NN,DIM3,
  3. 1 XEL,SHPTOT,SHP,GRAD,BPRIM,DJAC)
  4. C=======================================================================
  5. C
  6. C CALCULE LA MATRICE BPRIM
  7. C
  8. C ROUTINE FORTRAN PUR
  9. C CODE SUO X.Z JUILLET 1987
  10. C=======================================================================
  11. C INPUT
  12. C IGAU=NUMERO DU POINT DE GAUSS
  13. C ITEL=NUMERO DE L ELEMENT DANS NOMTP
  14. C MFR =NUMERO DE LA FORMULATION
  15. C NBNO=NOMBRE DE NOEUDS
  16. C LRE =NOMBRE DE COLONNES DE LA MATRICE B
  17. C IFOU=IFOUR DE CCOPTIO
  18. C NST =NOMBRE DE COMPOSANTES DE CONTRAINTES
  19. C NN =NUMERO DU MODE DE FOURIER
  20. C DIM3=EPAISSEUR (MASSIF CONTRAINTES PLANES)
  21. C XEL =COORDONNEES DE L ELEMENT
  22. C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  23. C GRAD(9)=GRADIENTS DE THETA
  24. C ZONE DE TRAVAIL
  25. C SHP(6,NBNO)=TABLEAU DE TRAVAIL
  26. C OUTPUT
  27. C DJAC=JACOBIEN
  28. C BPRIM(6,LRE)=MATRICE B
  29. C=======================================================================
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8(A-H,O-Z)
  32. DIMENSION XEL(3,*),BPRIM(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
  33. DIMENSION BB(3,9),GEOM(20),XX(3),YY(3),GRAD(*)
  34. DATA XX/.5D0,.0D0,.5D0/
  35. DATA YY/.0D0,.5D0,.5D0/
  36. C
  37. CALL ZERO(BPRIM,NST,LRE)
  38. C
  39. IFR=IFOU+4
  40. IF (ITEL.EQ.28.OR.ITEL.EQ.45) GOTO 28
  41. GOTO (666,10,10,20,30,40) ,IFR
  42. GOTO 666
  43. C
  44. C ELEMENTS MASSIFS BIDIM CONTRAINTES PLANES OU DEFRMTNS PLANES
  45. C
  46. 10 CONTINUE
  47. DO 101 NP=1,NBNO
  48. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  49. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  50. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  51. 101 CONTINUE
  52. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC)
  53. K=1
  54. DO 102 NP=1,NBNO
  55. BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)
  56. BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)
  57. BPRIM(4,K+1)=BPRIM(1,K)
  58. BPRIM(4,K )=BPRIM(2,K+1)
  59. 102 K=K+2
  60. GOTO 666
  61. C
  62. C ELEMENTS MASSIFS BIDIM AXISYMETRIQUE
  63. C
  64. 20 CONTINUE
  65. DO 201 NP=1,NBNO
  66. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  67. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  68. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  69. 201 CONTINUE
  70. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC)
  71. K=1
  72. DO 202 NP=1,NBNO
  73. BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)
  74. BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)
  75. BPRIM(3,K)=SHP(1,NP)/RR*GRAD(9)
  76. BPRIM(4,K+1)=BPRIM(1,K)
  77. BPRIM(4,K )=BPRIM(2,K+1)
  78. 202 K=K+2
  79. GOTO 666
  80. C
  81. C ELEMENTS MASSIFS BIDIM FOURIER
  82. C
  83. 30 CONTINUE
  84. DO 301 NP=1,NBNO
  85. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  86. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  87. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  88. 301 CONTINUE
  89. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC)
  90. XNSUR=DBLE(NN)/RR
  91. K=1
  92. DO 302 NP=1,NBNO
  93. BPRIM(1,K )= SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)-
  94. 1 XNSUR*SHP(1,NP)*GRAD(7)
  95. BPRIM(1,K+2)= -SHP(1,NP)*GRAD(7)/RR
  96. BPRIM(2,K+1)= SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)-
  97. 1 XNSUR*SHP(1,NP)*GRAD(8)
  98. BPRIM(3,K )= SHP(1,NP)/RR*GRAD(9)
  99. BPRIM(3,K+2)= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)+
  100. 1 XNSUR*SHP(1,NP)*GRAD(9)
  101. BPRIM(4,K )= BPRIM(2,K+1)
  102. BPRIM(4,K+1)= BPRIM(1,K )
  103. BPRIM(4,K+2)=-SHP(1,NP)*GRAD(8)/RR
  104. BPRIM(5,K )= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)-
  105. 1 XNSUR*SHP(1,NP)*GRAD(9)+SHP(1,NP)*GRAD(7)/RR
  106. BPRIM(5,K+2)= SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)+
  107. 1 XNSUR*SHP(1,NP)*GRAD(7)-SHP(1,NP)*GRAD(9)/RR
  108. BPRIM(6,K )= SHP(1,NP)*GRAD(8)/RR
  109. BPRIM(6,K+1)= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)-
  110. 1 XNSUR*SHP(1,NP)*GRAD(9)
  111. BPRIM(6,K+2)= SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)+
  112. 1 XNSUR*SHP(1,NP)*GRAD(8)
  113. 302 K=K+3
  114. GOTO 666
  115. C
  116. C ELEMENTS MASSIFS TRIDIM
  117. C
  118. 40 CONTINUE
  119. DO 401 NP=1,NBNO
  120. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  121. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  122. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  123. SHP(4,NP)=SHPTOT(4,NP,IGAU)
  124. 401 CONTINUE
  125. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,3,DIM3,RR,DJAC)
  126. K=1
  127. DO 402 NP=1,NBNO
  128. BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)+
  129. 1 SHP(4,NP)*GRAD(7)
  130. BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)+
  131. 1 SHP(4,NP)*GRAD(8)
  132. BPRIM(3,K+2)=SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)+
  133. 1 SHP(4,NP)*GRAD(9)
  134. BPRIM(4,K )=BPRIM(2,1+K)
  135. BPRIM(4,K+1)=BPRIM(1,K )
  136. BPRIM(5,K )=BPRIM(3,2+K)
  137. BPRIM(5,K+2)=BPRIM(1,K )
  138. BPRIM(6,K+1)=BPRIM(3,2+K)
  139. BPRIM(6,K+2)=BPRIM(2,1+K)
  140. 402 K=K+3
  141. GOTO 666
  142. C
  143. C 28 IEME ELEMENT : DKT ( N'EXISTER PAS )
  144. C
  145. 28 CONTINUE
  146. DO 127 NPOI=1,NBNO
  147. SHP(1,NPOI)=SHPTOT(1,NPOI,IGAU)
  148. SHP(2,NPOI)=SHPTOT(2,NPOI,IGAU)
  149. SHP(3,NPOI)=SHPTOT(3,NPOI,IGAU)
  150. 127 CONTINUE
  151. CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC)
  152. K=1
  153. DO 227 NPOI=1,NBNO
  154. BPRIM(1,K )=SHP(2,NPOI)
  155. BPRIM(1,K+1)=0.D0
  156. BPRIM(2,K )=0.D0
  157. BPRIM(2,K+1)=SHP(3,NPOI)
  158. BPRIM(3,K )=SHP(3,NPOI)
  159. BPRIM(3,K+1)=SHP(2,NPOI)
  160. 227 K=K+6
  161. CALL GEOCST(XEL,GEOM)
  162. CALL BFDKT(XX(IGAU),YY(IGAU),GEOM,BB)
  163. DJAC=GEOM(17)
  164. K=2
  165. KK=0
  166. DO 327 NPOI=1,3
  167. DO 427 IX=1,3
  168. DO 527 IY=1,3
  169. BPRIM(3+IX,K+IY)=BB(IX,IY+KK)
  170. 527 CONTINUE
  171. 427 CONTINUE
  172. KK=KK+3
  173. 327 K=K+6
  174. 666 CONTINUE
  175. RETURN
  176. END
  177.  
  178.  
  179.  
  180.  

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