Télécharger aclj.eso

Retour à la liste

Numérotation des lignes :

  1. C ACLJ SOURCE BP208322 17/03/01 21:15:00 9325
  2. SUBROUTINE ACLJ(WRK52, WRK53, WRK54,NVARI,IECOU)
  3.  
  4.  
  5. IMPLICIT REAL*8(a-H, o-Z)
  6. IMPLICIT INTEGER (i-N)
  7.  
  8.  
  9. -INC CCOPTIO
  10. -INC SMEVOLL
  11. -INC SMLREEL
  12. -INC DECHE
  13. C
  14. TTI1 = SIG0(1)
  15. C TTI2 = SIG0(2)
  16. C TTI3 = SIG0(3)
  17. GDP1 = VAR0(1)
  18. TDP1 = VAR0(2)
  19. GDN1 = VAR0(3)
  20. TDN1 = VAR0(4)
  21. DEPS1 = DEPST(1)
  22. DEPS2 = DEPST(2)
  23. C DEPS3 = DEPST(3)
  24. EPSI1 = EPST0(1)
  25. EPSI2 = EPST0(2)
  26. C
  27. C WRITE(6,*) 'XMAT',(XMATF(IOU),IOU = 1,XMAT(/1))
  28. C WRITE(6,*) 'VALMAT',(VALMAT(IOU),IOU = 1,VALMAT(/1))
  29. C WRITE(6,*) 'depst',(depst(IOU),IOU = 1,depst(/1))
  30. C
  31. MEVOLL = INT(VALMAT(3))
  32. SEGACT MEVOLL
  33. KEVOLL = IEVOLL(1)
  34. SEGACT KEVOLL
  35. MLREE1 = IPROGX
  36. MLREE2 = IPROGY
  37. SEGACT MLREE1, MLREE2
  38. C
  39. C GLISSEMENTS
  40. C
  41. DDDD = EPSI2 + DEPS2
  42. EEEE = EPSI1 + DEPS1
  43. C write(6,*) 'dddd eeee', dddd, eeee
  44. EPTO = ABS(EEEE)
  45. GGDP = 0.D0
  46. TTDP = 0.D0
  47. GGDN = 0.D0
  48. TTDN = 0.D0
  49. IF (EPTO.EQ.0.D0) THEN
  50. EPTO = 1.D0
  51. C WRITE(6,*)'***********************************'
  52. END IF
  53. SGNE = EEEE/EPTO
  54. C
  55. DGG1 = MLREE1.PROG(2) - MLREE1.PROG(1)
  56. DTT1 = MLREE2.PROG(2) - MLREE2.PROG(1)
  57. C DGG2 = MLREE1.PROG(3) - MLREE1.PROG(2)
  58. C DTT2 = MLREE2.PROG(3) - MLREE2.PROG(2)
  59. IF (DGG1.EQ.0.D0) THEN
  60. MOTERR='PULO'
  61. CALL ERREUR(1048)
  62. RETURN
  63. ENDIF
  64. TAN0 = DTT1/DGG1
  65. TFR1 = MLREE2.PROG(MLREE2.PROG(/1))
  66. GADH = MLREE1.PROG(2)
  67. C
  68. C VERIFIER LA LOI D ENTREE
  69. C
  70. C IF (DGG2.EQ.0.D0) THEN
  71. C DGG2 = 1
  72. C WRITE(6,*) '** ERROR DE DONNEE DE LA LOI D ENTREE'
  73. C END IF
  74. C TAN1 = DTT2/DGG2
  75. C RAPP = ABS((TAN1-TAN0)/TAN0)
  76. C IF (RAPP.LT.0.0000000001D0) THEN
  77. C WRITE(6,*) '** REVERIFIER LA LOI D ENTREE PENTE ELASTIQUE'
  78. C END IF
  79. C
  80. IF (EPTO.LE.MLREE1.PROG(1)) THEN
  81. TTTT = MLREE2.PROG(1)
  82. WRITE(6,*)'****'
  83. GO TO 1
  84. END IF
  85. C
  86. DO I = 2, MLREE1.PROG(/1)
  87. GGG1 = MLREE1.PROG(I-1)
  88. GGG2 = MLREE1.PROG(I)
  89. TTT1 = MLREE2.PROG(I-1)
  90. TTT2 = MLREE2.PROG(I)
  91. DGG1 = GGG2 - GGG1
  92. DTT1 = TTT2 - TTT1
  93. IF (EPTO.LE.GGG2) THEN
  94. C GLISSEMENT OU IL SE DECHARGE
  95. IF (EEEE.GE.EPSI1) THEN
  96. GGDP = EEEE
  97. GGDN = GDN1
  98. ELSE
  99. GGDP = GDP1
  100. GGDN = EEEE
  101. END IF
  102. C
  103. GFR1 = GDP1-(TFR1+TDP1)/TAN0
  104. GFR2 = GDP1+(TFR1-TDP1)/TAN0
  105. GFR3 = EPSI1-(TTI1+TFR1)/TAN0
  106. GFR4 = EPSI1+(TFR1-TTI1)/TAN0
  107. GFR5 = GDN1-(TFR1+TDN1)/TAN0
  108. GFR6 = GDN1+(TFR1-TDN1)/TAN0
  109. C TTT3 = SGNE*TTT1 + DTT1*(EEEE - SGNE*GGG1)/DGG1
  110. C GGG3 = EPSI1+(TTT3-TTI1)/TAN0
  111. C WRITE(6,*) 'GDP1 TDP1', GDP1, TDP1
  112. C WRITE(6,*) 'FROT', GFR1, GFR2, GFR3, GFR4, GFR5
  113. C
  114. IF (DEPS1.GE.0.D0) THEN
  115. IF (EEEE.GE.GDP1.AND.TTI1.NE.TFR1) THEN
  116. C (1)
  117. C WRITE(6,*) '*** 1'
  118. INDC = 1
  119. ELSE IF (EEEE.GE.GDP1.AND.TTI1.EQ.TFR1) THEN
  120. IF (EEEE.GE.GADH) THEN
  121. C (1)
  122. C WRITE(6,*) '***19'
  123. INDC = 19
  124. ELSE IF (EEEE.LE.GADH) THEN
  125. C (4)
  126. C WRITE(6,*) '***17'
  127. INDC = 17
  128. END IF
  129. ELSE IF (EEEE.LE.GDP1) THEN
  130. IF (EEEE.GE.GFR1.AND.TTT1.NE.TFR1) THEN
  131. IF (EEEE.LE.GFR4) THEN
  132. C (2)
  133. C WRITE(6,*) '*** 3'
  134. INDC = 3
  135. ELSE IF (EEEE.GE.GFR4.AND.EEEE.LE.GFR2) THEN
  136. C (4)
  137. C WRITE(6,*) '*** 13'
  138. INDC = 13
  139. ELSE IF (EEEE.GE.GFR2) THEN
  140. C (2)
  141. C WRITE(6,*) '*** 15'
  142. INDC = 15
  143. END IF
  144. ELSE IF (EEEE.GE.GFR1.AND.TTI1.EQ.TFR1) THEN
  145. IF (EEEE.GE.GFR2) THEN
  146. C (2)
  147. C WRITE(6,*) '*** 9'
  148. INDC = 9
  149. ELSE IF (EEEE.LE.GFR2) THEN
  150. C (4)
  151. C WRITE(6,*) '*** 11'
  152. INDC = 11
  153. END IF
  154. ELSE IF (EEEE.LE.GFR1.AND.EEEE.GE.GFR4) THEN
  155. C (4)
  156. C WRITE(6,*) '*** 5'
  157. INDC = 5
  158. ELSE IF (EEEE.LE.GFR1.AND.EEEE.LE.GFR4) THEN
  159. C (2)
  160. C WRITE(6,*) '*** 7'
  161. INDC = 7
  162. END IF
  163. END IF
  164. C
  165. ELSE IF (DEPS1.LT.0.D0) THEN
  166. IF (EEEE.GE.GFR1) THEN
  167. C (2)
  168. C WRITE(6,*) '*** 2'
  169. INDC = 2
  170. ELSE IF (EEEE.LE.GFR1.AND.EEEE.GE.(-1.D0)*GADH) THEN
  171. IF (EEEE.LE.GFR3) THEN
  172. C (3)
  173. C WRITE(6,*) '*** 4'
  174. INDC = 4
  175. ELSE IF (EEEE.GE.GFR3.AND.EEEE.LE.GFR4) THEN
  176. C (2)
  177. C WRITE(6,*) '*** 6'
  178. INDC = 6
  179. END IF
  180. CCC
  181. ELSE IF (EEEE.LE.(-1.D0)*GADH) THEN
  182. IF (TTI1.NE.(-1.D0)*TFR1) THEN
  183. IF (EEEE.LE.GDN1) THEN
  184. C (-1)
  185. C WRITE(6,*) '*** 8'
  186. INDC = 8
  187. ELSE IF (EEEE.GE.GDN1.AND.EEEE.LE.GFR6) THEN
  188. C (2)
  189. C WRITE(6,*) '*** 14'
  190. INDC = 14
  191. ELSE IF (EEEE.GE.GFR6) THEN
  192. IF (EEEE.LE.GFR4.AND.EEEE.GE.GFR3) THEN
  193. C (2)
  194. C WRITE(6,*) '*** 18'
  195. INDC = 18
  196. ELSE IF (EEEE.LE.GFR3) THEN
  197. C (3)
  198. C WRITE(6,*) '*** 20'
  199. INDC = 20
  200. END IF
  201. END IF
  202. CC
  203. ELSE IF (TTI1.EQ.(-1.D0)*TFR1) THEN
  204. IF (EEEE.GE.GDN1) THEN
  205. IF (EEEE.GE.GFR5) THEN
  206. C (3)
  207. C WRITE(6,*) '*** 10'
  208. INDC = 10
  209.  
  210. ELSE IF (EEEE.LE.GFR5) THEN
  211. C (2)
  212. C WRITE(6,*) '*** 12'
  213. INDC = 12
  214. END IF
  215. ELSE IF (EEEE.LE.GDN1) THEN
  216. C (-1)
  217. C WRITE(6,*) '*** 16'
  218. INDC = 16
  219. END IF
  220. END IF
  221. END IF
  222. END IF
  223. C
  224. C VERIFIER LA LOI ENTREE
  225. C
  226. IF (DGG1.EQ.0.D0) THEN
  227. MOTERR='PULO'
  228. CALL ERREUR(1048)
  229. RETURN
  230. ENDIF
  231. C
  232. C
  233. C
  234. IF (INDC.EQ.1) THEN
  235. PEN1 = DTT1/DGG1
  236. TTTT = TTT1 + DTT1*(EEEE - GGG1)/DGG1
  237. TTDP = TTTT
  238. TTDN = TTTT
  239. GO TO 1
  240. ELSE IF (INDC.EQ.19) THEN
  241. PEN1 = DTT1/DGG1
  242. GGDP = EEEE
  243. GGDN = GDN1
  244. TTTT = TTT1 + DTT1*(EEEE - GGG1)/DGG1
  245. TTDP = TTTT
  246. TTDN = TDN1
  247. GO TO 1
  248. ELSE IF(INDC.EQ.2)THEN
  249. PEN1 = TAN0
  250. GGDP = GDP1
  251. TTTT = TTI1 + TAN0*(EEEE - EPSI1)
  252. TTDP = TDP1
  253. IF (EEEE.LE.GDN1) THEN
  254. GGDN = EEEE
  255. TTDN = TTTT
  256. ELSE
  257. GGDN = GDN1
  258. TTDN = TDN1
  259. END IF
  260. GO TO 1
  261. ELSE IF(INDC.EQ.3.OR.INDC.EQ.18)THEN
  262. PEN1 = TAN0
  263. GGDP = GDP1
  264. GGDN = GDN1
  265. TTTT = TTI1 + TAN0*(EEEE - EPSI1)
  266. TTDP = TDP1
  267. TTDN = TDN1
  268. GO TO 1
  269. ELSE IF (INDC.EQ.4) THEN
  270. PEN1 = 0.D0
  271. GGDP = GDP1
  272. TTTT = 0.D0-TFR1
  273. TTDP = TDP1
  274. IF (EEEE.LE.GDN1) THEN
  275. GGDN = EEEE
  276. TTDN = TTTT
  277.  
  278. ELSE
  279. GGDN = GDN1
  280. TTDN = TDN1
  281.  
  282. END IF
  283. GO TO 1
  284. ELSE IF (INDC.EQ.10.OR.INDC.EQ.20) THEN
  285. PEN1 = 0.D0
  286. GGDP = GDP1
  287. GGDN = GDN1
  288. TTTT = 0.D0-TFR1
  289. TTDP = TDP1
  290. TTDN = TDN1
  291. GO TO 1
  292. ELSE IF (INDC.EQ.5.OR.INDC.EQ.11.OR.INDC.EQ.13) THEN
  293. PEN1 = 0.D0
  294. GGDP = GDP1
  295. GGDN = GDN1
  296. TTTT = TFR1
  297. TTDP = TDP1
  298. TTDN = TDN1
  299. GO TO 1
  300. ELSE IF (INDC.EQ.17) THEN
  301. PEN1 = 0.D0
  302. GGDP = EEEE
  303. GGDN = GDN1
  304. TTTT = TFR1
  305. TTDP = TTTT
  306. TTDN = TDN1
  307. GO TO 1
  308. ELSE IF (INDC.EQ.6.OR.INDC.EQ.7) THEN
  309. PEN1 = TAN0
  310. GGDP = GDP1
  311. GGDN = GDN1
  312. TTTT = TTI1 + TAN0*(EEEE - EPSI1)
  313. TTDP = TDP1
  314. TTDN = TDN1
  315. GO TO 1
  316. ELSE IF (INDC.EQ.9.OR.INDC.EQ.15) THEN
  317. PEN1 = TAN0
  318. GGDP = GDP1
  319. GGDN = GDN1
  320. TTTT = TDP1 + TAN0*(EEEE - GDP1)
  321. TTDP = TDP1
  322. TTDN = TDN1
  323. GO TO 1
  324. ELSE IF (INDC.EQ.12.OR.INDC.EQ.14) THEN
  325. PEN1 = TAN0
  326. GGDP = GDP1
  327. GGDN = GDN1
  328. TTTT = TDN1 + TAN0*(EEEE - GDN1)
  329. TTDP = TDP1
  330. TTDN = TDN1
  331. GO TO 1
  332. ELSE IF (INDC.EQ.8.OR.INDC.EQ.16) THEN
  333. PEN1 = DTT1/DGG1
  334. GGDP = GDP1
  335. GGDN = EEEE
  336. TTTT = SGNE*TTT1 + DTT1*(EEEE - SGNE*GGG1)/DGG1
  337. TTDP = TDP1
  338. TTDN = TTTT
  339. GO TO 1
  340. END IF
  341. END IF
  342. END DO
  343. TTTT = 0.d0
  344. C WRITE(6,*) '**** ****'
  345. 1 CONTINUE
  346. C
  347. SIGF(1) = TTTT
  348. SIGF(2) = VALMAT(2) * DDDD
  349. SIGF(3) = SIGF(2)
  350. VARF(1) = GGDP
  351. VARF(2) = TTDP
  352. VARF(3) = GGDN
  353. VARF(4) = TTDN
  354. VARF(5) = PEN1
  355. C
  356. C WRITE(6,*)'VARF', VARF(1), VARF(3)
  357. C WRITE(6,*)'SIGF', VARF(2), VARF(4)
  358. C WRITE(6,*)'KPENT', VARF(5)
  359. C WRITE(6,*)'EPSIL', EEEE, DDDD,DDDD
  360. C WRITE(6,*)'SIGMA', SIGF(1), SIGF(2), SIGF(3)
  361. C
  362. RETURN
  363. END
  364.  
  365.  
  366.  
  367.  
  368.  

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