1C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
2C YTIME
3C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
4 SUBROUTINE YTIME(EG,HCOMP,HD,HL,HS1,HT,JCORE,M,DELTSY,
5 * * HR1,HR2,HR3,HR4,HR5,HR6,HR7,HR8,HR9,HR10,HR11,HR12,HR13,
6C * HF1,HF2,QDP,QDT,JXBEG) ! KC 2025-05-31
7 * * HF1,HF2,JXBEG)
8C 10/15/26 MHP via Claude
9C code changed to take JSON from DIMENSIONS_MOD instead of declaring
10C PARAMETER(JSON=5000) here.
11 USE DIMENSIONS_MOD
12C 10/14/26 MHP via Claude
13C code changed to convert COMMON/NMLPAR/ into NMLPAR_MOD.
14 USE NMLPAR_MOD
15C 10/14/26 MHP via Claude
16C code changed to convert COMMON/CONSTANTS/ into CONSTANTS_MOD.
17 USE CONSTANTS_MOD
18C 10/20/26 MHP via Claude
19C code changed to replace implicit typing with IMPLICIT NONE and
20C explicit declarations.
21 IMPLICIT NONE
22 REAL*8 BE7MFLOC,DELTSY,DL,E,EALPCA,ECA,EG,EGG11,EGG22,EGG33,EGG44,
23 * * EGG55,ENU,HCOMP,HD,HF1,HF2,HL,HR1,HR10,HR11,HR12,HR13,HR2,
24 * * HR3,HR4,HR5,HR6,HR7,HR8,HR9,HS1,HT,HTMAX,QED,QET,SUM1,TL,X,
25 * * XBE9,XC12,XC13,XH2,XHE3,XLI6,XLI7,XN14,XN15,XO16,XO17,XO18,
26 * * Y,YCORE,Z,DYDT
27 INTEGER IT,ITMAX,IU,J,JCORE,JXBEG,M
28C CENTRAL Y BELOW WHICH THE CORE CRITERION IS DROPPED IN THE SHELL BRANCH.
29C BELOW EVERY END_YCEN IN USE (1D-4, 1D-3); A CO CORE HAS Y AT OR NEAR 0
30C AND IS LEFT TO THE SHELL LIMITS.
31 REAL*8 YFLOOR
32 PARAMETER (YFLOOR = 1.0D-5)
33C 10/12/26 MHP via Claude
34C code changed to extend COMMON/NMLPAR/ to 234 members, adding the
35C namelist variables that the physics routines read from 27 COMMON
36C blocks which also held derived or working members. Those blocks keep
37C only their non-namelist members; five of them -- NEWMX, VMULT,
38C PMMWIND, CCOUT1 and ENVGEN -- had nothing left and are gone.
39C Derivation-only namelist variables from the same blocks went to
40C COMMON/NMLBYPASS/ instead, not here.
41C
42C Declared identically in all 121 files that hold any of these members.
43C Generated from one member list, so every copy is byte-identical; the
44C linker's 'size of symbol changed' warning is the check that they are.
45C 10/13/26 MHP via Claude
46C code changed to drop COMMON/CTLIM/, declared here but never used.
47C 9/25/26 MHP via Claude
48C code changed to merge COMMON/CONST/, COMMON/CONST1/, COMMON/CONST2/,
49C and COMMON/CONST3/ into a single COMMON/CONSTANTS/
50C MHP 10/02 added missing common block
51C 10/13/26 MHP via Claude
52C code changed to replace COMMON/NEWEPS/ with explicit arguments: engeb.f
53C computes EALPCA and ENU, and coefft.f and ytime.f read them right after
54C their own CALL ENGEB, so they are returned as arguments. main.f, the
55C third caller, passes locals it does not use.
56 DIMENSION HCOMP(15,JSON),HD(JSON),HL(JSON),HS1(JSON),
57 * * HT(JSON),EG(6)
58 DIMENSION HR1(JSON),HR2(JSON),HR3(JSON),HR4(JSON),HR5(JSON),
59 * *HR6(JSON),HR7(JSON),HR8(JSON),HR9(JSON),HR10(JSON),HR11(JSON),
60 * *HR12(JSON),HR13(JSON),HF1(JSON),HF2(JSON)
61 SAVE
62C STARS WITH A HELIUM LUMINOSITY HAVE A TIMESTEP LIMIT
63C BASED ON THE TIME REQUIRED TO BURN ATIME(4) OF Y AT THE
64C MAXIMUM IN TEMPERATURE OR THE FRACTION ATIME(5) OF Y AT THIS POINT.
65C TEST FOR HELIUM FLASH BURNING; HIGH CENTRAL DENSITY IS TAKEN AS
66C A SIGN THAT THE MODEL IS A GIANT UNDERGOING A HE FLASH RATHER THAN
67C A HORIZONTAL BRANCH STAR.
68C DATA Q3A,QCA/5.85D17,1.7276D18/
69 IF (HD(1).GE.5.0D0) THEN
70C SEARCH FOR TEMPERATURE MAXIMUM
71 HTMAX = 0.0D0
72 ITMAX = 1
73 DO 210 IT = 1,M
74 IF (HT(IT).GT.HTMAX) THEN
75 ITMAX = IT
76 HTMAX = HT(IT)
77 ENDIF
78 210 210 CONTINUE
79C CALCULATE HELIUM BURNING RATE AT TMAX
80 DL = HD(ITMAX)
81 TL = HT(ITMAX)
82 X = HCOMP(1,ITMAX)
83 Y = HCOMP(2,ITMAX)
84 Z = HCOMP(3,ITMAX)
85 XHE3 = HCOMP(4,ITMAX)
86 XC12 = HCOMP(5,ITMAX)
87 XC13 = HCOMP(6,ITMAX)
88 XN14 = HCOMP(7,ITMAX)
89 XN15 = HCOMP(8,ITMAX)
90 XO16 = HCOMP(9,ITMAX)
91 XO17 = HCOMP(10,ITMAX)
92 XO18 = HCOMP(11,ITMAX)
93 IF(LEXCOM) THEN
94 XH2 = HCOMP(12,ITMAX)
95 XLI6 = HCOMP(13,ITMAX)
96 XLI7 = HCOMP(14,ITMAX)
97 XBE9 = HCOMP(15,ITMAX)
98 ENDIF
99 IU = ITMAX
100C 10/13/26 MHP via Claude
101C code changed to pass BE7MFLOC for ENGEB's new BE7MASSFRACTION
102C argument, which replaces COMMON/BE7/. This routine does not use the
103C value; only main.f reads it.
104 CALL ENGEB(EGG11,EGG22,EGG33,EGG44,EGG55,QED,QET,SUM1,DL,
105C * TL,QDT,QDP,X,Y,Z,XHE3,XC12,XC13,XN14,XN15,XO16,XO17,
106C * XO18,XH2,XLI6,XLI7,XBE9,IU,HR1,HR2,HR3,HR4,HR5,HR6,HR7, ! KC 2025-05-31
107 * * TL,X,Y,XHE3,XC12,XC13,XN14,XO16,
108 * * XO18,XH2,IU,HR1,HR2,HR3,HR4,HR5,HR6,HR7,
109 * * HR8,HR9,HR10,HR11,HR12,HR13,HF1,HF2,BE7MFLOC,EALPCA,ENU)
110 E = SUM1
111 EG(1) = EGG11
112 EG(2) = EGG22
113 EG(3) = EGG33
114 EG(4) = EGG44
115 EG(5) = EGG55
116 EG(6) = ENU
117 ECA = EALPCA
118 IF(EG(5).LT.1.D-22) EG(5) = 1.D-22
119 DELTSY=1.0D15/EG(5)
120 ELSE
121C SET LIMITS ON HE BURNING FOR NON-HELIUM FLASH STARS
122 YCORE = 1D0 - HCOMP(3,JCORE)
123 IF(YCORE.GE.ATIME(1)) THEN
124
125 DELTSY = MIN(ATIME(4),ATIME(5)*YCORE)
126C
127 DELTSY = (5.85D17/CLSUN)*DELTSY*(HS1(JCORE)/HL(JCORE))
128
129 ELSE
130C 10/30/26 MHP via Claude
131C code changed to give the shell branch real limits. It used to rescale
132C DELTSY, which held HTIMER's saved He timestep in seconds, as if it were
133C an amount of Y, so below ATIME(1) the He limit was meaningless and the
134C step grew through core He exhaustion. ATIME(12) and ATIME(14) were
135C read from the namelist but never used. Now the step is the minimum of:
136C - ATIME(14) Msun of He burned, at the luminosity of the H-free core;
137C - ATIME(12) of Y burned at any He-rich point (Y >= ATIME(1)) hot
138C enough to burn He (T >= TCUT(4));
139C - ATIME(5) of the remaining core He, the core criterion without its
140C absolute cap, while YCORE > YFLOOR. This resolves central He
141C exhaustion down to the END_YCEN stop.
142 DELTSY = 1.0D20
143 IF(JXBEG.GT.1) THEN
144 IF(HL(JXBEG-1).GT.0.0D0) DELTSY =
145 * * (5.85D17/CLSUN)*ATIME(14)*CMSUN/HL(JXBEG-1)
146 ENDIF
147 DO 220 J = 1,M
148 IF(HT(J).LT.TCUT(4) .OR. HCOMP(2,J).LT.ATIME(1)) GOTO 220
149 DL = HD(J)
150 TL = HT(J)
151 X = HCOMP(1,J)
152 Y = HCOMP(2,J)
153 XHE3 = HCOMP(4,J)
154 XC12 = HCOMP(5,J)
155 XC13 = HCOMP(6,J)
156 XN14 = HCOMP(7,J)
157 XO16 = HCOMP(9,J)
158 XO18 = HCOMP(11,J)
159 XH2 = 0.0D0
160 IF(LEXCOM) XH2 = HCOMP(12,J)
161 IU = J
162 CALL ENGEB(EGG11,EGG22,EGG33,EGG44,EGG55,QED,QET,SUM1,DL,
163 * * TL,X,Y,XHE3,XC12,XC13,XN14,XO16,
164 * * XO18,XH2,IU,HR1,HR2,HR3,HR4,HR5,HR6,HR7,
165 * * HR8,HR9,HR10,HR11,HR12,HR13,HF1,HF2,BE7MFLOC,
166 * * EALPCA,ENU)
167C RATE OF Y CONSUMPTION: 3-ALPHA AND ALPHA CAPTURES
168 DYDT = MAX(EGG55,0.0D0)/5.85D17 + MAX(EALPCA,0.0D0)/1.7276D18
169 IF(DYDT.GT.0.0D0) DELTSY = MIN(DELTSY,ATIME(12)*Y/DYDT)
170 220 220 CONTINUE
171 IF(YCORE.GT.YFLOOR .AND. HL(JCORE).GT.0.0D0) DELTSY =
172 * * MIN(DELTSY,(5.85D17/CLSUN)*ATIME(5)*YCORE*
173 * * (HS1(JCORE)/HL(JCORE)))
174
175C
176 ENDIF
177C
178 ENDIF
179
180 RETURN
181 END
1"""Python version of ytime.f (YREC 7be4133): the time step allowed by
2helium burning."""
3
4from pyrec import constants_mod
5import numpy as np
6from pyrec import nmlpar_mod
7from pyrec.engeb import engeb
8
9# SAVE: the extended-composition abundances keep their values between
10# calls, so that without LEXCOM ENGEB gets the last ones set (or 0)
11# (Fortran line 61).
12xh2 = 0.0
13xli6 = 0.0
14xli7 = 0.0
15xbe9 = 0.0
16
17# Central Y below which the core criterion is dropped in the shell branch
18# (Fortran lines 31–32).
19YFLOOR = 1.0e-5
20
21
22def ytime(eg: np.ndarray, hcomp: np.ndarray, hd: np.ndarray, hl: np.ndarray, hs1: np.ndarray, ht: np.ndarray,
23 jcore: int, m: int, deltsy: float, hr1: np.ndarray, hr2: np.ndarray, hr3: np.ndarray, hr4: np.ndarray,
24 hr5: np.ndarray, hr6: np.ndarray, hr7: np.ndarray, hr8: np.ndarray, hr9: np.ndarray, hr10: np.ndarray,
25 hr11: np.ndarray, hr12: np.ndarray, hr13: np.ndarray, hf1: np.ndarray, hf2: np.ndarray, jxbeg: int) -> float:
26 """The helium-burning time step DELTSY: in the helium flash (central
27 log rho >= 5), 1e15 over the triple-alpha rate at the temperature
28 maximum; otherwise the time to burn a fraction of the core's helium,
29 or, below ATIME(1), the smallest of the shell and core limits.
30
31 Translates: ytime.f#YTIME (7be4133)
32
33 Arguments: the energy rates eg(1..6) (set here, in the flash), the model
34 (hcomp, hd = log rho, hl, hs1 = m, ht = log T, jcore, m, jxbeg), the
35 step deltsy, and the rate work arrays hr1..hr13, hf1, hf2 passed on to
36 ENGEB. Returns deltsy.
37
38 """
39
40 global xh2, xli6, xli7, xbe9
41 n = nmlpar_mod
42
43 if hd[1] >= 5.0:
44 # Helium flash: find the temperature maximum (Fortran lines 69–78).
45 htmax = 0.0
46 itmax = 1
47 for it in range(1, m + 1): # label 210
48 if ht[it] > htmax:
49 itmax = it
50 htmax = ht[it]
51
52 # The composition there (Fortran lines 80–99).
53 dl = hd[itmax]
54 tl = ht[itmax]
55 x = hcomp[1, itmax]
56 y = hcomp[2, itmax]
57 z = hcomp[3, itmax] # noqa: F841 (unused in the Fortran too)
58 xhe3 = hcomp[4, itmax]
59 xc12 = hcomp[5, itmax]
60 xc13 = hcomp[6, itmax]
61 xn14 = hcomp[7, itmax]
62 xn15 = hcomp[8, itmax] # noqa: F841 (unused in the Fortran too)
63 xo16 = hcomp[9, itmax]
64 xo17 = hcomp[10, itmax] # noqa: F841 (unused in the Fortran too)
65 xo18 = hcomp[11, itmax]
66 if n.lexcom:
67 xh2 = hcomp[12, itmax]
68 xli6 = hcomp[13, itmax]
69 xli7 = hcomp[14, itmax]
70 xbe9 = hcomp[15, itmax]
71 iu = itmax
72
73 # The energy rates at the temperature maximum; ENGEB's set scalars
74 # are passed in with any value, and BE7MFLOC is not used here
75 # (Fortran lines 104–117).
76 (egg11, egg22, egg33, egg44, egg55, qed, qet, sum1, be7mfloc,
77 ealpca, enu) = engeb(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, dl,
78 tl, x, y, xhe3, xc12, xc13, xn14, xo16,
79 xo18, xh2, iu, hr1, hr2, hr3, hr4, hr5, hr6,
80 hr7, hr8, hr9, hr10, hr11, hr12, hr13, hf1,
81 hf2, 0.0, 0.0, 0.0)
82 e = sum1 # noqa: F841 (unused in the Fortran too)
83 eg[1] = egg11
84 eg[2] = egg22
85 eg[3] = egg33
86 eg[4] = egg44
87 eg[5] = egg55
88 eg[6] = enu
89 eca = ealpca # noqa: F841 (unused in the Fortran too)
90
91 # The step: 1e15 erg/g over the triple-alpha rate (Fortran lines
92 # 118–119).
93 # Question (see the page): the constant 1e15 and the floor 1e-22.
94 if eg[5] < 1.0e-22:
95 eg[5] = 1.0e-22
96 deltsy = 1.0e15 / eg[5]
97
98 else:
99 # Limits on helium burning for stars outside the flash: the core
100 # criterion (Fortran lines 122–127).
101 # Question (see the page): 1 - Z is X + Y, not Y.
102 ycore = 1.0 - hcomp[3, jcore]
103 if ycore >= n.atime[1]:
104 deltsy = min(n.atime[4], n.atime[5] * ycore)
105 deltsy = ((5.85e17 / constants_mod.clsun) * deltsy
106 * (hs1[jcore] / hl[jcore]))
107
108 else:
109 # The shell branch: atime[14] solar masses of helium at the
110 # luminosity just below the hydrogen shell (Fortran lines
111 # 142–146).
112 deltsy = 1.0e20
113 if jxbeg > 1:
114 if hl[jxbeg - 1] > 0.0:
115 deltsy = ((5.85e17 / constants_mod.clsun) * n.atime[14]
116 * constants_mod.cmsun / hl[jxbeg - 1])
117
118 # The fraction atime[12] of Y at each helium-burning point
119 # (Fortran lines 147–170).
120 for j in range(1, m + 1): # label 220
121 if ht[j] < n.tcut[4] or hcomp[2, j] < n.atime[1]:
122 continue
123 dl = hd[j]
124 tl = ht[j]
125 x = hcomp[1, j]
126 y = hcomp[2, j]
127 xhe3 = hcomp[4, j]
128 xc12 = hcomp[5, j]
129 xc13 = hcomp[6, j]
130 xn14 = hcomp[7, j]
131 xo16 = hcomp[9, j]
132 xo18 = hcomp[11, j]
133 xh2 = 0.0
134 if n.lexcom:
135 xh2 = hcomp[12, j]
136 iu = j
137 (egg11, egg22, egg33, egg44, egg55, qed, qet, sum1,
138 be7mfloc, ealpca, enu) = engeb(
139 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, dl, tl, x, y,
140 xhe3, xc12, xc13, xn14, xo16, xo18, xh2, iu, hr1, hr2,
141 hr3, hr4, hr5, hr6, hr7, hr8, hr9, hr10, hr11, hr12,
142 hr13, hf1, hf2, 0.0, 0.0, 0.0)
143 # Rate of Y consumption: 3-alpha and alpha captures.
144 dydt = max(egg55, 0.0) / 5.85e17 + max(ealpca, 0.0) / 1.7276e18
145 if dydt > 0.0:
146 deltsy = min(deltsy, n.atime[12] * y / dydt)
147
148 # The core criterion without its cap, while helium is left at
149 # the center (Fortran lines 171–173).
150 if ycore > YFLOOR and hl[jcore] > 0.0:
151 deltsy = min(deltsy, (5.85e17 / constants_mod.clsun)
152 * n.atime[5] * ycore * (hs1[jcore] / hl[jcore]))
153
154 return deltsy