Notebook Archive

Browse Categories
About
Contribute

Filter

Apply

Academic Articles & Supplements

Arrhenius Activation Energy and Transitivity in Fission-Track Annealing Equations

Matheus Rufino, Sandro Guedes

Author

Matheus Rufino, Sandro Guedes

Title

Arrhenius Activation Energy and Transitivity in Fission-Track Annealing Equations

Description

Script to obtain Fission-Track annealing equations (Arrhenius activation energy, transitivity)

Arrhenius Activation Energy and Transitivity in Fission-Track Annealing Equations

Matheus Rufino and Sandro Guedes

In[]:=

Clear[c,f,T,t,R,g,r,fr,n,Ea,lnk,lnt,fβ,γ,ptsIso,setSpec,pltArrhenius,pltPseudoArrhenius,pltEa,pltγ,durangodata,durangoPsArrh,DurangoPoints,FP,k,α,β,g2,fK,Ketlnt,Kettblr,KetpseudoFA,KetpseudoFCA]

In[]:=

(**Equations**)

In[]:=

g[r_]=Log[1-r];fr[r_]=

(1-r)

;c={{5.631017,-4.910332,-8.51756,-12.80664},{0.186520,0.194445,0.12659,0.23109},{-10.455390,-9.610091,-20.99225,-41.37987},{0,0,0.29845,-1.20490}};R=1.987204258

-3

;f[t_,T_]={c[[1,1]]+c[[2,1]]Log[t]+c[[3,1]]/(RT),c[[1,2]]+c[[2,2]]Log[t]+c[[3,2]]Log[1/(RT)],c[[1,3]]+c[[2,3]]((Log[t]-c[[3,3]])/(1/(RT)-c[[4,3]])),c[[1,4]]+c[[2,4]]((Log[t]-c[[3,4]])/(Log[1/(RT)]-c[[4,4]]))};lnk[t_,T_,n_]=Log[

∂

f[t,T]]-(n-1)f[t,T];lnt[t_,T_]=Table[Simplify[Solve[f[t,T][[i]]==g[r],Log[t]][[1,1,2]]],{i,1,4,1}]-Log[3600];Ea[t_,T_,n_]=Simplify[-R(D[Log[

∂

f[t,T]]-(n-1)f[t,T],T]/D[1/T,T])];fβ[t_,T_]=f[t,T]/.T->1/(βR);γ[t_,β_,n_]=Simplify

-1

(n-1)

∂

fβ[t,T]-

∂

Log[

∂

fβ[t,T]]

;

In[]:=

{{"lnk","lnt","Ea","γ"},{lnk[t,T,n],lnt[t,T],Ea[t,T,n],γ[t,T,n]}}//TableForm

Out[]//TableForm=

lnk

lnt

Log

0.18652

-(-1+n)5.63102-

5261.36

+0.18652Log[t]

Log

0.194445

-(-1+n)-4.91033+0.194445Log[t]-9.61009Log

503.22



-(-1+n)-8.51756+

0.12659(20.9923+Log[t])

-0.29845+

503.22

+Log

0.12659

t-0.29845+

503.22





-(-1+n)-12.8066+

0.23109(41.3799+Log[t])

1.2049+Log

503.22



+Log

0.23109

t1.2049+Log

503.22





-38.3786+

28208.

+5.36136Log[1.-1.r]

324.527+5.14284Log[1.-1.r]+49.4232Log



-Log[3600]+

33858.9-41.0733T+(3975.19-2.35761T)Log[1.-1.r]

-Log[3600]+4.327327.42593+Log

12.8066+1.Log[1.-1.r]-

9.56247

7.42593+Log



-10.4554(-1+n)

-0.0190972(-1.+n)T

1.4212T(-3975.19+(-18.6346+20.9923n)T+(-1.+1.n)TLog[t])

(1686.11-1.T)

0.000459223T-73.5142+41.3799n+(-1.+1.n)Log[t]-4.32732Log



7.42593+Log



0.0956444

-1.+n

0.104057T

-1.+n

(0.29845-1.T)

2.35896-2.65741n+1.T+(0.12659-0.12659n)Log[t]

4.32732T

(1.2049+Log[T])

-46.5939+41.3799n+(-1.+1.n)Log[t]-4.32732Log[T]

In[]:=

(**Pseudo-Arrhenius**)

In[]:=

g2[r_,β_,α_]:=

(1-

)β

-1

In[]:=

cK={{-21.589968,-62.8742},{0.000796839,1.3060},{-21.259381,-85.4861},{0.000558969,-8.3589}};β={-10.058835,-9.1435};α={-0.34055399,-0.3900};fK[t_,T_]=cK[[1,1]]+cK[[2,1]]

Log[t]-cK[[3,1]]

(1/T)-cK[[4,1]]

,cK[[1,2]]+cK[[2,2]]

Log[t]-cK[[3,2]]

Log[(1/T)]-cK[[4,2]]

