Télécharger mdcrel.eso

Retour à la liste

Numérotation des lignes :

  1. C MDCREL SOURCE CHAT 05/01/13 01:40:01 5004
  2. SUBROUTINE MDCREL(COE,COEG,BETJEF,BETFLU)
  3. C
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. C
  7. DIMENSION REL(200,200),TZO(200),DUR(200),
  8. & FIFLU(200,200),BRAN(8),TRO(200),
  9. & AB0(200),AB(8,8),RELC(8),
  10. & CZ1(8),CB0(200),CB(8,8),ELC(8),
  11. & EB(8),EBFLU(8,200),EVIS(8,38),
  12. & COEG(8),COE(8,8),CDB(8),CZ2(8)
  13. C
  14. C*******************************************************************
  15. C TAU1 = TEMPS INITIAL POUR LE CALCUL
  16. C DES COEFFICIENTS DE CHAQUE BRANCHE
  17. C TZO(M) = DATE D'APPLICATION DE LA CHARGE
  18. C DATCUR = DATE DE CURE DU BETON MINIMALE
  19. C DUR(N) = DUREE VARIABLE D APPLICATION DE LA CHARGE
  20. C NBRC = NOMBRE DE BRANCHES DU MODELE DE MAXWELL LIQUIDE
  21. C EVIS sert seulement à rendre visible toutes les valeurs de toutes les
  22. C branches du modèle de MAXWELL
  23. C TRO(N) = TABLEAU DU PREMIER TEMPS DE RELAXATION
  24. C POUR CHAQUE AGE D APPLICATION D UNE CHARGE
  25. C*******************************************************************
  26. C
  27. SEGMENT BETJEF
  28. REAL*8 AA,BETA,FC,ALPHA,EX,XNU,GFC,GFT,CAR,ETA,TDEF,
  29. & TCON,DPSTF1,DPSTF2,TETA,PDT,TP00
  30. INTEGER ICT,ICC,IMOD,IVIS,ITER,
  31. & ISIM,IBB,IGAU,IZON
  32. ENDSEGMENT
  33. SEGMENT BETFLU
  34. REAL*8 DATCOU,DATCUR,DATSEC,E28,PGTZO,PGDUR,TAU1,TAU2,
  35. & TP0,TZER
  36. INTEGER ITYPE,IMD,NBRC,NCOE,NTZERO,NTPS,IFOR
  37. ENDSEGMENT
  38. C*******************************************************************
  39. C INITIALISATION
  40. CALL ZERO(REL,200,200)
  41. CALL ZERO(TZO,200,1)
  42. CALL ZERO(DUR,200,1)
  43. CALL ZERO(FIFLU,200,200)
  44. CALL ZERO(TRO,200,1)
  45. C
  46. C*******************************************************************
  47. C DETERMINATION DES TEMPS DE RELAXATION DES BRANCHES DE MAXWELL
  48. C*******************************************************************
  49. C
  50. DO 10 N = 1,NBRC
  51. BRAN(N) = 0.D0
  52. IF (N.EQ.1) THEN
  53. BRAN(N) = TAU1
  54. ELSE
  55. BRAN(N) = 10**(N-2)*TAU2
  56. ENDIF
  57. 10 CONTINUE
  58. C
  59. C*******************************************************************
  60. C APPEL DES COURBES DE VALEURS DE RELAXATION
  61. C*******************************************************************
  62. C
  63. CALL TANSR(REL,TZO,DUR,FIFLU,TRO,BETJEF,BETFLU)
  64. C
  65. C NOMBRE DE VALEURS DE DUREE D APPLICATION DE LA CHARGE = NTPS1
  66. NTPS1 = NTPS+1
  67. C
  68. C INITIALISATION
  69. C*******************************************************************
  70. DO 11 K1 = 1,NBRC
  71. DO 12 K2 = 1,NCOE
  72. COE(K1,K2) = 0.D0
  73. 12 CONTINUE
  74. 11 CONTINUE
  75. C
  76. C
  77. C BOUCLE SUR LES DIFFERENTES BRANCHES (NBRC)
  78. C*******************************************************************
  79. C*******************************************************************
  80. DO 20 LDEB = 1,NBRC
  81. C*******************************************************************
  82. C*******************************************************************
  83. C
  84. C
  85. C INITIALISATION
  86. C*******************************************************************
  87. C
  88. DO 22 K2 = 1,NCOE
  89. ELC(K2) = 0.D0
  90. DO 23 K3 = 1,NCOE
  91. CB(K2,K3) = 0.D0
  92. 23 CONTINUE
  93. 22 CONTINUE
  94. C
  95. C
  96. C BOUCLE SUR LES DIFFERENTS TEMPS D'APPLICATION (NTZERO)
  97. C*******************************************************************
  98. C*******************************************************************
  99. DO 30 J = 1,NTZERO
  100. C*******************************************************************
  101. C*******************************************************************
  102. C
  103. C INITIALISATION
  104. C*******************************************************************
  105. C
  106. DO 31 K1 = 1,NTPS1
  107. AB0(K1) = 0.D0
  108. 31 CONTINUE
  109. DO 32 K2 = 1,NBRC
  110. RELC(K2) = 0.D0
  111. DO 33 K3 = 1,NBRC
  112. AB(K2,K3) = 0.D0
  113. 33 CONTINUE
  114. 32 CONTINUE
  115. C
  116. C BOUCLE SUR LES DIFFERENTES DUREES D APPLICATION DE LA CHARGE (NTPS1)
  117. C*******************************************************************
  118. C*******************************************************************
  119. DO 40 I = 1,NTPS1
  120. C*******************************************************************
  121. C*******************************************************************
  122. C
  123. IF(I.EQ.1)THEN
  124. AB0(I) = NTPS*(DUR(I)/DUR(NTPS1))
  125. C
  126. ELSE IF(I.EQ.2)THEN
  127. AB0(I) = NTPS*(DUR(I)/(2*DUR(NTPS1)))
  128. C
  129. ELSE IF(I.LT.NTPS1.AND.I.GT.2)THEN
  130. AB0(I) = NTPS*(DUR(I)-DUR(I-2))/(2*DUR(NTPS1))
  131. C
  132. ELSE IF(I.EQ.NTPS1)THEN
  133. AB0(I) = NTPS*(DUR(NTPS1)-DUR(NTPS))/DUR(NTPS1)
  134. ENDIF
  135. C
  136. DO 50 K = 1,NBRC
  137. DO 60 L = 1,NBRC
  138. C
  139. C COEFFICIENT DE LA MATRICE [AB]
  140. C [AB] = TABLEAU AB[NBRC,NBRC]
  141. C*******************************************************************
  142. IF (I.EQ.1) THEN
  143. AB(L,K) = AB0(I)
  144. ELSE
  145. AB(L,K) = AB(L,K) + AB0(I)*EXP(-DUR(I-1)/BRAN(K))*
  146. *EXP(-DUR(I-1)/BRAN(L))
  147. ENDIF
  148. C
  149. 60 CONTINUE
  150. 50 CONTINUE
  151. C
  152. DO 70 L = 1,NBRC
  153. C
  154. C COEFFICIENT DU VECTEUR RELC(NBRC)
  155. C RELC(NBRC)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS
  156. C*******************************************************************
  157. IF(I.EQ.1)THEN
  158. RELC(L) = RELC(L)+AB0(I)*REL(I,J)
  159. ELSE
  160. RELC(L) = RELC(L)+AB0(I)*REL(I-1,J)
  161. **EXP(-DUR(I-1)/BRAN(L))
  162. ENDIF
  163. C
  164. C INITIALISATION
  165. C*******************************************************************
  166. EB(L) = 0.D0
  167. 70 CONTINUE
  168. C
  169. C
  170. C*******************************************************************
  171. C*******************************************************************
  172. 40 CONTINUE
  173. C*******************************************************************
  174. C*******************************************************************
  175. C
  176. CALL SYSTLI(AB,RELC,NBRC,EB,NBRC,CZ1)
  177. C
  178. DO 79 NVIS =1,38
  179. DO 80 L = 1,NBRC
  180. EBFLU(L,J) = EB(L)
  181. EVIS(L,NVIS) = EBFLU(L,NVIS)
  182. 80 CONTINUE
  183. 79 CONTINUE
  184. C
  185. C
  186. C INITIALISATION
  187. C*******************************
  188. CB0(J) = 0.D0
  189. C
  190. C
  191. C BOUCLE SUR LES DIFFERENTS TEMPS D APPLICATION (SUITE)
  192. C*******************************************************************
  193. C*******************************************************************
  194. C
  195. MOK = NTZERO-1
  196. IF(J.EQ.1)THEN
  197. CB0(J) = MOK*(TZO(J+1)-TZO(1))/(TZO(NTZERO)-TZO(1))
  198. C
  199. ELSE IF(J.LT.NTZERO.AND.J.GT.1)THEN
  200. CB0(J) = MOK*(TZO(J+1)-TZO(J-1))
  201. */(2*(TZO(NTZERO)-TZO(1)))
  202. C
  203. ELSE IF(J.EQ.NTZERO)THEN
  204. CB0(J) = MOK*(TZO(NTZERO)-TZO(MOK))
  205. */(TZO(NTZERO) - TZO(1))
  206. C
  207. ENDIF
  208. C
  209. C*******************************************************************
  210. C
  211. DO 100 K = 1,NCOE
  212. DO 110 I = 1,NCOE
  213. C
  214. C COEFFICIENT DE LA MATRICE [CB]
  215. C [CB] = TABLEAU CB[NCOE,NCOE]
  216. C
  217. CB(I,K) = CB(I,K)+CB0(J)*EXP((DATCUR-TZO(J))
  218. **COEG(K))*EXP((DATCUR-TZO(J))*COEG(I))
  219. C
  220. 110 CONTINUE
  221. 100 CONTINUE
  222. C
  223. C COEFFICIENT DU VECTEUR ELC(NCOE)
  224. C ELC(NCOE)=SECOND MEMBRE POUR RESOLUTION PAR GAUSS (SYSTLI)
  225. C*******************************************************************
  226. C
  227. DO 120 N = 1,NCOE
  228. C
  229. ELC(N) = ELC(N)+CB0(J)*EBFLU(LDEB,J)
  230. **EXP((DATCUR-TZO(J))*COEG(N))
  231. C
  232. C INITIALISATION
  233. C*******************************************************************
  234. CDB(N) = 0.0
  235. 120 CONTINUE
  236. C
  237. C*******************************************************************
  238. C*******************************************************************
  239. 30 CONTINUE
  240. C*******************************************************************
  241. C*******************************************************************
  242. C
  243. CALL SYSTLI(CB,ELC,NCOE,CDB,NCOE,CZ2)
  244. C
  245. C AFFICHAGE DES VALEURS CONSTITUTIVES DE CHAQUE MODULE
  246. C DE CHAQUE BRANCHE DE MAXWELL
  247. C*******************************************************************
  248. C
  249. DO 130 NFIN = 1,NCOE
  250. COE(LDEB,NFIN) = CDB(NFIN)
  251. C PRINT*,'LES VALEURS POUR LA BRANCHE',LDEB,'SONT :',CDB(NFIN)
  252. 130 CONTINUE
  253. C
  254. C*******************************************************************
  255. C*******************************************************************
  256. 20 CONTINUE
  257. C*******************************************************************
  258. C*******************************************************************
  259. C
  260. RETURN
  261. END
  262.  
  263.  
  264.  

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