Télécharger crpha4.eso

Retour à la liste

Numérotation des lignes :

  1. C CRPHA4 SOURCE BP208322 17/03/01 21:16:45 9325
  2. C====================================================================
  3. C
  4. SUBROUTINE CRPHA4(VWRK1,CARB,iwrk52,IMARQ,DTPS,VWRK2,nhist,
  5. .ilent1,ilent2,iele,igau)
  6. C
  7. C====================================================================
  8. C
  9. C Calcul de transformations de phases
  10. C appelee par CRPHA3
  11. C
  12. C calcule les nouvelles proportions de phases au point considere
  13. C
  14. C vwrk1 /1 temperature
  15. C /2 vitesse de chauf,refr
  16. C /3 proportion d'austenite
  17. C /4 proportion de ferrite
  18. C /5 proportion de bainite
  19. C /6 proportion de martensite
  20. C /7 temperature de debut de transf. martensitique
  21. C carb taux de carbone moyen
  22. C iptab donnees materiau
  23. C imarq indicateur pour le tri des donnees
  24. C dtps pas de temps
  25. C vwrk2 resultat : vwrk1 actualise
  26. C
  27. C routines appelees
  28. C 1)austenitisation
  29. C TRITE3 tri dans la table des temperatures
  30. C AUSTRK integration de l'equa diff de Leblond
  31. C (runge-kutta ordre 4)
  32. C 2)ferrite+bainite
  33. C VOISI2 recherche des point support de l'interpolation
  34. C INTER9 interpolation/extrapolation
  35. C
  36. C Michael Martinez 12/98
  37. C====================================================================
  38. C
  39. C Modifications de LB a partir du 15/03/97
  40. C ========================================
  41. C 1) verifie que les compositions restent positives
  42. C 3) prise en compte de la vitesse mini pour l apparition
  43. C de la martensite
  44. C
  45. IMPLICIT INTEGER(I-N)
  46. IMPLICIT REAL*8(A-H,O-Z)
  47. C
  48. -INC SMNUAGE
  49. -INC SMLENTI
  50. -INC SMLREEL
  51.  
  52. -INC DECHE
  53. C
  54. REAL*8 VWRK1(*),VWRK2(7),ZFIN(4),VOIS2(4,3),COEF2(4)
  55. REAL*8 TZFP(4),TZBP(4),CK(10),CL(10),TE(10)
  56. INTEGER IMARQ(2)
  57. C
  58. DATA SMALL /0.000001/, PRESQU_UN /0.99999999/
  59. C
  60. wrk52 = iwrk52
  61. T0=VWRK1(1)
  62. TP0=VWRK1(2)
  63. ZA0=VWRK1(3)
  64. VMS1=VWRK1(7)
  65. if (iele.eq.1. and.igau.eq.1) then
  66. * write(6,*) 'trpha2 0',T0,TP0,ZA0,VMS1
  67. endif
  68. C
  69. C ON RESTE DANS DES LIMITES RAISONNABLES
  70. C
  71. IF (T0.GT.999.) THEN
  72. VWRK2(1)=VWRK1(1)
  73. VWRK2(2)=VWRK1(2)
  74. VWRK2(3)=1.D0
  75. VWRK2(4)=0.D0
  76. VWRK2(5)=0.D0
  77. VWRK2(6)=0.D0
  78. VWRK2(7)=VWRK1(7)
  79. RETURN
  80. ENDIF
  81. C
  82. C LECTURE DES DONNEES DE LA TABLE : AR1, MS0 ...
  83. C
  84. AC1=xmat0(1)
  85. AR1=xmat0(2)
  86. VMS0=xmat0(3)
  87. BETA=xmat0(4)
  88. AC=xmat0(5)
  89. AA=xmat0(6)
  90. ZS=xmat0(7)
  91. TPLM=xmat0(8)
  92. CARB0=xmat0(9)
  93.  
  94. mnuag1 = int(xmat0(17))
  95.  
  96. c NCHAUF=NHIST+3
  97. C
  98. IF (abs(TP0).LT.abs(TPLM)) then
  99. VMS1 = 210.
  100. ENDIF
  101. C
  102. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  103. C
  104. IF ((T0.GT.AR1.AND.ZA0.LT.PRESQU_UN).OR.(TP0.GE.0..AND.T0.GE.AC1
  105. . .AND.ZA0.LT.PRESQU_UN)) THEN
  106. C
  107. C AUSTENITISATION (MODELE DE LEBLOND)
  108. C
  109. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  110. C
  111. C POSITIONNEMENT EN TEMPERATURE
  112. C
  113. T1=T0+TP0*DTPS
  114. mlenti = ilent2
  115. segact mlenti
  116. ntemp = lect(/1)
  117. ITEMP0=IMARQ(1)
  118. ITEMP1=IMARQ(1)
  119. CALL TRITE3 (ilent2,NTEMP,T0,ITEMP0,ITSUP)
  120. CALL TRITE3 (ilent2,NTEMP,T1,ITEMP1,ITSUP)
  121. IMARQ(1)=ITEMP0
  122. C
  123. C RECUPERATION DES DEUX COEF DU MODELE DE LEBLOND
  124. C
  125. segact mlenti
  126. mlree1 = lect(itemp0)
  127. mlree2 = lect(itemp1)
  128. segact mlree1,mlree2
  129. CKA0=mlree1.prog(2)
  130. CLA0=mlree1.prog(3)
  131.  
  132. CKA1=mlree2.prog(2)
  133. CLA1=mlree2.prog(3)
  134. segdes mlree1,mlree2
  135.  
  136. C AUSTENITISATION
  137. C
  138. CALL AUSTRK(VWRK1,ZFIN,CKA0,CKA1,CLA0,CLA1,DTPS)
  139. C
  140. VWRK2(1)=T0
  141. VWRK2(2)=TP0
  142. VWRK2(3)=ZFIN(1)
  143. VWRK2(4)=ZFIN(2)
  144. VWRK2(5)=ZFIN(3)
  145. VWRK2(6)=ZFIN(4)
  146. VWRK2(7)=VMS0-AC*(CARB-CARB0)
  147. C
  148. ELSE
  149. if (iele.eq.1. and.igau.eq.1) then
  150. * write(6,*) 'trpha2 11'
  151. endif
  152. VWRK2(1)=VWRK1(1)
  153. VWRK2(2)=VWRK1(2)
  154. VWRK2(3)=VWRK1(3)
  155. VWRK2(4)=VWRK1(4)
  156. VWRK2(5)=VWRK1(5)
  157. VWRK2(6)=VWRK1(6)
  158. VWRK2(7)=VWRK1(7)
  159. C
  160. ENDIF
  161. C
  162. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  163. C
  164. IF (TP0.GE.0..AND.T0.LT.AC1) THEN
  165. C
  166. C CHAUFFAGE EN DESSOUS DE AC1 --> PAS DE TRANSFORMATIONS
  167. C
  168. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  169. C
  170. VWRK2(1)=VWRK1(1)
  171. VWRK2(2)=VWRK1(2)
  172. VWRK2(3)=VWRK1(3)
  173. VWRK2(4)=VWRK1(4)
  174. VWRK2(5)=VWRK1(5)
  175. VWRK2(6)=VWRK1(6)
  176. VWRK2(7)=VWRK1(7)
  177. C
  178. ENDIF
  179. C
  180. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  181. C
  182. IF (TP0.LT.0..AND.T0.LE.AR1.AND.T0.GT.VMS1) THEN
  183. C
  184. C TRANSFORMATION AUSTENITE --> FERRITE + BAINITE
  185. C
  186. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  187. if (iele.eq.1. and.igau.eq.1) then
  188. * write(6,*) 'trpha2 3'
  189. endif
  190. C
  191. C IL N'Y A DE TRANSFORMATION
  192. C QUE POUR UN MATERIAU CONTENANT DE L'AUSTENITE
  193. C
  194. IF (VWRK1(3).LT.SMALL) THEN
  195. VWRK2(1)=VWRK1(1)
  196. VWRK2(2)=VWRK1(2)
  197. VWRK2(3)=VWRK1(3)
  198. VWRK2(4)=VWRK1(4)
  199. VWRK2(5)=VWRK1(5)
  200. VWRK2(6)=VWRK1(6)
  201. VWRK2(7)=VWRK1(7)
  202. ELSE
  203. C
  204. C (FIN MODIF MM)
  205. C
  206. C --> RECHERCHE DES VOISINS
  207. C ON COMMENCE PAR ENCADRER LA TEMPERATURE T0
  208. C SUR LA PREMIERE COURBE
  209. C
  210. C INITIALISATION DE VOIS2
  211. C
  212. VOIS2(1,1)=0
  213. VOIS2(2,1)=0
  214. VOIS2(3,1)=0
  215. VOIS2(4,1)=0
  216. VOIS2(1,2)=0.D0
  217. VOIS2(2,2)=0.D0
  218. VOIS2(3,2)=0.D0
  219. VOIS2(4,2)=0.D0
  220. VOIS2(1,3)=100000.D0
  221. VOIS2(2,3)=100000.D0
  222. VOIS2(3,3)=100000.D0
  223. VOIS2(4,3)=100000.D0
  224. C
  225. C DETERMINATION DES QUATRES POINTS LES PLUS PROCHES
  226. C (==> VOIS2)
  227. C
  228. CALL VOISI2(T0,TP0,ZA0,VOIS2,IMARQ,ilent1,iele,igau)
  229. if (iele.eq.1. and.igau.eq.1) then
  230. * write(6,*) t0,tp0,za0
  231. endif
  232. C
  233. C INTERPOLATION A PARTIR DE VOIS2
  234. C
  235. CALL INTER9(T0,TP0,ZA0,VOIS2,COEF2,ilent1)
  236. C
  237. MLENTI = ILENT1
  238. segact mlenti
  239. C
  240. DO 1002 I=1,4
  241. IHIST=nint(VOIS2(I,1))
  242. mlent1 = lect(ihist)
  243. segact mlent1
  244. ITEMP=nint(VOIS2(I,2))
  245. mlreel = mlent1.lect(itemp)
  246. segact mlreel
  247. za = prog(3)
  248. zf = prog(4)
  249. zb = prog(5)
  250. zfp = prog(8)
  251. zbp = prog(9)
  252. tk = prog(1)
  253. tkp = prog(2)
  254. if (iele.eq.1. and.igau.eq.1) then
  255. * write(6,*) 'yo', i,ihist,itemp
  256. * write(6,*) tk,tkp,za, zf
  257. endif
  258. IF (ZA.LT.SMALL) THEN
  259. TZFP(I) = 0
  260. TZBP(I) = 0
  261. ELSE
  262. TZFP(I)=ZFP/ZA
  263. TZBP(I)=ZBP/ZA
  264. ENDIF
  265. segdes mlreel,mlent1
  266. 1002 CONTINUE
  267. C
  268. segdes mlenti
  269. C
  270. TZFP0=COEF2(1)*TZFP(1)+COEF2(2)*TZFP(2)+COEF2(3)*TZFP(3)
  271. & +COEF2(4)*TZFP(4)
  272. TZBP0=COEF2(1)*TZBP(1)+COEF2(2)*TZBP(2)+COEF2(3)*TZBP(3)
  273. & +COEF2(4)*TZBP(4)
  274. ZFP0=TZFP0*ZA0
  275. ZBP0=TZBP0*ZA0
  276. C
  277. VWRK2(1)=VWRK1(1)
  278. VWRK2(2)=VWRK1(2)
  279. VWRK2(4)=VWRK1(4)+ZFP0*DTPS
  280. VWRK2(5)=VWRK1(5)+ZBP0*DTPS
  281. C
  282. C MODIF DE LB :
  283. C
  284. C CONTROLE POUR BAINITE OU FERRITE POSITIVE
  285. C
  286. IF (VWRK2(4).LT.0.0) THEN
  287. VWRK2(4) = 0.0
  288. ENDIF
  289. IF (VWRK2(5).LT.0.0) THEN
  290. VWRK2(5) = 0.0
  291. ENDIF
  292. C
  293. C CONTROLE POUR GARDER AUSTENITE POSITIVE :
  294. C on verifie que BAINITE + FERRITE <= 1
  295. C
  296. C si creation de ferrite
  297. C
  298. IF (ZFP0.GT.ZBP0) THEN
  299. IF ((VWRK2(4)+VWRK2(5)).GT.1.0) THEN
  300. VWRK2(4) = 1.0 - VWRK2(5)
  301. ENDIF
  302. C
  303. C si creation de bainite
  304. C
  305. ELSE IF ((VWRK2(4)+VWRK2(5)).GT.1.0) THEN
  306. VWRK2(5) = 1.0 - VWRK2(4)
  307. ENDIF
  308. C
  309. C FIN MODIF LB
  310. C
  311. VWRK2(3)=1.D0-(VWRK2(4)+VWRK2(5))
  312. VWRK2(6)=VWRK1(6)
  313. C
  314. C TEMPERATURE DE DEBUT DE TRANSF. MARTENSITIQUE
  315. C
  316. ZTRSF = 1. - VWRK2(3)
  317. DZ = ZTRSF - ZS
  318. IF (DZ.LT.0.D0) THEN
  319. DZ=0.D0
  320. ENDIF
  321. VWRK2(7)=VMS0-AC*(CARB-CARB0)-AA*DZ
  322. C
  323. ENDIF
  324. C
  325. ENDIF
  326. C
  327. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  328. C
  329. IF (TP0.LT.0..AND.T0.LE.VMS1) THEN
  330. C
  331. C TRANSFORMATION MARTENSITIQUE
  332. C
  333. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  334. C
  335. VWRK2(7)=VWRK1(7)
  336. VWRK2(5)=VWRK1(5)
  337. VWRK2(4)=VWRK1(4)
  338. VWRK2(2)=VWRK1(2)
  339. VWRK2(1)=VWRK1(1)
  340. C
  341. C CALCUL DU TAUX DE MARTENSITE (AVEC IRREVERSIBILITE)
  342. C
  343. ZAN=1.D0-(VWRK1(4)+VWRK1(5))
  344. DELTT=VMS1-T0
  345. ZM1=VWRK1(6)
  346. ZM2=ZAN*(1.D0-EXP(BETA*DELTT))
  347. IF (ZM2.GT.ZM1) THEN
  348. VWRK2(6)=ZM2
  349. ELSE
  350. VWRK2(6)=ZM1
  351. ENDIF
  352. C
  353. C FIN MODIF MM
  354. C
  355. tem_00 = BETA * DELTT
  356. C
  357. C MODIF DE LB
  358. C
  359. C POUR GARDER L'AUSTENITE POSITIVE
  360. C
  361. IF ((VWRK2(4)+VWRK2(5)+VWRK2(6)).GE.1.0) THEN
  362. VWRK2(6) = 1.d0 - (VWRK2(4)+VWRK2(5))
  363. VWRK2(3) = 0.d0
  364. ELSE
  365. VWRK2(3)=1.0D0 - (VWRK2(4)+VWRK2(5)+VWRK2(6))
  366. ENDIF
  367. C
  368. C FIN MODIF LB
  369. C
  370. ENDIF
  371. C
  372. RETURN
  373. END
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  

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