;Ketlnt[t_,T_]=Table[Solve[fK[t,T][[i]]==g2[r,β[[i]],α[[i]]],Log[t]][[1,1,2]],{i,1,2,1}]-Log[3600];Kettblr=Table[Table[Ketlnt[t,T][[i]],{r,{0.55,0.93}}],{i,1,2,1}];KetpseudoFA=Simplify[Table[Kettblr[[1,i]],{i,1,2,1}]]/.

-3

T;KetpseudoFCA=Simplify[Table[Kettblr[[2,i]],{i,1,2,1}]]/.

-3

T;pltPseudoArrheniusKet={Plot[KetpseudoFA,{T,0.55,5},PlotStyle{{Dashed,Thickness[0.0080]}},LabelStyle->Directive[FontSize->22],PlotLegends->Placed[{"Ketcham et al.(2007)","Ketcham et al.(2007)"},Scaled[{0.35,0.85}]]],Plot[KetpseudoFCA,{T,0.,5},PlotStyle{{Dashed,Thickness[0.0080]}},LabelStyle->Directive[FontSize->22],PlotLegends->Placed[{"Ketcham et al.(2007)","Ketcham et al.(2007)"},Scaled[{0.35,0.85}]]]};

durangodata=Import["DadosDurangoLcMod.CSV","Dataset","HeaderLines"->1];(**PRECISAARRUMARESSELINK**)durangoPsArrh=Table

durangodata[[i,6]]

