Télécharger etagel.eso

Retour à la liste

Numérotation des lignes :

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

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