Télécharger etagel.eso

Retour à la liste

Numérotation des lignes :

  1. C ETAGEL SOURCE CB215821 16/04/21 21:16:42 8920
  2. C ETAGEL SOURCE AM 96/12/24 21:19:32 2448
  3. C======================================================================
  4. C ETAGE - D. COMBESCURE et P. PEGON - ELSA- 1996
  5. C======================================================================
  6. C
  7. C MODELE GLOBAL D'ETAGE
  8. C (Sur des elements de poutre TIMO - Effort tranchant/Cisail.)
  9. C
  10. SUBROUTINE ETAGEL(XDDEP,XFOR0,XFORF,VAR0,VARF,SECZ,
  11. & XDELAP,XDELAN,XDMAXP,XDMAXN,XBETA,XALPH,XTETA,
  12. & WRK2,NCURVP,NCURVN,KERRE)
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15. C
  16. C=======================================================================
  17. C CETTE ROUTINE EST APPELE DANS ECO100
  18. C
  19. C
  20. C XDDEP = Incrément de déplacement
  21. C XFOR0 = Effort tranchant initial
  22. C XFORF = Effort tranchant final
  23. C VAR0 = Variables internes initiales
  24. C VARF = Variables internes finales
  25. C
  26. C SECZ = Rigidité élastique en cisaillement
  27. C XDELAP = Déplacement de fissuration (sens positif)
  28. C XDELAM = (sens négatif)
  29. C XDMAXP = Endommagement maximum lors de la plastification
  30. C (sens positif)
  31. C XDAMAXN = (sens négatif)
  32. C
  33. C XBETA = Coefficient BETA
  34. C XALPH = Coefficient ALPH
  35. C XTETA = Coefficient TETA
  36. C
  37. C WRK1 = Segment contraintes
  38. C WRK2 = Segment courbe
  39. C NCURVP = Longueur courbe sens positif
  40. C NCURVN = Longueur courbe sens negatif
  41. C
  42. C======================================================================
  43. C XCAR = Caracteristique de la section
  44. C DEPST = Increment de deformation axiale
  45. C SIG0 = Contrainte initiale
  46. C VAR0 = Variables internes initiales
  47. C SIGF = Contrainte finale
  48. C VARF = Variables internes finales
  49. C DEFP = Deformation plastique
  50. C
  51. C=======================================================================
  52. C
  53. PARAMETER (XZER=0.D0,UN=1.D0,EPSILO=1.D-16)
  54. C
  55. C=======================================================================
  56. C VARIABLES ET SEGMENTS NECESSAIRES
  57. C=========================================================================
  58. -INC CCOPTIO
  59. C
  60. C Segment des contraintes
  61. C SEGMENT WRK1
  62. C REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  63. C REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  64. C REAL*8 DEFP(NSTRS),XCAR(ICARA)
  65. C ENDSEGMENT
  66. C Segment de la courbe
  67. SEGMENT WRK2
  68. REAL*8 TRAC(LTRAC)
  69. ENDSEGMENT
  70. C
  71. DIMENSION VAR0(*),VARF(*)
  72. C
  73. C
  74. C Lecture variables internes
  75. C
  76. XDAMP = VAR0(1)
  77. XDAMN = VAR0(2)
  78. XDEPMP = VAR0(3)
  79. XDEPMN = VAR0(4)
  80. XDEPA = VAR0(5)
  81. XDEPCP = VAR0(6)
  82. XDEPCN = VAR0(7)
  83. ICAS = nint(VAR0(8))
  84. C
  85. C Voila les positions des points d'entree des deux courbes dans TRAC
  86. IPP = 1
  87. IPN = IPP+2*NCURVP
  88. C
  89. IF (XFOR0.GE.XZER) THEN
  90. XDAM = XDAMP
  91. XDEPM = XDEPMP
  92. XDELA = XDELAP
  93. ELSE
  94. XDAM = XDAMN
  95. XDEPM = XDEPMN
  96. XDELA = XDELAN
  97. ENDIF
  98. IF (ABS(UN-XDAM).LE.EPSILO) THEN
  99. XDEP0 = XDEPA
  100. ELSE
  101. XDEP0 = XDEPA + (XFOR0/((UN - XDAM)*SECZ))
  102. ENDIF
  103. XDEPF = XDEP0 + XDDEP
  104. C
  105. C
  106. C
  107. C Fin de la lecture des variables et caracteristiques necessaires
  108. C
  109. C
  110. C Quelques calculs preliminaires
  111. C
  112. IF (XDDEP.GE.XZER) THEN
  113. IF (ICAS.EQ.0) ICAS = 15
  114. XDAM = XDAMP
  115. XDEPM = XDEPMP
  116. XDELA = XDELAP
  117. XDMAX = XDMAXP
  118. XDEGRAD = (UN - XTETA)*EXP(-XALPH*XDEPCP) + XTETA
  119. CALL VALINF(XDEPMP,XDEGRAD,TRAC(IPP),NCURVP,XZER,XFMAC,KERRE)
  120. ELSE
  121. IF (ICAS.EQ.0) ICAS = 25
  122. XDAM = XDAMN
  123. XDEPM = XDEPMN
  124. XDELA = XDELAN
  125. XDMAX = XDMAXN
  126. XDEGRAD = (UN - XTETA)*EXP(-XALPH*XDEPCN) + XTETA
  127. XDEPM0 = (-1.D0)*XDEPMN
  128. CALL VALINF(XDEPM0,XDEGRAD,TRAC(IPN),NCURVN,
  129. &XZER,XFMACN,KERRE)
  130. XFMAC = (-1.D0)*XFMACN
  131. ENDIF
  132. C
  133. IF (ABS(XDEPM).LE.EPSILO) THEN
  134. XFELC = XDEGRAD*SECZ*XDELA
  135. IF (ABS(UN - XDMAX).LE.EPSILO) THEN
  136. XPEN = XZER
  137. XFMAX = XFELC
  138. ELSE
  139. XPEN = (UN - (XFMAC/XFELC))/
  140. &(UN - ((UN/(UN - XDMAX))*(XFMAC/XFELC)))
  141. XFMAX = XFELC*( UN - XPEN )/( UN - (XPEN/(UN - XDAM)))
  142. ENDIF
  143. ELSE
  144. XFMAX = XFMAC
  145. ENDIF
  146. XFPIN = XBETA*XFMAX
  147. IF (ABS(UN - XDAM).LE.EPSILO) THEN
  148. XDEPIN = XDEPM
  149. XDEPMX = XDEPM
  150. ELSE
  151. XDEPIN = XDEPM + (XFPIN/((UN - XDAM)*SECZ))
  152. XDEPMX = XDEPM + (XFMAX/((UN - XDAM)*SECZ))
  153. ENDIF
  154. C
  155. C==================================================================
  156. C
  157. C DRIVER
  158. C
  159. C==================================================================
  160. IF (XDDEP.GE.XZER) THEN
  161. IF (ICAS.EQ.11) THEN
  162. GOTO 1100
  163. ELSEIF (ICAS.EQ.12) THEN
  164. GOTO 1200
  165. ELSEIF (ICAS.EQ.13) THEN
  166. GOTO 1300
  167. ELSEIF (ICAS.EQ.14) THEN
  168. GOTO 1400
  169. ELSEIF (ICAS.EQ.15) THEN
  170. GOTO 1500
  171. ELSEIF (XFOR0.GE.XZER) THEN
  172. IF (XDEP0.GE.XDEPIN) THEN
  173. GOTO 1400
  174. ELSE
  175. GOTO 1300
  176. ENDIF
  177. ELSEIF (XFOR0.LT.XZER) THEN
  178. GOTO 1100
  179. ENDIF
  180. ELSE
  181. IF (ICAS.EQ.21) THEN
  182. GOTO 2100
  183. ELSEIF (ICAS.EQ.22) THEN
  184. GOTO 2200
  185. ELSEIF (ICAS.EQ.23) THEN
  186. GOTO 2300
  187. ELSEIF (ICAS.EQ.24) THEN
  188. GOTO 2400
  189. ELSEIF (ICAS.EQ.25) THEN
  190. GOTO 2500
  191. ELSEIF (XFOR0.LE.XZER) THEN
  192. IF (XDEP0.LE.XDEPIN) THEN
  193. GOTO 2400
  194. ELSE
  195. GOTO 2300
  196. ENDIF
  197. ELSEIF (XFOR0.GT.XZER) THEN
  198. GOTO 2100
  199. ENDIF
  200. ENDIF
  201. XFORF = 1.D20
  202. GOTO 9999
  203. C==========================================================
  204. C CAS A-1 - Courbe de decharge -ICAS=11
  205. C==========================================================
  206. 1100 CONTINUE
  207. XDLIM = XDEPA
  208. C
  209. IF (XDEPF.LE.XDLIM) THEN
  210. XDERES = XZER
  211. XDELOC = XDDEP
  212. ELSE
  213. XDELOC = XDLIM - XDEP0
  214. XDERES = XDDEP - XDELOC
  215. ENDIF
  216. C
  217. XKKK = (UN - XDAMN)*SECZ
  218. XFORF = XFOR0 + (XKKK*XDELOC)
  219. C
  220. IF (XDERES.EQ.XZER) THEN
  221. ICAS = 11
  222. GOTO 9999
  223. ELSE
  224. XFOR0 = XFORF
  225. XDEP0 = XDLIM
  226. XDDEP = XDERES
  227. GOTO 1300
  228. C+DC
  229. ENDIF
  230. C
  231. C==========================================================
  232. C CAS A-2 - Courbe de recharge avec pincement -ICAS=12
  233. C==========================================================
  234. 1200 CONTINUE
  235. XDLIM = XDEPIN
  236. C
  237. IF (XDEPF.LE.XDLIM) THEN
  238. XDERES = XZER
  239. XDELOC = XDDEP
  240. ELSE
  241. XDELOC = XDLIM - XDEP0
  242. XDERES = XDDEP - XDELOC
  243. ENDIF
  244. C
  245. IF (ABS(XDEPIN-XDEPMN).LE.EPSILO) THEN
  246. XKKK = XZER
  247. ELSE
  248. XKKK = (XFPIN/(XDEPIN - XDEPMN))
  249. ENDIF
  250. C
  251. XFORF = XFOR0 + (XKKK*XDELOC)
  252. XDEPA0 = XDEPA
  253. IF (ABS(UN - XDAMP).LE.EPSILO) THEN
  254. XDEPA = XDEP0 + XDELOC
  255. ELSE
  256. XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAMP)*SECZ))
  257. ENDIF
  258. XDEPCN = XDEPCN + XDEPA - XDEPA0
  259. IF (XDERES.EQ.XZER) THEN
  260. ICAS = 12
  261. GOTO 9999
  262. ELSE
  263. XFOR0 = XFORF
  264. XDEP0 = XDLIM
  265. XDDEP = XDERES
  266. GOTO 1400
  267. ENDIF
  268. C==========================================================
  269. C CAS A-2b- Courbe de recharge avant A-2 -ICAS=13
  270. C==========================================================
  271. 1300 CONTINUE
  272. IF (ABS(XDEPMP-XDEPMN).GT.EPSILO) THEN
  273. IF (ABS(UN - XDAMP).LE.EPSILO) THEN
  274. XDLIM = XDEPA
  275. ELSE
  276. XDLIM = XDEPA + ((XFPIN/((UN - XDAMP)*SECZ))
  277. &/(XDEPMP - XDEPMN))*(XDEPA - XDEPMN)
  278. ENDIF
  279. ELSE
  280. XDLIM = XDEPA
  281. ENDIF
  282. C
  283. IF (XDEPF.LE.XDLIM) THEN
  284. XDERES = XZER
  285. XDELOC = XDDEP
  286. ELSE
  287. XDELOC = XDLIM - XDEP0
  288. XDERES = XDDEP - XDELOC
  289. ENDIF
  290. C
  291. XKKK = (UN - XDAMP)*SECZ
  292. XFORF = XFOR0 + (XKKK*XDELOC)
  293. C
  294. IF (XDERES.EQ.XZER) THEN
  295. ICAS = 13
  296. GOTO 9999
  297. ELSE
  298. XFOR0 = XFORF
  299. XDEP0 = XDLIM
  300. XDDEP = XDERES
  301. GOTO 1200
  302. ENDIF
  303. C==========================================================
  304. C CAS A-3 - Courbe de recharge -ICAS=14
  305. C==========================================================
  306. 1400 CONTINUE
  307. XDLIM = XDEPMX
  308. C
  309. IF (XDEPF.LE.XDLIM) THEN
  310. XDERES = XZER
  311. XDELOC = XDDEP
  312. ELSE
  313. XDELOC = XDLIM - XDEP0
  314. XDERES = XDDEP - XDELOC
  315. ENDIF
  316. C
  317. XKKK = (UN - XDAMP)*SECZ
  318. XFORF = XFOR0 + (XKKK*XDELOC)
  319. C
  320. IF (XDERES.EQ.XZER) THEN
  321. ICAS = 14
  322. GOTO 9999
  323. ELSE
  324. XFOR0 = XFORF
  325. XDEP0 = XDLIM
  326. XDDEP = XDERES
  327. GOTO 1500
  328. ENDIF
  329. C==========================================================
  330. C CAS A-4 - Courbe de simple charge -ICAS=15
  331. C==========================================================
  332. 1500 CONTINUE
  333. CALL VALINF(XZER,XDEGRAD,TRAC(IPP),NCURVP,XZER,XFMAC,KERRE)
  334. IF (ABS(UN - XDMAXP).LE.EPSILO) THEN
  335. C XDMAC = UN
  336. XDEPMA = XZER
  337. ELSE
  338. C XDMAC = XFMAC/((UN - XDMAXP)*SECZ)
  339. XDEPMA = XFMAC/((UN - XDMAXP)*SECZ)
  340. ENDIF
  341. XFELC = XDEGRAD*SECZ*XDELA
  342. XDEPEL = XFELC/SECZ
  343. IF (XDEPF.LE.XDEPMA) THEN
  344. IF (XDEPF.LE.XDEPEL) THEN
  345. XFORF = SECZ*XDEPF
  346. XDAMP = XZER
  347. ELSE
  348. IF (ABS(XDEPMA - XDEPEL).LE.EPSILO) THEN
  349. XFORF = XFELC
  350. ELSE
  351. XFORF= XFELC + ((XFMAC - XFELC)
  352. &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL)
  353. ENDIF
  354. IF (ABS(XDEPF).LE.EPSILO) THEN
  355. XDAMP = UN
  356. ELSE
  357. XDAMP = UN - (XFORF/(XDEPF*SECZ))
  358. ENDIF
  359. ENDIF
  360. ELSE
  361. SECZF = (UN - XDMAXP)*SECZ
  362. CALL VALINF(XDEPF,XDEGRAD,TRAC(IPP),NCURVP,SECZF,XFORF,KERRE)
  363. XDAMP = XDMAX
  364. XDEPA0 = XDEPA
  365. XDEPA = XDEPF - (XFORF/SECZF)
  366. XDEPCN = XDEPCN + XDEPA - XDEPA0
  367. XDEPMP = XDEPA
  368. ENDIF
  369. ICAS = 15
  370. GOTO 9999
  371. C==========================================================
  372. C CAS B-1 - Courbe de decharge -ICAS=21
  373. C==========================================================
  374. 2100 CONTINUE
  375. XDLIM = XDEPA
  376. C
  377. IF (XDEPF.GE.XDLIM) THEN
  378. XDERES = XZER
  379. XDELOC = XDDEP
  380. ELSE
  381. XDELOC = XDLIM - XDEP0
  382. XDERES = XDDEP - XDELOC
  383. ENDIF
  384. C
  385. XKKK = (UN - XDAMP)*SECZ
  386. XFORF = XFOR0 + (XKKK*XDELOC)
  387. C
  388. IF (XDERES.EQ.XZER) THEN
  389. ICAS = 21
  390. GOTO 9999
  391. ELSE
  392. XFOR0 = XFORF
  393. XDEP0 = XDLIM
  394. XDDEP = XDERES
  395. GOTO 2300
  396. C+DC
  397. ENDIF
  398. C==========================================================
  399. C CAS B-2 - Courbe de recharge avec pincement -ICAS=22
  400. C==========================================================
  401. 2200 CONTINUE
  402. XDLIM = XDEPIN
  403. C
  404. IF (XDEPF.GE.XDLIM) THEN
  405. XDERES = XZER
  406. XDELOC = XDDEP
  407. ELSE
  408. XDELOC = XDLIM - XDEP0
  409. XDERES = XDDEP - XDELOC
  410. ENDIF
  411. C
  412. IF (ABS(XDEPIN-XDEPMP).LE.EPSILO) THEN
  413. XKKK = XZER
  414. ELSE
  415. XKKK = (XFPIN/(XDEPIN - XDEPMP))
  416. ENDIF
  417. C
  418. XFORF = XFOR0 + (XKKK*XDELOC)
  419. XDEPA0 = XDEPA
  420. IF (ABS(UN - XDAMN).LE.EPSILO) THEN
  421. XDEPA = XDEP0 + XDELOC
  422. ELSE
  423. XDEPA = XDEP0 + XDELOC - (XFORF/((UN - XDAMN)*SECZ))
  424. ENDIF
  425. XDEPCP = XDEPCP - (XDEPA - XDEPA0)
  426. IF (XDERES.EQ.XZER) THEN
  427. ICAS = 22
  428. GOTO 9999
  429. ELSE
  430. XFOR0 = XFORF
  431. XDEP0 = XDLIM
  432. XDDEP = XDERES
  433. GOTO 2400
  434. ENDIF
  435. C==========================================================
  436. C CAS B-2b- Courbe de recharge avant A-2 -ICAS=23
  437. C==========================================================
  438. 2300 CONTINUE
  439. IF (ABS(XDEPMP-XDEPMN).GT.EPSILO) THEN
  440. IF (ABS(UN - XDAMN).LE.EPSILO) THEN
  441. XDLIM = XDEPA
  442. ELSE
  443. XDLIM = XDEPA + ((XFPIN/((UN - XDAMN)*SECZ))
  444. &/(XDEPMN - XDEPMP))*(XDEPA - XDEPMP)
  445. ENDIF
  446. ELSE
  447. XDLIM = XDEPA
  448. ENDIF
  449. C
  450. IF (XDEPF.GE.XDLIM) THEN
  451. XDERES = XZER
  452. XDELOC = XDDEP
  453. ELSE
  454. XDELOC = XDLIM - XDEP0
  455. XDERES = XDDEP - XDELOC
  456. ENDIF
  457. C
  458. XKKK = (UN - XDAMN)*SECZ
  459. XFORF = XFOR0 + (XKKK*XDELOC)
  460. C
  461. IF (XDERES.EQ.XZER) THEN
  462. ICAS = 23
  463. GOTO 9999
  464. ELSE
  465. XFOR0 = XFORF
  466. XDEP0 = XDLIM
  467. XDDEP = XDERES
  468. GOTO 2200
  469. ENDIF
  470. C==========================================================
  471. C CAS B-3 - Courbe de recharge -ICAS=24
  472. C==========================================================
  473. 2400 CONTINUE
  474. XDLIM = XDEPMX
  475. C
  476. IF (XDEPF.GE.XDLIM) THEN
  477. XDERES = XZER
  478. XDELOC = XDDEP
  479. ELSE
  480. XDELOC = XDLIM - XDEP0
  481. XDERES = XDDEP - XDELOC
  482. ENDIF
  483. C
  484. XKKK = (UN - XDAMN)*SECZ
  485. XFORF = XFOR0 + (XKKK*XDELOC)
  486. C
  487. IF (XDERES.EQ.XZER) THEN
  488. ICAS = 24
  489. GOTO 9999
  490. ELSE
  491. XFOR0 = XFORF
  492. XDEP0 = XDLIM
  493. XDDEP = XDERES
  494. GOTO 2500
  495. ENDIF
  496. C==========================================================
  497. C CAS B-4 - Courbe de simple charge -ICAS=25
  498. C==========================================================
  499. 2500 CONTINUE
  500. CALL VALINF(XZER,XDEGRAD,TRAC(IPN),NCURVN,XZER,XFMACN,KERRE)
  501. C
  502. XFMAC = (-1.D0)*XFMACN
  503. C
  504. IF (ABS(UN - XDMAXN).LE.EPSILO) THEN
  505. C XDMAC = UN
  506. XDEPMA = XZER
  507. ELSE
  508. C XDMAC = XFMAC/((UN - XDMAXN)*SECZ)
  509. XDEPMA = XFMAC/((UN - XDMAXN)*SECZ)
  510. ENDIF
  511. C XFMAC = (-1.D0)*XFMACN
  512. XFELC = XDEGRAD*SECZ*XDELA
  513. XDEPEL = XFELC/SECZ
  514. IF (XDEPF.GE.XDEPMA) THEN
  515. IF (XDEPF.GE.XDEPEL) THEN
  516. XFORF = SECZ*XDEPF
  517. XDAMN = XZER
  518. ELSE
  519. IF (ABS(XDEPMA - XDEPEL).LE.EPSILO) THEN
  520. XFORF = XFELC
  521. ELSE
  522. XFORF= XFELC + ((XFMAC - XFELC)
  523. &/(XDEPMA - XDEPEL))*(XDEPF - XDEPEL)
  524. ENDIF
  525. IF (ABS(XDEPF).LE.EPSILO) THEN
  526. XDAMN = UN
  527. ELSE
  528. XDAMN = UN - (XFORF/(XDEPF*SECZ))
  529. ENDIF
  530. ENDIF
  531. ELSE
  532. SECZF = (UN - XDMAXN)*SECZ
  533. XDEPFN = (-1.D0)*XDEPF
  534. CALL VALINF(XDEPFN,XDEGRAD,TRAC(IPN),NCURVN,SECZF
  535. &,XFORFN,KERRE)
  536. XFORF = (-1.D0)*XFORFN
  537. XDAMN = XDMAX
  538. XDEPA0 = XDEPA
  539. XDEPA = XDEPF - (XFORF/SECZF)
  540. XDEPCP = XDEPCP - (XDEPA - XDEPA0)
  541. XDEPMN = XDEPA
  542. ENDIF
  543. ICAS = 25
  544. GOTO 9999
  545. C
  546. C
  547. 9999 CONTINUE
  548. C
  549. C==================================================================
  550. C
  551. C On remplit les tableaux avant de sortir
  552. C
  553. C==================================================================
  554. C
  555. VARF(1) = XDAMP
  556. VARF(2) = XDAMN
  557. VARF(3) = XDEPMP
  558. VARF(4) = XDEPMN
  559. VARF(5) = XDEPA
  560. VARF(6) = XDEPCP
  561. VARF(7) = XDEPCN
  562. VARF(8) = ICAS
  563. C=====================================================
  564. C FIN DE LA ROUTINE DU MODELE
  565. C======================================================
  566. RETURN
  567.  
  568. END
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  

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