Télécharger frig22.eso

Retour à la liste

Numérotation des lignes :

  1. C FRIG22 SOURCE BP208322 15/06/22 21:18:31 8543
  2. C FRIG22 SOURCE IANIS 97/12/03 21:18:20 2938
  3. SUBROUTINE FRIG22(MELE,IPMAIL,MINTE,NBPTEL,
  4. 1 IVAMAT,IVACAR,NMATT,NCARR,
  5. 2 CRIGI,CMASS)
  6. ***********************************************************************
  7. * CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  8. * CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
  9. * .... AU SIGNE PRES
  10. * BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
  11. **********************************************************************
  12. * ENTREES :
  13. *
  14. * MELE = NUMERO ELEMENT FINI
  15. * IPMAIL = POINTEUR DU MAILLAGE
  16. * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  17. * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  18. * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  19. * NVARI =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  20. * NMATT =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  21. * NCARR =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  22. *
  23. * SORTIES :
  24. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
  25. * CMASS(12) MASSE SUR LA FIBRE MOYENNE
  26. *
  27. * D'APRES FRIGI2 DC 98
  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. END DO
  93. YY2=YY*YY
  94. *
  95. * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  96. *
  97. DO IE1=1,6
  98. DO IE2=1,NBNN
  99. SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  100. END DO
  101. END DO
  102. C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  103. *
  104. * ON RECUPERE LES CONSTANTES DU MATERIAU
  105. *
  106. MPTVAL=IVAMAT
  107. DO IC=1,NMATT
  108. MELVAL=IVAL(IC)
  109. IF(IC.LT.3)THEN
  110. IIC=IC
  111. ELSEIF(IC.LT.(NMATT-2))THEN
  112. IIC=IC+3
  113. ELSEIF(IC.LE.(NMATT))THEN
  114. IIC=5+IC-NMATT
  115. ELSE
  116. ENDIF
  117. IF(MELVAL.NE.0)THEN
  118. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  119. IBMN=MIN(IB,VELCHE(/2))
  120. IGMN=MIN(IGAU,VELCHE(/1))
  121. XMAT(IIC)=VELCHE(IGMN,IBMN)
  122. ELSE
  123. IBMN=MIN(IB,IELCHE(/2))
  124. IGMN=MIN(IGAU,IELCHE(/1))
  125. XMAT(IIC)=IELCHE(IGMN,IBMN)
  126. ENDIF
  127. ELSE
  128. XMAT(IIC)=0.D0
  129. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  130. XMAT(IIC)=0.D0
  131. END IF
  132. ENDIF
  133. END DO
  134. *
  135. * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  136. *
  137. MPTVAL=IVACAR
  138. DO IC=1,NCARR
  139. MELVAL=IVAL(IC)
  140. IBMN=MIN(IB,VELCHE(/2))
  141. IGMN=MIN(IGAU,VELCHE(/1))
  142. XCAR(IC)=VELCHE(IGMN,IBMN)
  143. END DO
  144. C+PPf
  145. C
  146. C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  147. C
  148. IF(MELE.EQ.167)THEN
  149. DJAC=XCAR(2)
  150. ELSEIF(MELE.EQ.166)THEN
  151. C+DC on utilise le cas joi3
  152. CALL JACOBI(XE,SHP,86,NBNN,DJAC)
  153. DJAC=DJAC*XCAR(2)
  154. ELSE
  155. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  156. ENDIF
  157. C+PPf
  158. *
  159. * CONTRIBUTION A CRIGI
  160. *
  161. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  162. *
  163. YOUNG=XMAT(1)
  164. GAMMA=XMAT(1)/(2.D0*(1.D0+XMAT(2)))
  165. ALPH1=XCAR(1)
  166. CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS
  167. CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS
  168. CRIGI( 3)=CRIGI( 3)+YOUNG*YY2*PGAUSS
  169. *
  170. CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
  171. *
  172. * CONTRIBUTION A CMASS
  173. *
  174. RHO=XMAT(3)
  175. C
  176. C
  177. CMASS( 1)=CMASS( 1)+RHO*PGAUSS
  178. CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS
  179. CMASS( 3)=CMASS( 3)+RHO*YY2*PGAUSS
  180. *
  181. CMASS( 4)=CMASS( 4)+RHO*PGAUSS
  182. C
  183. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  184. C
  185. 1100 CONTINUE
  186. C
  187. C FIN DE LA BOUCLE SUR LES ELEMENTS
  188. C
  189. 1000 CONTINUE
  190. *
  191. SEGDES,MINTE
  192. SEGSUP WRK0,WRK2
  193. *
  194. RETURN
  195. END
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  

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