Télécharger frigi2.eso

Retour à la liste

Numérotation des lignes :

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

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