Télécharger lfroa.eso

Retour à la liste

Numérotation des lignes :

  1. C LFROA SOURCE FANDEUR 11/07/19 21:16:22 7042
  2.  
  3. SUBROUTINE LFROA(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 pour les liquides de face LSE2 *
  11. C dans le cas 2D, ou de face LTR3 ou LQU4 dans le cas 3D. *
  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. -INC CCREEL
  37.  
  38. -INC SMRIGID
  39. -INC SMELEME
  40. -INC SMCOORD
  41. -INC SMCHAML
  42. -INC SMINTE
  43. C
  44. SEGMENT MPTVAL
  45. INTEGER IPOS(NS),NSOF(NS)
  46. INTEGER IVAL(NCOSOU)
  47. CHARACTER*16 TYVAL(NCOSOU)
  48. ENDSEGMENT
  49. C
  50. SEGMENT,MWORK
  51. REAL*8 XE(3,NBNN)
  52. REAL*8 REL(LRE,LRE)
  53. REAL*8 SHPWRK(6,NBNN),BGENE(NDDL,LRE)
  54. REAL*8 VALMAT(NV1)
  55. REAL*8 RCLMAT(NDDL,NDDL)
  56. ENDSEGMENT
  57. C
  58. MELEME=IPOGEO
  59. c* SEGACT MELEME
  60. NBNN=NUM(/1)
  61. NBELEM=NUM(/2)
  62. C
  63. MINTE=IPMINT
  64. c* SEGACT,MINTE
  65. NBPGAU=POIGAU(/1)
  66. C
  67. DIM3=1.D0
  68. C
  69. xMATRI=IPMATR
  70. c* SEGACT,xMATRI*MOD
  71. c* NLIGRD=LRE
  72. c* NLIGRP=LRE
  73.  
  74. NV1=5
  75. SEGINI,MWORK
  76. C
  77. C boucle sur les éléments
  78. C
  79. DO 1 IB=1,NBELEM
  80. C
  81. C on cherche les coordonnées de l'élément IB
  82. C
  83. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  84. CALL ZERO(REL,LRE,LRE)
  85. CALL ZERO(RCLMAT,NDDL,NDDL)
  86. C
  87. C boucle sur les points de Gauss
  88. C
  89. DO 10 IGAU=1,NBPGAU
  90. C
  91. C récupération de l'épaisseur
  92. C
  93. IF (IFOUR.EQ.-2) THEN
  94. IF (IVACAR.NE.0) THEN
  95. MPTVAL=IVACAR
  96. MELVAL=IVAL(1)
  97. IF (MELVAL.NE.0) THEN
  98. IGMN=MIN(IGAU,VELCHE(/1))
  99. IBMN=MIN(IB,VELCHE(/2))
  100. DIM3=VELCHE(IGMN,IBMN)
  101. ELSE
  102. DIM3=1.D0
  103. ENDIF
  104. ENDIF
  105. ENDIF
  106. C
  107. C récupération des données matériau
  108. C
  109. MPTVAL=IVAMAT
  110. DO 11 J=1,5
  111. MELVAL=IVAL(J)
  112. IGMN=MIN(IGAU,VELCHE(/1))
  113. IBMN=MIN(IB,VELCHE(/2))
  114. VALMAT(J)=VELCHE(IGMN,IBMN)
  115. 11 CONTINUE
  116. C
  117. RHO=VALMAT(1)
  118. CSON=VALMAT(2)
  119. ROREF=VALMAT(3)
  120. CREF=VALMAT(4)
  121. RLCAR=VALMAT(5)
  122. C
  123. C coefficient d'amortissement normalisé
  124. C
  125. RCL=(1.D0/CSON/rho)*ROREF*RLCAR*roref*cref**2/rlcar
  126. C
  127. C matrice RCLMAT
  128. C
  129. RCLMAT(1,1)=RCL
  130. RCLMAT(2,2)=RCL
  131. C
  132. C calcul de la matrice N des fonctions de forme
  133. C
  134. XDPGE=0.D0
  135. YDPGE=0.D0
  136. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
  137. 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  138. C
  139. C mise à zéro des composantes sur p
  140. C
  141. DO 21 J=1,LRE
  142. BGENE(2,J)=0.D0
  143. 21 CONTINUE
  144. C
  145. C calcul du jacobien
  146. C
  147. IF (IDIM.EQ.3) THEN
  148. DXDQSI=0.D0
  149. DYDQSI=0.D0
  150. DZDQSI=0.D0
  151. DXDETA=0.D0
  152. DYDETA=0.D0
  153. DZDETA=0.D0
  154. DO 40 I=1,NBNN
  155. DXDQSI=DXDQSI+SHPTOT(2,I,IGAU)*XE(1,I)
  156. DYDQSI=DYDQSI+SHPTOT(2,I,IGAU)*XE(2,I)
  157. DXDETA=DXDETA+SHPTOT(3,I,IGAU)*XE(1,I)
  158. DYDETA=DYDETA+SHPTOT(3,I,IGAU)*XE(2,I)
  159. DZDQSI=DZDQSI+SHPTOT(2,I,IGAU)*XE(3,I)
  160. DZDETA=DZDETA+SHPTOT(3,I,IGAU)*XE(3,I)
  161. 40 CONTINUE
  162. DJAC=SQRT((DYDQSI*DZDETA-DYDETA*DZDQSI)**2+
  163. 1 (DXDETA*DZDQSI-DXDQSI*DZDETA)**2+
  164. 2 (DXDQSI*DYDETA-DXDETA*DYDQSI)**2)
  165. ELSE
  166. c* ELSE IF(IDIM.EQ.2) THEN
  167. DXDQSI=0.D0
  168. DYDQSI=0.D0
  169. DO I=1,NBNN
  170. DXDQSI=DXDQSI+SHPTOT(2,I,IGAU)*XE(1,I)
  171. DYDQSI=DYDQSI+SHPTOT(2,I,IGAU)*XE(2,I)
  172. ENDDO
  173. DJAC=SQRT(DXDQSI**2+DYDQSI**2)
  174. ENDIF
  175. C
  176. C calcul de l'élément de volume
  177. C
  178. IF (IFOUR.LT.0.OR.IFOUR.EQ.2) THEN
  179. R=1.D0
  180. IF (IFOUR.EQ.-2) R=DIM3
  181. ELSE
  182. R=0.D0
  183. DO I=1,NBNN
  184. R=R+SHPTOT(1,I,IGAU)*XE(1,I)
  185. ENDDO
  186. IF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  187. 1 .AND.NIFOUR.EQ.0)) THEN
  188. R=2*XPI*R
  189. ELSE
  190. c* ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  191. R=XPI*R
  192. ENDIF
  193. ENDIF
  194. C
  195. C construction de la matrice d'amortissement
  196. C
  197. DJAC=DJAC*POIGAU(IGAU)*R
  198. CALL BDBST(BGENE,DJAC,RCLMAT,LRE,NDDL,REL)
  199. C
  200. 10 CONTINUE
  201. C
  202. C remplissage de XMATRI
  203. C
  204. CALL REMPMT(REL,LRE,RE(1,1,ib))
  205. *
  206. ** la matrice calculée ci dessus serait correcte si l'on avait
  207. ** une formulation uniquement en pi. Comme on retient la formulation
  208. ** en p et pi et pour ne rien ajouter sur la ligne en pi (si non on
  209. ** ne satisfait plus la relation entre p et pi) on aboutit à une matrice
  210. ** disymetrique avec des termes uniquement sur le lignes en pi et collones
  211. ** en p. D'où la matrice suivante :
  212.  
  213. do 30 i = 1, lre
  214. do 31 j = 2, lre
  215. ix = mod(j,2)
  216. if (ix.eq.0) then
  217. re(i,j,ib) = -re( i,(j-1),ib)
  218. re( i,(j-1),ib) = 0.d0
  219. endif
  220. 31 continue
  221. 30 continue
  222.  
  223. 1 CONTINUE
  224.  
  225. SEGSUP,MWORK
  226. c* SEGDES MELEME,MINTE,xMATRI
  227.  
  228. RETURN
  229. END
  230.  
  231.  
  232.  

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