Télécharger froa3d.eso

Retour à la liste

Numérotation des lignes :

  1. C FROA3D SOURCE FANDEUR 11/07/19 21:16:06 7042
  2.  
  3. SUBROUTINE FROA3D(IPOGEO,IPMATR,IPMINT,IVAMAT,
  4. 1 IVACAR,MELE,MFR,LRE,NDDL)
  5. C
  6. C***********************************************************************
  7. C *
  8. C Routine appelée par FRVISQ. *
  9. C *
  10. C Calcule l'amortissement de frontière dans le cas 3D pour les *
  11. C massifs de face FAC3, FAC4, FAC6 ou FAC8. *
  12. C *
  13. C Entrées : *
  14. C -------- *
  15. C *
  16. C IPOGEO : pointeur sur le maillage de l'enveloppe des massifs, *
  17. C type MELEME *
  18. C IPMATR : pointeur sur le segment IMATRI, chapeau des rigidités *
  19. C élémentaires *
  20. C IPMINT : pointeur sur le segment d'intégration, type MINTE *
  21. C IVAMAT : pointeur sur un segment MPTVAL de données matériau *
  22. C IVACAR : pointeur sur un segment MPTVAL de caractéristiques *
  23. C (épaisseur dans le cas contraintes planes) *
  24. C MELE : numéro de l'élément fini associé à la face du massif *
  25. C MFR : numéro de la formulation *
  26. C LRE : taille de la matrice d'amortissement à construire *
  27. C NDDL : nombre de degrés de liberté *
  28. C *
  29. C Remplit le segment XMATRI pour chaque élément de la sous-zone. *
  30. C***********************************************************************
  31. C
  32. IMPLICIT INTEGER(I-N)
  33. IMPLICIT REAL*8(A-H,O-Z)
  34. C
  35. -INC CCOPTIO
  36. C
  37. -INC SMRIGID
  38. -INC SMELEME
  39. -INC SMCOORD
  40. -INC SMCHAML
  41. -INC SMINTE
  42. C
  43. SEGMENT,MWORK
  44. REAL*8 XE(3,NBNN)
  45. REAL*8 REL(LRE,LRE)
  46. REAL*8 SHPWRK(6,NBNN),BGENE(NDDL,LRE)
  47. REAL*8 VALMAT(NV1)
  48. REAL*8 VECN(NDDL),VECT1(NDDL),VECT2(NDDL)
  49. REAL*8 XNNT(NDDL,NDDL),XTTT1(NDDL,NDDL),XTTT2(NDDL,NDDL)
  50. ENDSEGMENT
  51. C
  52. SEGMENT MPTVAL
  53. INTEGER IPOS(NS),NSOF(NS)
  54. INTEGER IVAL(NCOSOU)
  55. CHARACTER*16 TYVAL(NCOSOU)
  56. ENDSEGMENT
  57.  
  58. IF (IFOUR.NE.2) THEN
  59. CALL ERREUR(21)
  60. RETURN
  61. ENDIF
  62. C
  63. MELEME=IPOGEO
  64. c* SEGACT MELEME
  65. NBNN=NUM(/1)
  66. NBELEM=NUM(/2)
  67. C
  68. MINTE=IPMINT
  69. c* SEGACT,MINTE
  70. NBPGAU=POIGAU(/1)
  71. C
  72. xMATRI=IPMATR
  73. c* SEGACT,xMATRI*MOD
  74. c* NLIGRD=LRE
  75. c* NLIGRP=LRE
  76. c*
  77. NV1=3
  78. SEGINI,MWORK
  79. C
  80. C boucle sur les éléments
  81. C
  82. DO 1 IB=1,NBELEM
  83. C
  84. C on cherche les coordonnées de l'élément IB
  85. C
  86. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  87. CALL ZERO(REL,LRE,LRE)
  88. C
  89. C boucle sur les points de Gauss
  90. C
  91. DO 10 IGAU=1,NBPGAU
  92. C
  93. C récupération des données matériau
  94. C
  95. MPTVAL=IVAMAT
  96. DO 11 J=1,3
  97. MELVAL=IVAL(J)
  98. IGMN=MIN(IGAU,VELCHE(/1))
  99. IBMN=MIN(IB,VELCHE(/2))
  100. VALMAT(J)=VELCHE(IGMN,IBMN)
  101. 11 CONTINUE
  102. C
  103. RHO=VALMAT(1)
  104. E=VALMAT(2)
  105. XNU=VALMAT(3)
  106. CS=E/(RHO*2.*(1+XNU))
  107. CP=2*CS*(1-XNU)/(1-2*XNU)
  108. CP=SQRT(CP)
  109. CS=SQRT(CS)
  110. C
  111. C coefficients d'amortissement
  112. C
  113. RCP=RHO*CP
  114. RCS=RHO*CS
  115. C
  116. C calcul des vecteurs du plan tangent
  117. C
  118. VNQSI1=0.D0
  119. VNQSI2=0.D0
  120. VNQSI3=0.D0
  121. VNETA1=0.D0
  122. VNETA2=0.D0
  123. VNETA3=0.D0
  124. C
  125. DO 20 I=1,NBNN
  126. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  127. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  128. VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I)
  129. VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I)
  130. VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I)
  131. VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I)
  132. 20 CONTINUE
  133. C
  134. C calcul de VECN,VECT1,VECT2 et du jacobien
  135. C
  136. VECN(1)=VNQSI2*VNETA3-VNQSI3*VNETA2
  137. VECN(2)=VNQSI3*VNETA1-VNQSI1*VNETA3
  138. VECN(3)=VNQSI1*VNETA2-VNQSI2*VNETA1
  139. XNORM=VECN(1)**2+VECN(2)**2+VECN(3)**2
  140. XNORM=SQRT(XNORM)
  141. C
  142. DJAC0=XNORM*POIGAU(IGAU)
  143. C
  144. VECN(1)=VECN(1)/XNORM
  145. VECN(2)=VECN(2)/XNORM
  146. VECN(3)=VECN(3)/XNORM
  147. C
  148. XNORM1=VNQSI1**2+VNQSI2**2+VNQSI3**2
  149. XNORM1=SQRT(XNORM1)
  150. VECT1(1)=VNQSI1/XNORM1
  151. VECT1(2)=VNQSI2/XNORM1
  152. VECT1(3)=VNQSI3/XNORM1
  153. C
  154. VECT2(1)=VECT1(2)*VECN(3)-VECT1(3)*VECN(2)
  155. VECT2(2)=VECT1(3)*VECN(1)-VECT1(1)*VECN(3)
  156. VECT2(3)=VECT1(1)*VECN(2)-VECT1(2)*VECN(1)
  157. C
  158. C calcul des matrices nnT, ttT1, et ttT2
  159. C
  160. DO 30 I=1,NDDL
  161. DO 31 J=1,NDDL
  162. XNNT(I,J)=VECN(I)*VECN(J)
  163. XTTT1(I,J)=VECT1(I)*VECT1(J)
  164. XTTT2(I,J)=VECT2(I)*VECT2(J)
  165. 31 CONTINUE
  166. 30 CONTINUE
  167. C
  168. C calcul de la matrice N des fonctions de forme
  169. C
  170. XDPGE=0.D0
  171. YDPGE=0.D0
  172. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  173. & DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  174. C
  175. C construction de la matrice d'amortissement
  176. C
  177. DJACN=DJAC0*RCP
  178. CALL BDBST(BGENE,DJACN,XNNT,LRE,NDDL,REL)
  179.  
  180. DJACT=DJAC0*RCS
  181. CALL BDBST(BGENE,DJACT,XTTT1,LRE,NDDL,REL)
  182. CALL BDBST(BGENE,DJACT,XTTT2,LRE,NDDL,REL)
  183. C
  184. 10 CONTINUE
  185. C
  186. C remplissage de XMATRI
  187. C
  188. CALL REMPMT(REL,LRE,RE(1,1,ib))
  189. C
  190. 1 CONTINUE
  191. C
  192. SEGSUP,MWORK
  193.  
  194. c* SEGDES MELEME,MINTE,xMATRI
  195.  
  196. RETURN
  197. END
  198.  
  199.  
  200.  

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