Télécharger froa2d.eso

Retour à la liste

Numérotation des lignes :

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

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