,N[Log[durangodata[[i,1]]]],durangodata[[i,7]],{i,1,82};DurangoPoints=ListPlot[{Select[durangoPsArrh,(#[[3]]>.9)&][[;;,1;;2]],Select[durangoPsArrh,(0.8<#[[3]]<.9)&][[;;,1;;2]],Select[durangoPsArrh,(0.7<#[[3]]<.8)&][[;;,1;;2]],Select[durangoPsArrh,(#[[3]]<.7)&][[;;,1;;2]]},PlotStyle{Blue,Red,Blue,Red},PlotMarkers{"OpenMarkers",12},LabelStyleDirective[Bold,FontSize->22],PlotLegendsPlaced[{"r > 0.9","0.8 < r < 0.9","0.7 < r < 0.8","0.6 < r < 0.7"},Scaled[{0.8,0.2}]]];(**ImportDurangoDatafromCloud**)

In[]:=

SetAttributes[setSpec,HoldAllComplete]setSpec[s_Symbol,spec__]:=s/:h_[pre__,s,post___]:=h[pre,spec,post]setSpec[ops1,Frame->True,LabelStyle->Directive[FontSize->30],ImageSize->Large,FrameStyle->Thickness[.005],AspectRatio->0.8,PlotStyle->{{Thickness[0.0080]}},PlotRange->{{0,4},{-50,55}},FrameLabel->{"1000/T [

-1

]","ln(t) [h]"},AxesOrigin->{0,-45},Epilog->{Text[Style["r = 0.55",25],Scaled[{0.25,0.5}]],Text[Style["r = 0.93",25],Scaled[{0.5,0.35}]]},PlotTheme->"Scientific"]

In[]:=

tblr=TableTable[lnt[t,T][[i]],{r,{0.55,0.93}}]/.1T->

-3

T,T->

T,{i,1,4,1};pseudoPA=Table[tblr[[1,i]],{i,1,2,1}];pseudoPC=Table[tblr[[2,i]],{i,1,2,1}];pseudoFA=Table[tblr[[3,i]],{i,1,2,1}];pseudoFCA=Table[tblr[[4,i]],{i,1,2,1}];

In[]:=

pltPseudoArrhenius={Plot[pseudoPA,{T,0,5},ops1],Plot[pseudoPC,{T,0,4},ops1],Plot[pseudoFA,{T,0.57,4},ops1],Plot[pseudoFCA,{T,0,4},ops1]};

In[]:=

(**Arrhenius-space**)

In[]:=

setSpec[ops2,Frame->True,LabelStyle->Directive[FontSize->30],ImageSize->Large,FrameStyle->Thickness[.005],AspectRatio->0.8,PlotStyle->{{Thickness[0.0080]}},FrameLabel->{"1000/T [

-1

]","ln(k)"}]setSpec[ops22,JoinedTrue,PlotMarkers{"OpenMarkers",6},PlotStyle{Red,Purple},LabelStyleDirective[FontSize->30],LabelStyleDirective[Bold,FontSize->22],PlotLegendsPlaced[{"r = 0.4","r = 0.9"},Scaled[{0.2,0.2}]]]

In[]:=

ptsIso[t_,ri_,n_,i_]:=

1000

NSolve[g[ri]==f[t,T][[i]],T][[1,1,2]]

,lnk[t,NSolve[g[ri]==f[t,T][[i]],T][[1,1,2]],n][[i]]

In[]:=

tr=Table[36

-9

,{n,0,40,1}];(**Listoftimes**)

In[]:=

tlab=1003600;tgeo=9.4608

;

In[]:=

Isoptscalc[n_]=Table[{Table[ptsIso[t,0.4,n,i],{t,tr}],Table[ptsIso[t,0.9,n,i],{t,tr}]},{i,1,4,1}];

NSolve

:Inverse functions are being used by NSolve, so some solutions may not be found; use Reduce for complete solution information.

NSolve

:Inverse functions are being used by NSolve, so some solutions may not be found; use Reduce for complete solution information.

NSolve

:Inverse functions are being used by NSolve, so some solutions may not be found; use Reduce for complete solution information.

General

:Further output of NSolve::ifun will be suppressed during this calculation.

In[]:=

pltArrhenius[n_,FP_]:=JoinTableShowPlotlnktlab,

1000

,n[[i]],lnktgeo,

1000

,n[[i]],{T,0,4},PlotStyle{{Gray,Thickness[0.0080]}},ops2,Epilog->{Text[Style["Time independent",25],Scaled[{0.5,0.8}]]},ListPlot[{Isoptscalc[n][[i,1]],Isoptscalc[n][[i,2]]},ops22],{i,1,2,1},TableShowPlotlnktlab,

1000

,n[[i]],lnktgeo,

1000

,n[[i]],{T,FP,5},PlotRange->{{0,4},{-100,50}},ops2,PlotLegends->Placed[{"t = 100 h","t = 30 Ma"},Scaled[{0.8,0.85}]],PlotTablelnktlab*

1000

,n[[i]],{j,1,14},{T,FP,8},PlotRange->{{0,4},Automatic},PlotStyleDirective[Opacity[0.2],Black],ListPlot[{Select[Isoptscalc[n][[i,1]],(FP<#[[1]]&)[[;;,1;;2]]],Select[Isoptscalc[n][[i,2]],(FP<#[[1]]&)[[;;,1;;2]]]},ops22],{i,3,4,1}

In[]:=

(**Arrheniusactivationenergy**)

In[]:=

setSpec[ops3,Frame->True,LabelStyle->Directive[FontSize->30],ImageSize->Large,FrameStyle->Thickness[.005],AspectRatio->0.8,PlotStyle->{{Thickness[0.0080]}},FrameLabel->{"T [K]","

[kcal/mol]"}]

In[]:=

pltEa[n_]:=Join[Table[Plot[{Ea[tlab,T,n][[i]],Ea[tgeo,T,n][[i]]},{T,250,650},PlotStyle{{Gray,Thickness[0.0080]}},ops3,Epilog->{Text[Style["Time independent",25],Scaled[{0.5,0.8}]]}],{i,1,2,1}],Table[Plot[{Ea[tlab,T,n][[i]],Ea[tgeo,T,n][[i]]},{T,250,650},ops3,PlotLegends->Placed[{"t = 100 h","t = 30 Ma"},Scaled[{0.2,0.8}]],PlotRange->{{250,650},{0,60}}],{i,3,4,1}]]

In[]:=

(**Transitivity**)

In[]:=

setSpec[ops4,LabelStyle->Directive[FontSize->30],ImageSize->Large,FrameStyle->Thickness[.005],AspectRatio->0.8,Frame->True,PlotRange->{{-0.01,2},{-0.05,0.05}},FrameLabel->{"β [mol/kcal]","γ (β) [mol/kcal]"},AxesOrigin->{0,-0.05}]

In[]:=

pltγ[n_]:=Join[{Plot[γ[tlab,β,n][[1]],{β,0,2},ops4,Epilog->{Text[Style["Arrhenius",25],Scaled[{0.5,0.75}]]},PlotStyle->{{Orange,Thickness[0.0080]},{Orange,Thickness[0.0080]}}]},{Plot[{γ[tlab,β,n][[2]],0},{β,0,10},ops4,Epilog->{Text[Style["Sub-Arrhenius",25],Scaled[{0.5,0.8}]],Text[Style["Arrhenius",25],Scaled[{0.5,0.55}]]},PlotRange->{{250,650},{0,60}},PlotStyle->{{Blue,Thickness[0.0080]},{Orange,Thickness[0.0080]}}]},Table[Show[Plot[{γ[tlab,β,n][[i]],γ[tgeo,β,n][[i]],0},{β,0.29845,2},PlotRange->{{-0.01,2},{-0.05,0.05}},ops4,PlotLegendsPlaced[{"t = 100 h","t = 30 Ma"},Scaled[{0.5,0.2}]],Epilog->{Text[Style["Sub-Arrhenius",25],Scaled[{0.2,0.8}]],Text[Style["Arrhenius",25],Scaled[{0.7,0.55}]]},PlotStyle->{{Blue,Thickness[0.0080]},{Blue,Dashed,Thickness[0.0080]},{Orange,Thickness[0.0080]}}],Plot[0,{β,0,2},PlotStyle{Orange,Thickness[0.0080]}]],{i,3,4,1}]]

In[]:=

Resultados[i_]:=Manipulate[{pltPseudoArrhenius[[i]],pltArrhenius[n][[i]],pltEa[n][[i]],pltγ[n][[i]]},{n,-5,0}]

Cite this as: Matheus Rufino, Sandro Guedes, "Arrhenius Activation Energy and Transitivity in Fission-Track Annealing Equations" from the Notebook Archive (2022), https://notebookarchive.org/2022-02-c067im0

Wolfram Foundation

Download