Télécharger frigt2.eso

Retour à la liste

Numérotation des lignes :

  1. C FRIGT2 SOURCE BP208322 15/06/22 21:18:35 8543
  2. SUBROUTINE FRIGT2(INFIBR,MELE,IPMAIL,MINTE,NBPTEL,
  3. 1 IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVARI,
  4. 2 CRIGI)
  5. ***********************************************************************
  6. * COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE
  7. * BOUCLE SUR LES SS_ZONE DU MODELE DE SECTION
  8. ***********************************************************************
  9. * ENTREES :
  10. *
  11. * INFIBR = NUMERO DE MATERIAU INELASTIQUE
  12. * MELE = NUMERO ELEMENT FINI
  13. * IPMAIL = POINTEUR DU MAILLAGE
  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. * IVARI =POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES
  18. * NMATT =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
  19. * NCARR =NOMBRE DE COMPOSANTES DE CARACTERISTIQUES GEOMETRIQUES
  20. * NVARI =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  21. *
  22. * SORTIES :
  23. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
  24. *
  25. ************************************************************************
  26. * Pierre Pegon (ISPRA) Juillet/Aout 1993
  27. ***********************************************************************
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8(A-H,O-Z)
  30. *
  31. -INC CCOPTIO
  32. -INC SMCHAML
  33. -INC SMELEME
  34. -INC SMCOORD
  35. -INC SMMODEL
  36. -INC SMINTE
  37. -INC CCHAMP
  38. *
  39. SEGMENT MPTVAL
  40. INTEGER IPOS(NS) ,NSOF(NS)
  41. INTEGER IVAL(NCOSOU)
  42. CHARACTER*16 TYVAL(NCOSOU)
  43. ENDSEGMENT
  44. *
  45. SEGMENT WRK0
  46. REAL*8 XMAT(NCXMAT),XCAR(NCXCAR),XVAR(NCXVAR)
  47. ENDSEGMENT
  48. *
  49. SEGMENT WRK2
  50. REAL*8 XE(3,NBBB),SHP(6,NBBB)
  51. ENDSEGMENT
  52. *
  53. DIMENSION CRIGI(*)
  54. *
  55. MFR =NUMMFR(MELE)
  56. MELEME=IPMAIL
  57. NBNN=NUM(/1)
  58. NBELEM=NUM(/2)
  59. *
  60. * SEGMENT D'INTEGRATION
  61. *
  62. C* SEGACT,MINTE <- ACTIF EN E/S
  63. *
  64. * INITIALISATION DES SEGMENTS DE TRAVAIL
  65. *
  66. NCXMAT=NMATT
  67. NCXCAR=NCARR
  68. NCXVAR=NVARI
  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.0
  87. ZZ=0.0
  88. DO IE1=1,NBNN
  89. CGAUSS=SHPTOT(1,IE1,IGAU)
  90. YY=YY+XE(1,IE1)*CGAUSS
  91. ZZ=ZZ+XE(2,IE1)*CGAUSS
  92. END DO
  93. YY2=YY*YY
  94. ZZ2=ZZ*ZZ
  95. *
  96. * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  97. *
  98. DO IE2=1,NBNN
  99. DO IE1=1,6
  100. SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  101. END DO
  102. END DO
  103. C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  104. *
  105. * ON RECUPERE LES CONSTANTES DU MATERIAU
  106. *
  107. MPTVAL=IVAMAT
  108. DO IC=1,NMATT
  109. MELVAL=IVAL(IC)
  110. IF(IC.LT.3)THEN
  111. IIC=IC
  112. ELSEIF(IC.LT.(NMATT-1))THEN
  113. IIC=IC+2
  114. ELSE
  115. IIC=4+IC-NMATT
  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. C ELSE
  128. C XMAT(IIC)=0.
  129. C IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  130. C XMAT(IIC)=0
  131. C 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. IF(MELVAL.NE.0)THEN
  141. IBMN=MIN(IB,VELCHE(/2))
  142. IGMN=MIN(IGAU,VELCHE(/1))
  143. XCAR(IC)=VELCHE(IGMN,IBMN)
  144. C* ELSE
  145. C* XCAR(IC)=0.D0
  146. ENDIF
  147. END DO
  148. *
  149. * ON RECUPERE LES VARIABLES INTERNES
  150. *
  151. MPTVAL=IVARI
  152. DO IC=1,NVARI
  153. MELVAL=IVAL(IC)
  154. IF (MELVAL.NE.0)THEN
  155. IBMN=MIN(IB,VELCHE(/2))
  156. IGMN=MIN(IGAU,VELCHE(/1))
  157. XVAR(IC)=VELCHE(IGMN,IBMN)
  158. C* ELSE
  159. C* XVAR(IC)=0.D0
  160. ENDIF
  161. END DO
  162. *
  163. C Recuperation du module de YOUNG
  164. YOUNG=XMAT(1)
  165. *
  166. * YOUNG TANGENT SELON LES MODELES
  167. *
  168. IF(INFIBR.EQ.0)THEN
  169. C
  170. C MODELE ELASTIQUE LINEAIRE (EXEMPLE)
  171. C
  172. YOUNGT=XMAT(1)
  173. C
  174. ELSEIF(INFIBR.EQ.1)THEN
  175. C
  176. C MODELE BETON_UNI
  177. C
  178. C PP YOUNGT=XVAR(6)
  179. YOUNGT=XVAR(5)
  180. C
  181. ELSEIF(INFIBR.EQ.2)THEN
  182. C
  183. C MODELE ACIER_UNI
  184. C
  185. YOUNGT=XVAR(4)
  186. C
  187. ELSEIF(INFIBR.EQ.3)THEN
  188. C
  189. C MODELE MAZARS_FIB
  190. C
  191. YOUNGT=(1.-XVAR(2))*YOUNG
  192. C
  193. ELSEIF(INFIBR.EQ.4)THEN
  194. C
  195. C MODELE FRAGILE_UNI
  196. C
  197. YOUNGT=XVAR(4)
  198. C
  199. ELSEIF(INFIBR.EQ.5)THEN
  200. C
  201. C MODELE BETON_BAEL
  202. C
  203. YOUNGT=XVAR(3)
  204. C
  205. ELSEIF(INFIBR.EQ.6)THEN
  206. C
  207. C MODELE PARFAIT_UNI
  208. C
  209. YOUNGT=XVAR(2)
  210. C
  211. ELSEIF(INFIBR.EQ.7)THEN
  212. C
  213. C MODELE STRUT_UNI
  214. C
  215. YOUNGT=XVAR(6)
  216. C
  217. ELSEIF(INFIBR.EQ.8)THEN
  218. C
  219. C MODELE CISAIL_NL
  220. C
  221. YOUNGT=XMAT(1)
  222. C
  223. ELSEIF(INFIBR.EQ.9)THEN
  224. C
  225. C MODELE 'PARFAIT_ANCRAGE'
  226. C
  227. YOUNGT=XVAR(6)
  228. C
  229. ELSEIF(INFIBR.EQ.10)THEN
  230. C
  231. C MODELE 'ACIER_ANCRAGE'
  232. C
  233. YOUNGT=XVAR(16)
  234. C
  235. ELSEIF(INFIBR.EQ.11)THEN
  236. C
  237. C MODELE UNILATERAL
  238. C
  239. YOUNGT=XVAR(1)
  240. C
  241. ELSE
  242. C
  243. C A MINIMA ON PREND MODULE D'YOUNG
  244. C
  245. YOUNGT=YOUNG
  246. C
  247. ENDIF
  248. C+PPf
  249. C
  250. C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  251. C
  252. IF(MELE.EQ.167)THEN
  253. DJAC=XCAR(NCARR)
  254. ELSEIF(MELE.EQ.166)THEN
  255. CALL JACOBI(XE,SHP,1,NBNN,DJAC)
  256. DJAC=DJAC*XCAR(NCARR)
  257. ELSE
  258. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  259. ENDIF
  260. C+PPf
  261. *
  262. * CONTRIBUTION A CRIGI
  263. *
  264. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  265. *
  266. GAMMA=YOUNG/(2.*(1.+XMAT(2)))
  267. ALPH1=XCAR(1)
  268. ALPH2=XCAR(2)
  269. *
  270. CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS
  271. CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS
  272. CRIGI( 3)=CRIGI( 3)+YOUNGT*ZZ*PGAUSS
  273. CRIGI( 4)=CRIGI( 4)+YOUNGT*YY2*PGAUSS
  274. CRIGI( 5)=CRIGI( 5)+YOUNGT*YY*ZZ*PGAUSS
  275. CRIGI( 6)=CRIGI( 6)+YOUNGT*ZZ2*PGAUSS
  276. *
  277. CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS
  278. CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS
  279. CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS
  280. CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS
  281. CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS
  282. CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS
  283. C
  284. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  285. C
  286. 1100 CONTINUE
  287. C
  288. C FIN DE LA BOUCLE SUR LES ELEMENTS
  289. C
  290. 1000 CONTINUE
  291. *
  292. C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE)
  293. SEGSUP,WRK0,WRK2
  294. *
  295. RETURN
  296. END
  297.  
  298.  
  299.  
  300.  
  301.  
  302.  

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