Télécharger fri2t2.eso

Retour à la liste

Numérotation des lignes :

  1. C FRI2T2 SOURCE BP208322 15/06/22 21:18:30 8543
  2. C FRIGT2 SOURCE DC 98/01/27 21:16:32 3070
  3. SUBROUTINE FRI2T2(INFIBR,MELE,IPMAIL,MINTE,NBPTEL,
  4. 1 IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVARI,
  5. 2 CRIGI)
  6. ***********************************************************************
  7. * COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE
  8. * BOUCLE SUR LES SS_ZONE DU MODELE DE SECTION
  9. ***********************************************************************
  10. * ENTREES :
  11. *
  12. * INFIBR = NUMERO DE MATERIAU INELASTIQUE
  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. * IVARI =POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES
  19. * NMATT =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
  20. * NCARR =NOMBRE DE COMPOSANTES DE CARACTERISTIQUES GEOMETRIQUES
  21. * NVARI =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  22. *
  23. * SORTIES :
  24. * CRIGI(12) RIGIDITE 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),XVAR(NCXVAR)
  48. ENDSEGMENT
  49. *
  50. SEGMENT WRK2
  51. REAL*8 XE(3,NBBB),SHP(6,NBBB)
  52. ENDSEGMENT
  53. *
  54. DIMENSION CRIGI(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. NCXVAR=NVARI
  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. DO IE1=1,NBNN
  89. CGAUSS=SHPTOT(1,IE1,IGAU)
  90. YY=YY+XE(1,IE1)*CGAUSS
  91. END DO
  92. YY2=YY*YY
  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. C PPf 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. * ON RECUPERE LES VARIABLES INTERNES
  144. *
  145. MPTVAL=IVARI
  146. DO IC=1,NVARI
  147. MELVAL=IVAL(IC)
  148. IBMN=MIN(IB,VELCHE(/2))
  149. IGMN=MIN(IGAU,VELCHE(/1))
  150. XVAR(IC)=VELCHE(IGMN,IBMN)
  151. END DO
  152. *
  153. * YOUNG TANGENT SELON LES MODELES
  154. *
  155. IF(INFIBR.EQ.0)THEN
  156. C
  157. C MODELE ELASTIQUE LINEAIRE (EXEMPLE)
  158. C
  159. YOUNGT=XMAT(1)
  160. C
  161. ELSEIF(INFIBR.EQ.1)THEN
  162. C
  163. C MODELE BETON_UNI
  164. C
  165. C PP YOUNGT=XVAR(6)
  166. YOUNGT=XVAR(5)
  167. C
  168. ELSEIF(INFIBR.EQ.2)THEN
  169. C
  170. C MODELE ACIER_UNI
  171. C
  172. YOUNGT=XVAR(4)
  173. C
  174. ELSEIF(INFIBR.EQ.3)THEN
  175. C
  176. C MODELE MAZARS_FIB
  177. C
  178. YOUNGT=(1.-XVAR(2))*XMAT(1)
  179. C
  180. ELSEIF(INFIBR.EQ.4)THEN
  181. C
  182. C MODELE FRAGILE_UNI
  183. C
  184. YOUNGT=XVAR(4)
  185. C
  186. ELSEIF(INFIBR.EQ.5)THEN
  187. C
  188. C MODELE BETON_BAEL
  189. C
  190. YOUNGT=XVAR(3)
  191. C
  192. ELSEIF(INFIBR.EQ.6)THEN
  193. C
  194. C MODELE PARFAIT_UNI
  195. C
  196. YOUNGT=XVAR(2)
  197. C
  198. ELSEIF(INFIBR.EQ.7)THEN
  199. C
  200. C MODELE STRUT_UNI
  201. C
  202. YOUNGT=XVAR(6)
  203. C
  204. ELSEIF(INFIBR.EQ.8)THEN
  205. C
  206. C MODELE CISAIL_NL
  207. C
  208. YOUNGT=XMAT(1)
  209. C
  210. ELSEIF(INFIBR.EQ.9)THEN
  211. C
  212. C MODELE 'PARFAIT_ANCRAGE'
  213. C
  214. YOUNGT=XVAR(6)
  215. C
  216. ELSEIF(INFIBR.EQ.10)THEN
  217. C
  218. C MODELE 'ACIER_ANCRAGE'
  219. C
  220. YOUNGT=XVAR(16)
  221. C
  222. ELSEIF(INFIBR.EQ.11)THEN
  223. C
  224. C MODELE UNILATERAL
  225. C
  226. YOUNGT=XVAR(1)
  227. C
  228. ENDIF
  229. C+PPf
  230. C
  231. C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  232. C
  233. IF(MELE.EQ.167)THEN
  234. DJAC=XCAR(NCARR)
  235. ELSEIF(MELE.EQ.166)THEN
  236. CALL JACOBI(XE,SHP,1,NBNN,DJAC)
  237. DJAC=DJAC*XCAR(NCARR)
  238. ELSE
  239. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  240. ENDIF
  241. C+PPf
  242. *
  243. * CONTRIBUTION A CRIGI
  244. *
  245. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  246. *
  247. YOUNG=XMAT(1)
  248. GAMMA=XMAT(1)/(2.*(1.+XMAT(2)))
  249. ALPH1=XCAR(1)
  250. CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS
  251. CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS
  252. CRIGI( 3)=CRIGI( 3)+YOUNGT*YY2*PGAUSS
  253. *
  254. CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
  255. C
  256. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  257. C
  258. 1100 CONTINUE
  259. C
  260. C FIN DE LA BOUCLE SUR LES ELEMENTS
  261. C
  262. 1000 CONTINUE
  263. *
  264. C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE)
  265. SEGSUP WRK0,WRK2
  266. *
  267. RETURN
  268. END
  269.  
  270.  
  271.  
  272.  
  273.  

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