Télécharger frith2.eso

Retour à la liste

Numérotation des lignes :

  1. C FRITH2 SOURCE BP208322 15/06/22 21:18:39 8543
  2. C FRIGTH2 SOURCE DJER 94/02/25 21:57:00 1061
  3. SUBROUTINE FRITH2(MELE,IPMAIL,MINTE,NBPTEL,
  4. 1 IVAMAT,IVACAR,NMATT,NCARR,CRIGI,IELA,ICONT)
  5. ***********************************************************************
  6. * CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  7. * BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
  8. **********************************************************************
  9. * ENTREES :
  10. *
  11. * MELE = NUMERO ELEMENT FINI
  12. * IPMAIL = POINTEUR DU MAILLAGE (ACTIF)
  13. * MINTE = POINTEUR CARACTERISTIQUES INTEGRATION (ACTIF)
  14. * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  15. * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  16. * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  17. * NVARI =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  18. * NMATT =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  19. * NCARR =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  20. *
  21. * SORTIES :
  22. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE ( SOMi (HOOKi * ALPHAi) )
  23. *
  24. ************************************************************************
  25. * Pierre Pegon (ISPRA) Juillet/Aout 1993
  26. ***********************************************************************
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8(A-H,O-Z)
  29. *
  30. -INC CCOPTIO
  31. -INC SMCHAML
  32. -INC SMELEME
  33. -INC SMCOORD
  34. -INC SMMODEL
  35. -INC SMINTE
  36. -INC CCHAMP
  37. *
  38. SEGMENT MPTVAL
  39. INTEGER IPOS(NS) ,NSOF(NS)
  40. INTEGER IVAL(NCOSOU)
  41. CHARACTER*16 TYVAL(NCOSOU)
  42. ENDSEGMENT
  43. *
  44. SEGMENT WRK0
  45. REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  46. ENDSEGMENT
  47. *
  48. SEGMENT WRK2
  49. REAL*8 XE(3,NBBB),SHP(6,NBBB)
  50. ENDSEGMENT
  51. *
  52. DIMENSION CRIGI(12)
  53. *
  54. MFR =NUMMFR(MELE)
  55. MELEME=IPMAIL
  56. NBNN=NUM(/1)
  57. NBELEM=NUM(/2)
  58. *
  59. * SEGMENT D'INTEGRATION
  60. *
  61. C** SEGACT,MINTE <- ACTIF EN E/S
  62. *
  63. * INITIALISATION DES SEGMENTS DE TRAVAIL
  64. *
  65. NCXMAT=NMATT
  66. NCXCAR=NCARR
  67. NBBB=NBNN
  68. SEGINI WRK0,WRK2
  69. *
  70. * BOUCLE SUR LES ELEMENTS
  71. *
  72. DO 1000 IB=1,NBELEM
  73. *
  74. * ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  75. *
  76. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  77. *
  78. * BOUCLE SUR LES POINTS DE GAUSS
  79. *
  80. DO 1100 IGAU=1,NBPTEL
  81. *
  82. * ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  83. *
  84. YY=0.D0
  85. ZZ=0.D0
  86. DO IE1=1,NBNN
  87. CGAUSS=SHPTOT(1,IE1,IGAU)
  88. YY=YY+XE(1,IE1)*CGAUSS
  89. ZZ=ZZ+XE(2,IE1)*CGAUSS
  90. END DO
  91. YY2=YY*YY
  92. ZZ2=ZZ*ZZ
  93. *
  94. * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  95. *
  96. DO IE2=1,NBNN
  97. DO IE1=1,6
  98. SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  99. END DO
  100. END DO
  101. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  102. *
  103. * ON RECUPERE LES CONSTANTES DU MATERIAU
  104. *
  105. MPTVAL=IVAMAT
  106. DO IC=1,NMATT
  107. MELVAL=IVAL(IC)
  108. IF(IC.LT.3)THEN
  109. IIC=IC
  110. ELSEIF(IC.LT.(NMATT-1))THEN
  111. IIC=IC+2
  112. ELSE
  113. IIC=4+IC-NMATT
  114. ENDIF
  115. IF(MELVAL.NE.0)THEN
  116. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  117. IBMN=MIN(IB,VELCHE(/2))
  118. IGMN=MIN(IGAU,VELCHE(/1))
  119. XMAT(IIC)=VELCHE(IGMN,IBMN)
  120. ELSE
  121. IBMN=MIN(IB,IELCHE(/2))
  122. IGMN=MIN(IGAU,IELCHE(/1))
  123. XMAT(IIC)=IELCHE(IGMN,IBMN)
  124. ENDIF
  125. ELSE
  126. XMAT(IIC)=0.D0
  127. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  128. XMAT(IIC)=0
  129. END IF
  130. ENDIF
  131. END DO
  132. *
  133. * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  134. *
  135. MPTVAL=IVACAR
  136. DO IC=1,NCARR
  137. MELVAL=IVAL(IC)
  138. IBMN=MIN(IB,VELCHE(/2))
  139. IGMN=MIN(IGAU,VELCHE(/1))
  140. XCAR(IC)=VELCHE(IGMN,IBMN)
  141. END DO
  142. *
  143. * CONTRIBUTION A CRIGI
  144. *
  145. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  146. *
  147. IF(ICONT.EQ.0) THEN
  148. YOUNG=1.D0
  149. XNU =1.D0
  150. ELSE
  151. YOUNG=XMAT(1)
  152. XNU =XMAT(2)
  153. ENDIF
  154. ALPHA=XMAT(4)
  155. IF(IELA.EQ.1) ALPHA=1.D0
  156. GAMMA=YOUNG/(2.D0*(1.+XNU))
  157. ALPH1=XCAR(1)
  158. ALPH2=XCAR(2)
  159. CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS*ALPHA
  160. CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS*ALPHA
  161. CRIGI( 3)=CRIGI( 3)+YOUNG*ZZ*PGAUSS*ALPHA
  162. CRIGI( 4)=CRIGI( 4)+YOUNG*YY2*PGAUSS*ALPHA
  163. CRIGI( 5)=CRIGI( 5)+YOUNG*YY*ZZ*PGAUSS*ALPHA
  164. CRIGI( 6)=CRIGI( 6)+YOUNG*ZZ2*PGAUSS*ALPHA
  165. *
  166. CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS*ALPHA
  167. CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS*ALPHA
  168. CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS*ALPHA
  169. CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS*ALPHA
  170. CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS*ALPHA
  171. CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS*ALPHA
  172. C
  173. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  174. C
  175. 1100 CONTINUE
  176. C
  177. C FIN DE LA BOUCLE SUR LES ELEMENTS
  178. C
  179. 1000 CONTINUE
  180. *
  181. C** SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE)
  182. SEGSUP WRK0,WRK2
  183. *
  184. RETURN
  185. END
  186.  
  187.  
  188.  
  189.  
  190.  

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