Télécharger froa2d.eso

Retour à la liste

Numérotation des lignes :

  1. C FROA2D SOURCE FANDEUR 11/07/19 21:16:05 7042
  2.  
  3. SUBROUTINE FROA2D(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 2D pour les *
  11. C massifs de face SEG2 ou SEG3. *
  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 CCREEL
  36. *-
  37. -INC CCOPTIO
  38. -INC SMRIGID
  39. -INC SMELEME
  40. -INC SMCOORD
  41. -INC SMCHAML
  42. -INC SMINTE
  43. C
  44. SEGMENT MWORK
  45. REAL*8 XE(3,NBNN)
  46. REAL*8 REL(LRE,LRE)
  47. REAL*8 SHPWRK(6,NBNN),BGENE(NDDL,LRE)
  48. REAL*8 VALMAT(NV1)
  49. REAL*8 VECN(NDDL),VECT1(NDDL),VECT2(NDDL)
  50. REAL*8 XNNT(NDDL,NDDL),XTTT1(NDDL,NDDL),XTTT2(NDDL,NDDL)
  51. ENDSEGMENT
  52. C
  53. SEGMENT MPTVAL
  54. INTEGER IPOS(NS),NSOF(NS)
  55. INTEGER IVAL(NCOSOU)
  56. CHARACTER*16 TYVAL(NCOSOU)
  57. ENDSEGMENT
  58. C
  59. MELEME=IPOGEO
  60. c* SEGACT,MELEME
  61. NBNN=NUM(/1)
  62. NBELEM=NUM(/2)
  63. *
  64. MINTE=IPMINT
  65. c* SEGACT,MINTE
  66. NBPGAU=POIGAU(/1)
  67. C
  68. NV1=3
  69. C
  70. DIM3=1.D0
  71. C
  72. xMATRI=IPMATR
  73. c* SEGACT,xMATRI*MOD
  74. c* NLIGRD=LRE
  75. c* NLIGRP=LRE
  76. *
  77. SEGINI,MWORK
  78. C
  79. C boucle sur les éléments
  80. C
  81. DO 1 IB=1,NBELEM
  82. C
  83. C on cherche les coordonnées de l'élément IB
  84. C
  85. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  86. CALL ZERO(REL,LRE,LRE)
  87. C
  88. C boucle sur les points de Gauss
  89. C
  90. DO 10 IGAU=1,NBPGAU
  91. C
  92. C récupération de l'épaisseur
  93. C
  94. IF (IFOUR.EQ.-2) THEN
  95. MPTVAL=IVACAR
  96. IF (IVACAR.NE.0) THEN
  97. MELVAL=IVAL(1)
  98. IF (MELVAL.NE.0) THEN
  99. IGMN=MIN(IGAU,VELCHE(/1))
  100. IBMN=MIN(IB,VELCHE(/2))
  101. DIM3=VELCHE(IGMN,IBMN)
  102. ELSE
  103. DIM3=1.D0
  104. ENDIF
  105. ENDIF
  106. ENDIF
  107. C
  108. C récupération des données matériau
  109. C
  110. MPTVAL=IVAMAT
  111. DO 11 J=1,3
  112. MELVAL=IVAL(J)
  113. IGMN=MIN(IGAU,VELCHE(/1))
  114. IBMN=MIN(IB,VELCHE(/2))
  115. VALMAT(J)=VELCHE(IGMN,IBMN)
  116. 11 CONTINUE
  117. C
  118. RHO=VALMAT(1)
  119. E=VALMAT(2)
  120. XNU=VALMAT(3)
  121. CS=E/(2*(1+XNU)*RHO)
  122. IF (IFOUR.EQ.-2) THEN
  123. CP=SQRT(E/(RHO*(1-XNU*XNU)))
  124. ELSE
  125. CP=SQRT(2*CS*(1-XNU)/(1-2*XNU))
  126. ENDIF
  127. CS=SQRT(CS)
  128. C
  129. C coefficients d'amortissement
  130. C
  131. RCP=RHO*CP
  132. RCS=RHO*CS
  133. C
  134. C calcul de la tangente locale normalisée
  135. C
  136. VNQSI1=0.D0
  137. VNQSI2=0.D0
  138. DO 20 I=1,NBNN
  139. VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  140. VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  141. 20 CONTINUE
  142. XNORM=SQRT(VNQSI1*VNQSI1+VNQSI2*VNQSI2)
  143. VECT1(1)=VNQSI1/XNORM
  144. VECT1(2)=VNQSI2/XNORM
  145. IF(IFOUR.EQ.1) VECT1(3)=0.D0
  146. C
  147. C calcul de la normale
  148. C
  149. VECN(1)=-VECT1(2)
  150. VECN(2)=VECT1(1)
  151. IF(IFOUR.EQ.1) VECN(3)=0.D0
  152. C
  153. C calcul des matrices nnT et ttT1
  154. C
  155. DO 30 I=1,NDDL
  156. DO 31 J=1,NDDL
  157. XNNT(I,J)=VECN(I)*VECN(J)
  158. XTTT1(I,J)=VECT1(I)*VECT1(J)
  159. 31 CONTINUE
  160. 30 CONTINUE
  161. C
  162. C calcul du deuxième vecteur tangent dans le cas du mode Fourier
  163. C et de la matrice ttT2 associee
  164. C
  165. IF (IFOUR.EQ.1) THEN
  166. VECT2(1)=0.D0
  167. VECT2(2)=0.D0
  168. VECT2(3)=1.D0
  169. DO I=1,NDDL
  170. DO J=1,NDDL
  171. XTTT2(I,J)=VECT2(I)*VECT2(J)
  172. ENDDO
  173. ENDDO
  174. ENDIF
  175. C
  176. C calcul de la matrice N des fonctions de forme
  177. C
  178. XDPGE=0.D0
  179. YDPGE=0.D0
  180. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  181. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  182. C
  183. C calcul du jacobien
  184. C
  185. DXDQSI=0.D0
  186. DYDQSI=0.D0
  187. DO 40 I=1,NBNN
  188. DXDQSI=DXDQSI+SHPTOT(2,I,IGAU)*XE(1,I)
  189. DYDQSI=DYDQSI+SHPTOT(2,I,IGAU)*XE(2,I)
  190. 40 CONTINUE
  191. DJAC=SQRT(DXDQSI*DXDQSI+DYDQSI*DYDQSI)
  192. C
  193. C calcul de l'élément de volume
  194. C
  195. IF (IFOUR.LT.0) THEN
  196. R=1.D0
  197. IF (IFOUR.EQ.-2) R=DIM3
  198. ELSE
  199. R=0.D0
  200. DO I=1,NBNN
  201. R=R+SHPTOT(1,I,IGAU)*XE(1,I)
  202. ENDDO
  203. IF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  204. & .AND.NIFOUR.EQ.0)) THEN
  205. R=2*XPI*R
  206. ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  207. R=XPI*R
  208. ENDIF
  209. ENDIF
  210. C
  211. C construction de la matrice d'amortissement
  212. C
  213. DJACN=ABS(DJAC)*RCP*POIGAU(IGAU)*R
  214. CALL BDBST(BGENE,DJACN,XNNT,LRE,NDDL,REL)
  215.  
  216. DJACT=ABS(DJAC)*RCS*POIGAU(IGAU)*R
  217. CALL BDBST(BGENE,DJACT,XTTT1,LRE,NDDL,REL)
  218. C
  219. C cas du mode Fourier
  220. C
  221. IF (IFOUR.EQ.1) THEN
  222. CALL BDBST(BGENE,DJACT,XTTT2,LRE,NDDL,REL)
  223. ENDIF
  224. C
  225. 10 CONTINUE
  226. C
  227. C remplissage de XMATRI
  228. C
  229. CALL REMPMT(REL,LRE,RE(1,1,ib))
  230. C
  231. 1 CONTINUE
  232.  
  233. SEGSUP,MWORK
  234. c* SEGDES,xMATRI,MINTE,MELEME
  235.  
  236. RETURN
  237. END
  238.  
  239.  
  240.  

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