Télécharger mdcres.eso

Retour à la liste

Numérotation des lignes :

  1. C MDCRES SOURCE CHAT 05/01/13 01:40:07 5004
  2. SUBROUTINE MDCRES(COE,COEG,BETJEF,BETFLU)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C
  7. DIMENSION AB(9,9),RELC(9),BRAN(8),DUR(200),
  8. & AB0(200),AL(200),AK(200),AKL(200),
  9. & EBFLU(9,200),EB(9),EVIS(9,38),TZE(200),
  10. & REL(200,200),TZERO(200),TMT0(200),
  11. & CB(9,9),ELC(9),COEG(8),TRO(200),
  12. & CB0(200),CL(200),CK(200),CKL(200),
  13. & COE(9,9),CDB(9),CZ1(9),CZ2(9),
  14. & FIFLU(200,200)
  15. C
  16. C******************************************************************
  17. C TEM(N,M)=DATE DE MESURE DE LA DEFORMATION
  18. C TZERO(M)= DATE D'APPLICATION DE LA CHARGE
  19. C DATCOU= DATE DE COULAGE DU BETON
  20. C TMT0(N)=(TEM(N,M)-TZERO(M))
  21. C E28=4734*SQR(FC)
  22. C
  23. C******************************************************************
  24. C
  25. SEGMENT BETJEF
  26. REAL*8 AA,BETA,FC,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
  27. & TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  28. INTEGER ICT,ICC,IMOD,IVIS,ITER,
  29. & ISIM,IBB,IGAU,IZON
  30. ENDSEGMENT
  31. SEGMENT BETFLU
  32. REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  33. & TP0,TZER
  34. INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
  35. ENDSEGMENT
  36. C*******************************************************************
  37. C INITIALISATION
  38. CALL ZERO(REL,200,200)
  39. CALL ZERO(TZERO,200,1)
  40. CALL ZERO(DUR,200,1)
  41. CALL ZERO(FIFLU,200,200)
  42. CALL ZERO(TRO,200,1)
  43. C
  44. C
  45. C TAU1= TEMPS INITIAL POUR LE CALCUL A PARTIR DE LA SECONDE BRANCHE
  46. C DES COEFFICIENTS DE CHAQUE BRANCHE
  47. C
  48. C*******************************************************************
  49. C CALCUL DES COEFFICIENTS DES BRANCHES DU MODELE DE MAXWELL
  50. C*******************************************************************
  51. C
  52. MC=NBRC+1
  53. C
  54. DO 10 N=1,NBRC
  55. IF (N.EQ.1) THEN
  56. BRAN(N) = 0.D0
  57. BRAN(N)=TAU1
  58. ELSE
  59. BRAN(N)=10**(N-2)*TAU2
  60. ENDIF
  61. 10 CONTINUE
  62. C
  63. NC=NCOE+1
  64. C
  65. C*******************************************************************
  66. C APPEL DES COURBES DE VALEURS DE RELAXATION
  67. C*******************************************************************
  68. C
  69. CALL TANSR(REL,TZERO,DUR,FIFLU,TRO,BETJEF,BETFLU)
  70. C
  71. NTPS1=NTPS+1
  72. C
  73. DO 20 I=1,NTPS1
  74. C
  75. IF(I.EQ.1)THEN
  76. TMT0(I)=DUR(I)
  77. ELSE IF(I.GT.1.AND.I.LT.NTPS1) THEN
  78. TMT0(I)=DUR(I)
  79. ELSE IF(I.EQ.NTPS1) THEN
  80. TMT0(I)=0.D0
  81. ENDIF
  82. C
  83. 20 CONTINUE
  84. C
  85. C******************************************************************
  86. C INITIALISATION SUR COE(9,9)=0.D0
  87. C******************************************************************
  88. C
  89. DO 21 KI=1,MC
  90. DO 22 KJ=1,NC
  91. COE(KI,KJ) = 0.D0
  92. 22 CONTINUE
  93. 21 CONTINUE
  94. C
  95. C*******************************************************************
  96. C BOUCLE SUR LES DIFFERENTES BRANCHES
  97. C*******************************************************************
  98. C
  99. DO 25 LDEB=1,MC
  100. C
  101. C******************************************************************
  102. C INITIALISATION
  103. C*****************************************************************
  104. C
  105. DO 26 IN1 = 1,NC
  106. ELC(IN1) = 0.D0
  107. DO 27 IN2 = 1,NC
  108. CB(IN1,IN2) = 0.D0
  109. 27 CONTINUE
  110. 26 CONTINUE
  111. C
  112. C******************************************************************
  113. C BOUCLE SUR LES DIFFERENTS TEMPS D'APPLICATION
  114. C*******************************************************************
  115. C
  116. DO 30 J = 1,NTZERO
  117. TZE(J) = TZERO(J)
  118. C
  119. C*******************************************************************
  120. C BOUCLE SUR LES DIFFERENTES DATES DE MESURE
  121. C*******************************************************************
  122. C
  123. C*******************************************************************
  124. C INITIALISATION
  125. C*******************************************************************
  126. C
  127. DO 40 I = 1,NTPS1
  128. AB0(I) = 0.D0
  129. AL(I) = 0.D0
  130. AK(I) = 0.D0
  131. AKL(I) = 0.D0
  132. 40 CONTINUE
  133. C
  134. C*******************************************************************
  135. C CONDITION THERMODYNAMIQUE
  136. C*******************************************************************
  137. C
  138. C DO 41 I=1,NTPS1
  139. C
  140. C DO 42 JO=1,NTZERO
  141. C
  142. C IF(REL(I,JO).LT.0.D0)THEN
  143. C NTPS1=I-1
  144. C GOTO 500
  145. C ENDIF
  146. C
  147. C 42 CONTINUE
  148. C
  149. C 41 CONTINUE
  150. C
  151. C*******************************************************************
  152. C INITIALISATION
  153. C*******************************************************************
  154. C
  155. 500 DO 43 L = 1,MC
  156. RELC(L) = 0.D0
  157. DO 44 K = 1,MC
  158. AB(L,K) = 0.D0
  159. 44 CONTINUE
  160. 43 CONTINUE
  161. C
  162. C********************************************************************
  163. C
  164. DO 45 I=1,NTPS1
  165. C
  166. C
  167. NOK=NTPS
  168. C
  169. C
  170. IF(I.EQ.1)THEN
  171. AB0(I)=NOK*(TMT0(I))/(TMT0(NOK))
  172. ELSE IF(I.EQ.2)THEN
  173. AB0(I)=NOK*(TMT0(I)-TMT0(NTPS1))/(2*(TMT0(NOK)))
  174. ELSE IF(I.LE.(NOK).AND.I.GT.2)THEN
  175. AB0(I)=NOK*(TMT0(I)-TMT0(I-2))/(2*(TMT0(NOK)))
  176. ELSE IF(I.EQ.NTPS1)THEN
  177. AB0(I)=NOK*(TMT0(NOK)-TMT0(NOK-1))/(TMT0(NOK))
  178. ENDIF
  179. C
  180. DO 50 K=1,MC
  181. C
  182. DO 60 L=1,MC
  183. C
  184. C COEFFICIENT DE LA MATRICE [AB]
  185. C [AB]=TABLEAU AB[NBRC+1,NBRC+1]
  186. C
  187. IF(I.EQ.1) THEN
  188. IF(K.EQ.1.AND.L.EQ.1)THEN
  189. AB(L,K)=AB(L,K)+AB0(I)
  190. ELSE IF(K.EQ.1.AND.L.GT.1)THEN
  191. AL(I) = AB0(I)*EXP(-(TMT0(NTPS1))/BRAN(L-1))
  192. AB(L,K) = AB(L,K)+ AL(I)
  193. ELSE IF(K.GT.1.AND.L.EQ.1)THEN
  194. AK(I) = AB0(I)*EXP(-(TMT0(NTPS1))/BRAN(K-1))
  195. AB(L,K) = AB(L,K)+ AK(I)
  196. ELSE IF(K.GT.1.AND.L.GT.1)THEN
  197. AKL(I) = AB0(I)*EXP(-(TMT0(NTPS1))/BRAN(K-1))*
  198. *EXP(-(TMT0(NTPS1))/BRAN(L-1))
  199. AB(L,K) = AB(L,K)+AKL(I)
  200. ENDIF
  201. C
  202. ELSE
  203. C
  204. IF(K.EQ.1.AND.L.EQ.1)THEN
  205. AB(L,K)=AB(L,K)+AB0(I)
  206. ELSE IF(K.EQ.1.AND.L.GT.1)THEN
  207. AL(I) = AB0(I)*EXP(-(TMT0(I-1))/BRAN(L-1))
  208. AB(L,K) = AB(L,K)+ AL(I)
  209. ELSE IF(K.GT.1.AND.L.EQ.1)THEN
  210. AK(I) = AB0(I)*EXP(-(TMT0(I-1))/BRAN(K-1))
  211. AB(L,K) = AB(L,K)+ AK(I)
  212. ELSE IF(K.GT.1.AND.L.GT.1)THEN
  213. AKL(I) = AB0(I)*EXP(-(TMT0(I-1))/BRAN(K-1))*
  214. *EXP(-(TMT0(I-1))/BRAN(L-1))
  215. AB(L,K) = AB(L,K)+AKL(I)
  216. ENDIF
  217. ENDIF
  218. C
  219. 60 CONTINUE
  220. 50 CONTINUE
  221. C
  222. C*******************************************************************
  223. C INITIALISATION
  224. C*******************************************************************
  225. C
  226. RL0=0.D0
  227. RL1=0.D0
  228. C
  229. C
  230. C******************************************************************
  231. C
  232. DO 70 L=1,MC
  233. C
  234. C COEFFICIENT DU VECTEUR RELC(NBRC)
  235. C RELC(NBRC)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS
  236. C
  237. IF(I.EQ.1) THEN
  238. IF(L.EQ.1)THEN
  239. RL0=AB0(I)*REL(I,J)
  240. RELC(L)=RELC(L)+RL0
  241. ELSE IF(L.GT.1)THEN
  242. RL1=AB0(I)*REL(I,J)*EXP(-(TMT0(NTPS1))/BRAN(L-1))
  243. RELC(L)=RELC(L)+RL1
  244. ENDIF
  245. ELSE
  246. C
  247. IF(L.EQ.1)THEN
  248. RL0=AB0(I)*REL(I,J)
  249. RELC(L)=RELC(L)+RL0
  250. ELSE IF(L.GT.1)THEN
  251. RL1=AB0(I)*REL(I,J)*EXP(-(TMT0(I-1))/BRAN(L-1))
  252. RELC(L)=RELC(L)+RL1
  253. ENDIF
  254. ENDIF
  255.  
  256. RL0=0.D0
  257. RL1=0.D0
  258. C
  259. EB(L)=0.D0
  260. C
  261. 70 CONTINUE
  262. C
  263. 45 CONTINUE
  264. C
  265. CALL SYSTLI(AB,RELC,MC,EB,MC,CZ1)
  266. C
  267. DO 79 NVIS = 1,38
  268. DO 80 L=1,MC
  269. EBFLU(L,J)=EB(L)
  270. EVIS(L,NVIS) = EBFLU(L,NVIS)
  271. 80 CONTINUE
  272. 79 CONTINUE
  273. C
  274. C
  275. C*******************************************************************
  276. C INITIALISATION
  277. C******************************************************************
  278. C
  279. CB0(J)=0.D0
  280. CL(J)=0.D0
  281. CK(J)=0.D0
  282. CKL(J)=0.D0
  283. EL0=0.D0
  284. EL1=0.D0
  285. C
  286. C*******************************************************************
  287. C BOUCLE SUR LES DIFFERENTS TEMPS D APPLICATION (SUITE)
  288. C*******************************************************************
  289. C
  290. C*******************************************************************
  291. C !!!REMARQUE IMPORTANTE : SI NTZERO DIFFERENT DE NTPS
  292. C ALORS REVOIR LA VALEUR (LA DEFINIR)DE TZERO(MOK) CI-DESSOUS
  293. C TRANSFORMEE EN TMT0(MOK) CAR IL S AVERE ETRE LA MEME VALEUR
  294. C*******************************************************************
  295. C
  296. MOK=NTZERO-1
  297. C
  298. IF(J.EQ.1)THEN
  299. CB0(J)=MOK*(TZERO(J+1)-TZERO(J))/(TZERO(NTZERO)-TZERO(1))
  300. ELSE IF(J.LE.(MOK).AND.J.GT.1)THEN
  301. CB0(J)=MOK*(TZERO(J+1)-TZERO(J-1))/(2*(TZERO(NTZERO)-TZERO(1)))
  302. ELSE IF(J.EQ.NTZERO)THEN
  303. CB0(J)=MOK*(TZERO(J)-TZERO(J-1))/(TZERO(NTZERO)- TZERO(1))
  304. C
  305. ENDIF
  306. C
  307. C*********************************************************************
  308. C
  309. DO 100 K=1,NC
  310. C
  311. DO 110 I=1,NC
  312. C
  313. C COEFFICIENT DE LA MATRICE [CB]
  314. C [CB]=TABLEAU CB[NCOE+1,NCOE+1]
  315. C
  316. IF(K.EQ.1.AND.I.EQ.1)THEN
  317. C
  318. CB(I,K)=CB(I,K)+CB0(J)
  319. ELSE IF(K.EQ.1.AND.I.GT.1)THEN
  320. CL(J)=CB0(J)*EXP((DATCUR-TZERO(J))
  321. **COEG(I-1))
  322. CB(I,K)=CB(I,K)+CL(J)
  323. ELSE IF(K.GT.1.AND.I.EQ.1)THEN
  324. CK(J)=CB0(J)*EXP((DATCUR-TZERO(J))
  325. **COEG(K-1))
  326. CB(I,K)=CB(I,K)+CK(J)
  327. ELSE IF(K.GT.1.AND.I.GT.1)THEN
  328. CKL(J)=CB0(J)*EXP((DATCUR-TZERO(J))
  329. **COEG(K-1))*EXP((DATCUR-TZERO(J))
  330. **COEG(I-1))
  331. CB(I,K)=CB(I,K)+CKL(J)
  332. C
  333. ENDIF
  334. C
  335. 110 CONTINUE
  336. C
  337. 100 CONTINUE
  338. C
  339. DO 120 N=1,NC
  340. C
  341. C COEFFICIENT DU VECTEUR ELC(NCOE)
  342. C ELC(NCOE)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS (Subroutine SYSTLI)
  343. C
  344. IF(N.EQ.1)THEN
  345. C
  346. EL0=CB0(J)*EBFLU(LDEB,J)
  347. ELC(N)=ELC(N)+EL0
  348. ELSE IF(N.GT.1)THEN
  349. EL1=CB0(J)*EBFLU(LDEB,J)*EXP((DATCUR-TZERO(J))
  350. **COEG(N-1))
  351. ELC(N)=ELC(N)+EL1
  352. ENDIF
  353. CDB(N)=0.0
  354. C
  355. 120 CONTINUE
  356. C
  357. 30 CONTINUE
  358. C
  359. CALL SYSTLI(CB,ELC,NC,CDB,NC,CZ2)
  360. C
  361. C*******************************************************************
  362. C AFFICHAGE DES VALEURS CONSTITUTIVES DE CHAQUE MODULE
  363. C DE CHAQUE BRANCHE DE MAXWELL
  364. C*******************************************************************
  365. C
  366. DO 130 NFIN=1,NC
  367. C
  368. COE(LDEB,NFIN)=CDB(NFIN)
  369. C
  370. C PRINT*,'LES VALEURS POUR LA BRANCHE',LDEB,'SONT :',CDB(NFIN)
  371. C
  372. 130 CONTINUE
  373. C
  374. 25 CONTINUE
  375. C
  376. RETURN
  377. END
  378.  
  379.  
  380.  

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