Télécharger frigi2.eso

Retour à la liste

Numérotation des lignes :

  1. C FRIGI2 SOURCE BP208322 15/06/22 21:18:32 8543
  2. SUBROUTINE FRIGI2(MELE,IPMAIL,MINTE,NBPTEL,
  3. 1 IVAMAT,IVACAR,NMATT,NCARR,
  4. 2 CRIGI,CMASS)
  5. ***********************************************************************
  6. * CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  7. * CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
  8. * .... AU SIGNE PRES
  9. * BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
  10. **********************************************************************
  11. * ENTREES :
  12. *
  13. * MELE = NUMERO ELEMENT FINI
  14. * IPMAIL = POINTEUR DU MAILLAGE
  15. * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  16. * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  17. * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  18. * NVARI =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  19. * NMATT =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  20. * NCARR =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  21. *
  22. * SORTIES :
  23. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
  24. * CMASS(12) MASSE SUR LA FIBRE MOYENNE
  25. *
  26. ************************************************************************
  27. * Pierre Pegon (ISPRA) Juillet/Aout 1993
  28. ***********************************************************************
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. *
  32. -INC CCOPTIO
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMMODEL
  37. -INC SMINTE
  38. -INC CCHAMP
  39. *
  40. SEGMENT MPTVAL
  41. INTEGER IPOS(NS) ,NSOF(NS)
  42. INTEGER IVAL(NCOSOU)
  43. CHARACTER*16 TYVAL(NCOSOU)
  44. ENDSEGMENT
  45. *
  46. SEGMENT WRK0
  47. REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  48. ENDSEGMENT
  49. *
  50. SEGMENT WRK2
  51. REAL*8 XE(3,NBBB),SHP(6,NBBB)
  52. ENDSEGMENT
  53. *
  54. DIMENSION CRIGI(12),CMASS(12)
  55. *
  56. C
  57. MFR =NUMMFR(MELE)
  58. MELEME=IPMAIL
  59. NBNN=NUM(/1)
  60. NBELEM=NUM(/2)
  61. *
  62. * SEGMENT D'INTEGRATION
  63. *
  64. SEGACT,MINTE
  65. *
  66. * INITIALISATION DES SEGMENTS DE TRAVAIL
  67. *
  68. NCXMAT=NMATT
  69. NCXCAR=NCARR
  70. NBBB=NBNN
  71. SEGINI WRK0,WRK2
  72. *
  73. * BOUCLE SUR LES ELEMENTS
  74. *
  75. DO 1000 IB=1,NBELEM
  76. *
  77. * ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  78. *
  79. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  80. *
  81. * BOUCLE SUR LES POINTS DE GAUSS
  82. *
  83. DO 1100 IGAU=1,NBPTEL
  84. *
  85. * ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  86. *
  87. YY=0.D0
  88. ZZ=0.D0
  89. DO IE1=1,NBNN
  90. CGAUSS=SHPTOT(1,IE1,IGAU)
  91. YY=YY+XE(1,IE1)*CGAUSS
  92. ZZ=ZZ+XE(2,IE1)*CGAUSS
  93. END DO
  94. YY2=YY*YY
  95. ZZ2=ZZ*ZZ
  96. *
  97. * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  98. *
  99. DO IE1=1,6
  100. DO IE2=1,NBNN
  101. SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  102. END DO
  103. END DO
  104. C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  105. *
  106. * ON RECUPERE LES CONSTANTES DU MATERIAU
  107. *
  108. MPTVAL=IVAMAT
  109. DO IC=1,NMATT
  110. MELVAL=IVAL(IC)
  111. IF(IC.LT.3)THEN
  112. IIC=IC
  113. ELSEIF(IC.LT.(NMATT-2))THEN
  114. IIC=IC+3
  115. ELSEIF(IC.LE.(NMATT))THEN
  116. IIC=5+IC-NMATT
  117. ELSE
  118. ENDIF
  119. IF(MELVAL.NE.0)THEN
  120. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  121. IBMN=MIN(IB,VELCHE(/2))
  122. IGMN=MIN(IGAU,VELCHE(/1))
  123. XMAT(IIC)=VELCHE(IGMN,IBMN)
  124. ELSE
  125. IBMN=MIN(IB,IELCHE(/2))
  126. IGMN=MIN(IGAU,IELCHE(/1))
  127. XMAT(IIC)=IELCHE(IGMN,IBMN)
  128. ENDIF
  129. ELSE
  130. XMAT(IIC)=0.D0
  131. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  132. XMAT(IIC)=0.D0
  133. END IF
  134. ENDIF
  135. END DO
  136. *
  137. * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  138. *
  139. MPTVAL=IVACAR
  140. DO IC=1,NCARR
  141. MELVAL=IVAL(IC)
  142. IF(MELVAL.NE.0)THEN
  143. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  144. IBMN=MIN(IB,VELCHE(/2))
  145. IGMN=MIN(IGAU,VELCHE(/1))
  146. XCAR(IC)=VELCHE(IGMN,IBMN)
  147. ELSE
  148. IBMN=MIN(IB,IELCHE(/2))
  149. IGMN=MIN(IGAU,IELCHE(/1))
  150. XCAR(IC)=IELCHE(IGMN,IBMN)
  151. ENDIF
  152. ELSE
  153. XCAR(IC)=0.D0
  154. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  155. XCAR(IC)=0.D0
  156. END IF
  157. ENDIF
  158. *
  159. END DO
  160. C+PPf
  161. C
  162. C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  163. C
  164. IF(MELE.EQ.167)THEN
  165. DJAC=XCAR(3)
  166. ELSEIF(MELE.EQ.166)THEN
  167. C+DC on utilise le cas joi3
  168. CALL JACOBI(XE,SHP,86,NBNN,DJAC)
  169. DJAC= DJAC*XCAR(3)
  170. ELSE
  171. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  172. ENDIF
  173.  
  174. C+PPf
  175. *
  176. * CONTRIBUTION A CRIGI
  177. *
  178. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  179. *
  180. YOUNG=XMAT(1)
  181. GAMMA=XMAT(1)/2.D0/(1.D0+XMAT(2))
  182. ALPH1=XCAR(1)
  183. ALPH2=XCAR(2)
  184. CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS
  185. CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS
  186. CRIGI( 3)=CRIGI( 3)+YOUNG*ZZ*PGAUSS
  187. CRIGI( 4)=CRIGI( 4)+YOUNG*YY2*PGAUSS
  188. CRIGI( 5)=CRIGI( 5)+YOUNG*YY*ZZ*PGAUSS
  189. CRIGI( 6)=CRIGI( 6)+YOUNG*ZZ2*PGAUSS
  190. *
  191. CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS
  192. CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS
  193. CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS
  194. CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS
  195. CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS
  196. CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS
  197. *
  198. * CONTRIBUTION A CMASS
  199. *
  200. *
  201. RHO=XMAT(3)
  202. C
  203. C
  204. C RHO=XMAT(NMATT)
  205. C
  206. CMASS( 1)=CMASS( 1)+RHO*PGAUSS
  207. CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS
  208. CMASS( 3)=CMASS( 3)+RHO*ZZ*PGAUSS
  209. CMASS( 4)=CMASS( 4)+RHO*YY2*PGAUSS
  210. CMASS( 5)=CMASS( 5)+RHO*YY*ZZ*PGAUSS
  211. CMASS( 6)=CMASS( 6)+RHO*ZZ2*PGAUSS
  212. *
  213. CMASS( 7)=CMASS( 7)+RHO*PGAUSS
  214. CMASS( 8)=CMASS( 8)+RHO*PGAUSS
  215. CMASS( 9)=CMASS( 9)+RHO*YY*PGAUSS
  216. CMASS(10)=CMASS(10)+RHO*ZZ*PGAUSS
  217. CMASS(11)=CMASS(11)+RHO*YY2*PGAUSS
  218. CMASS(12)=CMASS(12)+RHO*ZZ2*PGAUSS
  219. C
  220. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  221. C
  222. 1100 CONTINUE
  223. C
  224. C FIN DE LA BOUCLE SUR LES ELEMENTS
  225. C
  226. 1000 CONTINUE
  227. *
  228. SEGDES,MINTE
  229. SEGSUP WRK0,WRK2
  230. *
  231. RETURN
  232. END
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  

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