Télécharger famo22.eso

Retour à la liste

Numérotation des lignes :

famo22
  1. C FAMO22 SOURCE BP208322 15/06/22 21:18:09 8543
  2. SUBROUTINE FAMO22(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. * D'APRES FRIGI2 DC 98
  27. ************************************************************************
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30. *
  31. -INC PPARAM
  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. MFR =NUMMFR(MELE)
  57. MELEME=IPMAIL
  58. NBNN=NUM(/1)
  59. NBELEM=NUM(/2)
  60. *
  61. * SEGMENT D'INTEGRATION
  62. *
  63. C* SEGACT,MINTE <- ACTIF EN E/S
  64. *
  65. * INITIALISATION DES SEGMENTS DE TRAVAIL
  66. *
  67. NCXMAT=NMATT
  68. NCXCAR=NCARR
  69. NBBB=NBNN
  70. SEGINI WRK0,WRK2
  71. *
  72. * BOUCLE SUR LES ELEMENTS
  73. *
  74. DO 1000 IB=1,NBELEM
  75. *
  76. * ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  77. *
  78. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  79. *
  80. * BOUCLE SUR LES POINTS DE GAUSS
  81. *
  82. DO 1100 IGAU=1,NBPTEL
  83. *
  84. * ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  85. *
  86. YY=0.D0
  87. DO IE1=1,NBNN
  88. CGAUSS=SHPTOT(1,IE1,IGAU)
  89. YY=YY+XE(1,IE1)*CGAUSS
  90. END DO
  91. YY2=YY*YY
  92. *
  93. * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  94. *
  95. DO IE2=1,NBNN
  96. DO IE1=1,6
  97. SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  98. END DO
  99. END DO
  100. C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  101. *
  102. * ON RECUPERE LES CONSTANTES DU MATERIAU
  103. *
  104. MPTVAL=IVAMAT
  105. DO IC=1,NMATT
  106. MELVAL=IVAL(IC)
  107. IF(IC.LT.3)THEN
  108. IIC=IC
  109. ELSEIF(IC.LT.(NMATT-2))THEN
  110. IIC=IC+3
  111. ELSEIF(IC.LE.(NMATT))THEN
  112. IIC=5+IC-NMATT
  113. ELSE
  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. C+PPf
  143. C
  144. C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  145. C
  146. IF(MELE.EQ.167)THEN
  147. DJAC=XCAR(2)
  148. ELSEIF(MELE.EQ.166)THEN
  149. C+DC on utilise le cas joi3
  150. CALL JACOBI(XE,SHP,86,NBNN,DJAC)
  151. DJAC=DJAC*XCAR(2)
  152. ELSE
  153. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  154. ENDIF
  155. C+PPf
  156. *
  157. * CONTRIBUTION A CRIGI
  158. *
  159. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  160. *
  161. YOUNG=XMAT(5)
  162. GAMMA=XMAT(5)/(2.*(1.+XMAT(2)))
  163. ALPH1=XCAR(1)
  164. CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS
  165. CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS
  166. CRIGI( 3)=CRIGI( 3)+YOUNG*YY2*PGAUSS
  167. *
  168. CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
  169. *
  170. * CONTRIBUTION A CMASS
  171. *
  172. RHO=XMAT(3)
  173. C
  174. CMASS( 1)=CMASS( 1)+RHO*PGAUSS
  175. CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS
  176. CMASS( 3)=CMASS( 3)+RHO*YY2*PGAUSS
  177. *
  178. CMASS( 4)=CMASS( 4)+RHO*PGAUSS
  179. C
  180. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  181. C
  182. 1100 CONTINUE
  183. C
  184. C FIN DE LA BOUCLE SUR LES ELEMENTS
  185. C
  186. 1000 CONTINUE
  187. *
  188. C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE)
  189. SEGSUP WRK0,WRK2
  190. *
  191. RETURN
  192. END
  193.  
  194.  
  195.  
  196.  
  197.  

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