1C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
2C SCONVEC
3C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
4 SUBROUTINE SCONVEC(DELTS,HCOMP,HD,HL,HP,HR,HS,HT,M,MXZONE,NZONE,
5 * * TEFFL,CMIXL)
6C 10/15/26 MHP via Claude
7C code changed to take JSON from DIMENSIONS_MOD instead of declaring
8C PARAMETER(JSON=5000) here.
9 USE DIMENSIONS_MOD
10C 10/14/26 MHP via Claude
11C code changed to convert COMMON/DEBHU/ into DEBHU_MOD.
12 USE DEBHU_MOD
13C 10/14/26 MHP via Claude
14C code changed to convert COMMON/NMLPAR/ into NMLPAR_MOD.
15 USE NMLPAR_MOD
16C 10/14/26 MHP via Claude
17C code changed to convert COMMON/CONSTANTS/ into CONSTANTS_MOD.
18 USE CONSTANTS_MOD
19C 10/14/26 MHP via Claude
20C code changed to convert COMMON/IOUNITS/ into IOUNITS_MOD.
21 USE IOUNITS_MOD
22C 10/20/26 MHP via Claude
23C code changed to replace implicit typing with IMPLICIT NONE and
24C explicit declarations.
25 IMPLICIT NONE
26 REAL*8 AMU,B,BETA,BETA1,BETA14,CMIXL,D,DEL,DELA,DELR,DELR0,DELR1,
27 * * DELTS,DL,EMU,ETA,FDEL,FPL,FTL,FXION,HCOMP,HD,HL,HP,HR,HS,
28 * * HT,O,OL,P,PL,QACP,QACR,QACT,QAP,QAT,QCP,QCPP,QCPT,QDP,QDT,
29 * * QDTP,QDTT,QOD,QOT,RDIFF,RL,RMAX,RMU,RSUM,RVAL1,RVAL2,SL,T,
30 * * TEFFL,TL,VEL,X,XINTMU,Z
31 INTEGER I,II,ILOOP,IU,J,J2,JBEG,JEND,JMC,JMC2,JMR,JSTEP,K,K1,
32 * * KSAHA,M,MXZONE,NZONE
33 LOGICAL*4 LATMO,LCONV,LDERIV,LFLAGD,LFLAGU,LMAX,LOCOND,L_ONLY_CORE
34
35C 10/12/26 MHP via Claude
36C code changed to extend COMMON/NMLPAR/ to 234 members, adding the
37C namelist variables that the physics routines read from 27 COMMON
38C blocks which also held derived or working members. Those blocks keep
39C only their non-namelist members; five of them -- NEWMX, VMULT,
40C PMMWIND, CCOUT1 and ENVGEN -- had nothing left and are gone.
41C Derivation-only namelist variables from the same blocks went to
42C COMMON/NMLBYPASS/ instead, not here.
43C
44C Declared identically in all 121 files that hold any of these members.
45C Generated from one member list, so every copy is byte-identical; the
46C linker's 'size of symbol changed' warning is the check that they are.
47C 9/25/26 MHP via Claude
48C code changed to consolidate all I/O logical unit numbers, previously
49C scattered across COMMON/LUOUT/, COMMON/LUNUM/, COMMON/ALEX06/,
50C COMMON/ACDPTH/, COMMON/NEWOPAC/, COMMON/LOPAL95/, COMMON/ATMOS2/,
51C COMMON/ALATM03/, COMMON/OPALEOS/, and COMMON/SCV2/, into a single
52C COMMON/IOUNITS/
53C 9/25/26 MHP via Claude
54C code changed to merge COMMON/CONST/, COMMON/CONST1/, COMMON/CONST2/,
55C and COMMON/CONST3/ into a single COMMON/CONSTANTS/
56C 10/13/26 MHP via Claude: removed the unused COMMON/NEWOPAC/ declaration
57C (no member referenced here; residue of the obsolete-option removals).
58C DBG 7/92 COMMON BLOCK ADDED TO COMPUTE DEBYE-HUCKEL CORRECTION.
59 DIMENSION HCOMP(15,JSON),HD(JSON),HP(JSON),HR(JSON),HS(JSON),
60 * * HT(JSON),MXZONE(12,2),FXION(3),HL(JSON)
61 SAVE
62
63C SEMI-CONVECTION IS TESTED FOR ALL CONVECTIVE REGIONS IN THIS SUBROUTINE.
64C THE REFERENCE FOR THIS SECTION IS :
65C CASTELLANI ET AL.(1971)ASTROPHYSICS AND SPACE SCIENCE, VOL. 10, PP.340-349.
66C
67C AT THE EDGE OF ALL CONVECTIVE REGIONS, THE RADIATIVE TEMPERATURE GRADIENT
68C IS COMPUTED WITH BOTH THE LOCAL ABUNDANCES AND THOSE IN THE NEIGHBORING
69C CONVECTION ZONE. IF DEL(RAD)>DEL(AD) WHEN THE ABUNDANCES ARE PERTURBED,
70C THEN THE REGION IS CONSIDERED UNSTABLE TO THE GROWTH OF A SEMI-CONVECTIVE
71C REGION AND THE CODE COMPUTES ITS EXTENT.
72C
73C INPUT VARIABLES :
74C
75C DELTS : MODEL TIMESTEP (SECONDS)
76C HD,HL,HP,HR,HS,HT : MODEL RUN OF DENSITY, LUMINOSITY, PRESSURE, RADIUS,
77C MASS, AND TEMPERATURE.
78C HCOMP : MODEL RUN OF MASS FRACTIONS OF DIFFERENT CHEMICAL SPECIES;
79C HCOMP(1,...) IS HYDROGEN AND HCOMP(3,...) IS THE METALS.
80C MXZONE, NZONE : THE LOCATIONS OF THE EDGES OF CONVECTIVE REGIONS,
81C STORED IN PAIRS, AND THE NUMBER OF DISTINCT CONVECTION ZONES.
82C E.G. MXZONE(3,1) IS THE ID OF THE BOTTOM SHELL IN THE 3RD CZ FROM
83C THE CENTER AND MXZONE(3,2) IS THE ID OF THE TOP SHELL IN THE SAME CZ.
84C
85C OUTPUT VARIABLES :
86C
87C MXZONE, NZONE CAN BE ALTERED BY THE SUBROUTINE.
88C
89C RUN THROUGH ALL THE CONVECTION ZONES.
90c$$$ DO 210 I = 1,NZONE
91
92 L_ONLY_CORE = .TRUE.
93 IF(L_ONLY_CORE)THEN
94 ILOOP = 1
95 ELSE
96 ILOOP = NZONE
97 ENDIF
98 DO 210 I = 1,ILOOP
99
100
101C DETERMINE IF THIS REGION IS A CORE CONVECTION ZONE, SURFACE CZ,
102C OR INTERMEDIATE CZ.
103C LFLAGU IS T IF SEMICONVECTION ABOVE THE CZ NEEDS TO BE COMPUTED;
104C LFLAGD IS T IF SEMICONVECTION BELOW THE CZ NEEDS TO BE COMPUTED.
105 IF(MXZONE(I,1).EQ.1)THEN
106C CONVECTIVE CORE
107C CHECK FOR A FULLY CONVECTIVE STAR; SKIP THIS SUBROUTINE IF THERE IS ONE.
108 IF (MXZONE(I,2).EQ.M) RETURN
109 LFLAGU = .TRUE.
110 LFLAGD = .FALSE.
111 ELSE IF(MXZONE(I,2).EQ.M)THEN
112C CONVECTIVE ENVELOPE
113 LFLAGU = .FALSE.
114 LFLAGD = .TRUE.
115 ELSE
116C INTERMEDIATE CONVECTION ZONE (NOT INCLUDING CENTRAL OR SURFACE POINT).
117 LFLAGU = .TRUE.
118 LFLAGD = .TRUE.
119 ENDIF
120C CHECK SEMICONVECTION BELOW (K=1) AND ABOVE (K=2) THE CZ.
121 DO 200 K = 1,2
122C SKIP SEMI-CONVECTION BELOW A CENTRAL CZ AND ABOVE A SURFACE ONE.
123 IF(K.EQ.1.AND..NOT.LFLAGD) GOTO 200
124 IF(K.EQ.2.AND..NOT.LFLAGU) GOTO 200
125C JMC AND JMR ARE THE LOCATIONS OF THE EDGE OF THE CONVECTIVE ZONE
126C AND THE FIRST RADIATIVE POINT OUTSIDE IT RESPECTIVELY.
127 JMC = MXZONE(I,K)
128 IF(K.EQ.1) JMR = JMC - 1
129 IF(K.EQ.2) JMR = JMC + 1
130C SET UP FLAGS FOR CALLS TO THE BASIC PHYSICS ROUTINES.
131 LDERIV = .FALSE.
132 LOCOND = .TRUE.
133 LATMO = .TRUE.
134 KSAHA = 0
135C USE THE STRUCTURE VARIABLES FOR THE FIRST POINT OUTSIDE THE CZ
136C AND THE ABUNDANCES OF THE CZ TO DETERMINE THE MODIFIED MU AND
137C RADIATIVE AND ADIABATIC TEMPERATURE GRADIENTS.
138 B = HL(JMR)
139 SL = HS(JMR)
140 PL = HP(JMR)
141 TL = HT(JMR)
142 DL = HD(JMR)
143C MHP 10/02 added definition of RL
144 RL = HR(JMR)
145 X = HCOMP(1,JMC)
146 Z = HCOMP(3,JMC)
147C*** ADD ROTATION VECTORS ***
148 FPL = 1.0D0
149 FTL = 1.0D0
150 IU=JMC
151 IF (LDH) THEN
152 XXDH = HCOMP(1,JMC)
153 YYDH = HCOMP(2,JMC)+HCOMP(4,JMC)
154 ZZDH = HCOMP(3,JMC)
155 ZDH(1) = HCOMP(5,JMC)+HCOMP(6,JMC)
156 ZDH(2) = HCOMP(7,JMC)+HCOMP(8,JMC)
157 ZDH(3) = HCOMP(9,JMC)+HCOMP(10,JMC)+HCOMP(11,JMC)
158 END IF
159 CALL EQSTAT(TL,T,PL,P,DL,D,X,Z,BETA,BETA1,BETA14,FXION,
160 * * RMU,AMU,EMU,ETA,QDT,QDP,QCP,DELA,QDTT,QDTP,QAT,QAP,
161 * * QCPT,QCPP,LDERIV,LATMO,KSAHA)
162C DBG 12/95 GET OPACITY
163 CALL GETOPAC(DL, TL, X, Z, O, OL, QOD, QOT, FXION)
164 CALL TPGRAD(TL,T,PL,P,D,RL,SL,B,O,QDT,QDP,QOT,QOD,QCP,
165 * * DEL,DELR,DELA,QDTT,QDTP,QAT,QAP,QACT,QACP,QACR,QCPT,
166 * * QCPP,VEL,LDERIV,LCONV,FPL,FTL,TEFFL,CMIXL)
167C SKIP IF ZONE IS STABLE WITH THE CORE COMPOSITION.
168 IF(DELR.LT.DELA) GOTO 200
169C STORE MEAN MOLECULAR WEIGHT, ADJUSTED RADIATIVE TEMPERATURE GRADIENT,
170C AND THE QUANTITY (DELR - DELA)/DELR.
171 XINTMU = AMU + EMU
172 DELR1 = DELR
173 RMAX = 1.0D0 - DELA/DELR
174C REPEAT CALL WITH THE LOCAL COMPOSITION.
175 X = HCOMP(1,JMR)
176 Z = HCOMP(3,JMR)
177 IU=JMR
178 IF (LDH) THEN
179 XXDH = HCOMP(1,JMR)
180 YYDH = HCOMP(2,JMR)+HCOMP(4,JMR)
181 ZZDH = HCOMP(3,JMR)
182 ZDH(1) = HCOMP(5,JMR)+HCOMP(6,JMR)
183 ZDH(2) = HCOMP(7,JMR)+HCOMP(8,JMR)
184 ZDH(3) = HCOMP(9,JMR)+HCOMP(10,JMR)+HCOMP(11,JMR)
185 END IF
186 CALL EQSTAT(TL,T,PL,P,DL,D,X,Z,BETA,BETA1,BETA14,FXION,
187 * * RMU,AMU,EMU,ETA,QDT,QDP,QCP,DELA,QDTT,QDTP,QAT,QAP,
188 * * QCPT,QCPP,LDERIV,LATMO,KSAHA)
189C DBG 12/95 GET OPACITY
190 CALL GETOPAC(DL, TL, X, Z, O, OL, QOD, QOT, FXION)
191 CALL TPGRAD(TL,T,PL,P,D,RL,SL,B,O,QDT,QDP,QOT,QOD,QCP,
192 * * DEL,DELR,DELA,QDTT,QDTP,QAT,QAP,QACT,QACP,QACR,QCPT,
193 * * QCPP,VEL,LDERIV,LCONV,FPL,FTL,TEFFL,CMIXL)
194 HD(JMR) = DL
195C FDEL IS THE RATIO OF THE GRADIENTS WITH THE OLD COMP AND NEW ONE.
196 FDEL = DELR1/DELR
197 DELR0 = DELR
198C RMAX IS THE MAXIMUM RADIAL DISTANCE THAT OVERSHOOT MAY PENETRATE, AND
199C IS THE TIMESTEP(DELTS) MULTIPLIED BY THE VELOCITY OF PROPAGATION OF
200C THE INSTABILITY (VP IN EQUATION 5PRIME, P. 347).
201 RMAX = RMAX*(HL(JMC)*CLSUN/(10.0D0*C4PI*DEXP(CLN*HP(JMC))))
202 * * *(DELTS/DEXP(CLN*(HR(JMC)+HR(JMC))))
203C INITIALIZE SUM.
204 RSUM = 0.0D0
205C LMAX IS SET TO TRUE IF THE OVERSHOOT REACHES ITS MAXIMUM EXTENT.
206 LMAX = .FALSE.
207 IF(K.EQ.1)THEN
208 RVAL1 = EXP(CLN*HR(JMR+1))
209 JBEG = JMR-1
210 JEND = 1
211 JSTEP = -1
212 ELSE IF(K.EQ.2)THEN
213 RVAL1 = EXP(CLN*HR(JMR-1))
214 JBEG = JMR + 1
215 JEND = M
216 JSTEP = 1
217 ENDIF
218 DO 32 II = JBEG,JEND,JSTEP
219C TEST ON MAXIMUM OVERSHOOTING LIMIT IN RADIUS
220 IF(K.EQ.1) RVAL2 = EXP(CLN*HR(II+1))
221 IF(K.EQ.2) RVAL2 = EXP(CLN*HR(II-1))
222 RDIFF = RVAL2-RVAL1
223 RSUM = RSUM + (1.0D0 - XINTMU/(AMU+EMU))*RDIFF
224 RVAL1 = RVAL2
225 IF(RSUM.GT.RMAX) GO TO 33
226C TEST ON RESCALED RAD. GRADIENT FOR CONVECTION
227 B = HL(II)
228 SL = HS(II)
229 PL = HP(II)
230 TL = HT(II)
231 DL = HD(II)
232 X = HCOMP(1,II)
233 Z = HCOMP(3,II)
234 IU = II
235 IF (LDH) THEN
236 XXDH = HCOMP(1,II)
237 YYDH = HCOMP(2,II)+HCOMP(4,II)
238 ZZDH = HCOMP(3,II)
239 ZDH(1) = HCOMP(5,II)+HCOMP(6,II)
240 ZDH(2) = HCOMP(7,II)+HCOMP(8,II)
241 ZDH(3) = HCOMP(9,II)+HCOMP(10,II)+HCOMP(11,II)
242 END IF
243 CALL EQSTAT(TL,T,PL,P,DL,D,X,Z,BETA,BETA1,BETA14,FXION,
244 * * RMU,AMU,EMU,ETA,QDT,QDP,QCP,DELA,QDTT,QDTP,QAT,QAP,
245 * * QCPT,QCPP,LDERIV,LATMO,KSAHA)
246C DBG 12/95 GET OPACITY
247 CALL GETOPAC(DL, TL, X, Z, O, OL, QOD, QOT, FXION)
248 CALL TPGRAD(TL,T,PL,P,D,RL,SL,B,O,QDT,QDP,QOT,QOD,
249 * * QCP,DEL,DELR,DELA,QDTT,QDTP,QAT,QAP,QACT,QACP,
250 * * QACR,QCPT,QCPP,VEL,LDERIV,LCONV,FPL,FTL,TEFFL,
251 * * CMIXL)
252 HD(II) = DL
253C EXIT IF ZONE IS RADIATIVELY STABLE.
254 IF(FDEL*DELR.LT.DELA) GO TO 34
255 32 32 CONTINUE
256 IF(K.EQ.1) II = 0
257 IF(K.EQ.2) II = M + 1
258 33 33 LMAX = .TRUE.
259 34 34 CONTINUE
260C ASSIGN THE NEW EDGE LOCATION TO MXZONE.
261 IF(K.EQ.1)THEN
262 MXZONE(I,K) = II + 1
263 JMC2 = II + 1
264 ELSE IF(K.EQ.2)THEN
265 MXZONE(I,K) = II - 1
266 JMC2 = II - 1
267 ENDIF
268 WRITE(ISHORT,601) JMC,JMC2,LMAX,DELR1,DELR0
269 601 601 FORMAT(1X,'CZ OLD EDGE ',I3,' EXTENDED TO-',
270 * * I3,' LIMIT=',L1,' RAD.GRADS-IN/OUT',2F8.4)
271 200 200 CONTINUE
272 210 210 CONTINUE
273C CHECK FOR MERGERS OF NEARBY CONVECTION ZONES CAUSED BY SEMI-CONVECTION.
274 IF(NZONE.LE.1) RETURN
275 J = 1
276 85 85 CONTINUE
277C CHECK IF 'TOP' OF ONE REGION IS ABOVE 'BOTTOM' OF THE NEXT ONE.
278 IF(MXZONE(J,2).GT.MXZONE(J+1,1))THEN
279C IF THIS OCCURS, TWO CONVECTION ZONES HAVE MERGED.
280 WRITE(ISHORT,93)((MXZONE(K,K1),K1=1,2),K=J,J+1),MXZONE(J,1),
281 * * MXZONE(J+1,2)
282 93 93 FORMAT(2X,'MIXED ZONES MERGED DUE TO SEMICONVECTION'
283 * * /2X,'OLD',2('[',I3,'-',I3,']'),
284 * * ' NEW','[',I3,'-',I3,']')
285 MXZONE(J+1,1) = MXZONE(J,1)
286 DO 90 K = J,NZONE-1
287 DO 95 J2 = 1,2
288 MXZONE(K,J2) = MXZONE(K+1,J2)
289 95 95 CONTINUE
290 90 90 CONTINUE
291 NZONE = NZONE - 1
292 IF(J.LE.NZONE-1)THEN
293 GOTO 85
294 ELSE
295 RETURN
296 ENDIF
297 ENDIF
298 J = J + 1
299 IF (J.LE.NZONE-1)GOTO 85
300
301 RETURN
302 END1"""Python version of sconvec.f (YREC 7be4133): semiconvection at the
2edges of convection zones (Castellani et al. 1971), and the merging of
3zones that come to overlap."""
4
5import math
6
7import numpy as np
8
9from pyrec import constants_mod
10from pyrec import debhu_mod
11from pyrec import iounits_mod
12from pyrec import nmlpar_mod
13from pyrec.eqstat import eqstat
14from pyrec.getopac import getopac
15from pyrec.tpgrad import tpgrad
16
17# Local kept between calls (SAVE): the ionization fractions from eqstat.
18fxion = np.zeros(4)
19
20
21def _load_debhu(hcomp: np.ndarray, j: int) -> None:
22 """Load shell j's composition for the Debye-Hueckel correction in
23 eqstat (the block the Fortran repeats three times)."""
24
25 if nmlpar_mod.ldh:
26 debhu_mod.xxdh = hcomp[1, j]
27 debhu_mod.yydh = hcomp[2, j] + hcomp[4, j]
28 debhu_mod.zzdh = hcomp[3, j]
29 debhu_mod.zdh[1] = hcomp[5, j] + hcomp[6, j]
30 debhu_mod.zdh[2] = hcomp[7, j] + hcomp[8, j]
31 debhu_mod.zdh[3] = hcomp[9, j] + hcomp[10, j] + hcomp[11, j]
32
33
34def _gradients(tl: float, pl: float, dl: float, rl: float, sl: float, b: float, x: float, z: float, lderiv: bool,
35 latmo: bool, ksaha: int, fpl: float, ftl: float, teffl: float,
36 cmixl: float) -> tuple[float, float, float, float, float]:
37 """EQSTAT, GETOPAC and TPGRAD at one point (repeated three times in
38 the Fortran). Returns (dl, amu, emu, dela, delr)."""
39
40 (t, p, dl, d, beta, beta1, beta14, rmu, amu, emu, eta, qdt, qdp,
41 qcp, dela, qdtt, qdtp, qat, qap, qcpt, qcpp, ksaha) = eqstat(
42 tl, 0.0, pl, 0.0, dl, 0.0, x, z, 0.0, 0.0, 0.0, fxion, 0.0, 0.0,
43 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
44 lderiv, latmo, ksaha)
45 o, ol, qod, qot = getopac(dl, tl, x, z, 0.0, 0.0, 0.0, 0.0, fxion)
46 (dele, delr, qact, qacp, qacr, vel, lconv) = tpgrad(
47 tl, t, pl, p, d, rl, sl, b, o, qdt, qdp, qot, qod, qcp, 0.0,
48 0.0, dela, qdtt, qdtp, qat, qap, 0.0, 0.0, 0.0, qcpt, qcpp,
49 0.0, lderiv, False, fpl, ftl, teffl, cmixl)
50 return dl, amu, emu, dela, delr
51
52
53def sconvec(delts: float, hcomp: np.ndarray, hd: np.ndarray, hl: np.ndarray, hp: np.ndarray, hr: np.ndarray,
54 hs: np.ndarray, ht: np.ndarray, m: int, mxzone: np.ndarray, nzone: int, teffl: float, cmixl: float) -> int:
55 """Test the edges of the first convection zone (L_ONLY_CORE) for
56 semiconvection and extend the zone where the region next to it is
57 unstable, as far as the propagation speed allows in one step; then
58 merge zones that overlap.
59
60 Translates: sconvec.f#SCONVEC (7be4133)
61
62 Arguments: the step delts (s); hcomp[species, shell]; the model's hd
63 (log rho; overwritten at the shells tested), hl (L/Lsun), hp, hr, hs,
64 ht (logs); m shells; the zones mxzone[k, 1..2] (changed in place) and
65 their count nzone; teffl; cmixl, the mixing length (for tpgrad).
66
67 Returns nzone (reduced by mergers).
68
69 """
70
71 c = constants_mod
72
73 # Only the first zone (Fortran lines 89–98).
74 # Question (see the page): only the first zone is tested.
75 l_only_core = True
76 if l_only_core:
77 iloop = 1
78 else:
79 iloop = nzone
80 for i in range(1, iloop + 1): # loop 210
81 # Core, surface or intermediate zone: LFLAGU (test above),
82 # LFLAGD (test below) (Fortran lines 101–119).
83 if mxzone[i, 1] == 1:
84 # Convective core; skip a fully convective star.
85 if mxzone[i, 2] == m:
86 return nzone
87 lflagu = True
88 lflagd = False
89 elif mxzone[i, 2] == m:
90 lflagu = False
91 lflagd = True
92 else:
93 lflagu = True
94 lflagd = True
95
96 for k in (1, 2): # loop 200
97 # Fortran lines 120–134.
98 if k == 1 and not lflagd:
99 continue
100 if k == 2 and not lflagu:
101 continue
102 # The edge of the zone (JMC) and the first radiative shell
103 # outside it (JMR).
104 jmc = mxzone[i, k]
105 if k == 1:
106 jmr = jmc - 1
107 if k == 2:
108 jmr = jmc + 1
109 lderiv = False
110 locond = True # noqa: F841 (unused in the Fortran too)
111 latmo = True
112 ksaha = 0
113
114 # The structure of JMR with the zone's composition (Fortran
115 # lines 135–168).
116 b = hl[jmr]
117 sl = hs[jmr]
118 pl = hp[jmr]
119 tl = ht[jmr]
120 dl = hd[jmr]
121 rl = hr[jmr]
122 x = hcomp[1, jmc]
123 z = hcomp[3, jmc]
124 fpl = 1.0
125 ftl = 1.0
126 iu = jmc
127 _load_debhu(hcomp, jmc)
128 dl, amu, emu, dela, delr = _gradients(
129 tl, pl, dl, rl, sl, b, x, z, lderiv, latmo, ksaha,
130 fpl, ftl, teffl, cmixl)
131 # Skip if stable with the zone's composition.
132 if delr < dela:
133 continue
134
135 # Fortran lines 169–173.
136 xintmu = amu + emu
137 delr1 = delr
138 rmax = 1.0 - dela / delr
139
140 # Repeat with the local composition (Fortran lines 174–194).
141 # Question (see the page): hd overwritten.
142 x = hcomp[1, jmr]
143 z = hcomp[3, jmr]
144 iu = jmr
145 _load_debhu(hcomp, jmr)
146 dl, amu, emu, dela, delr = _gradients(
147 tl, pl, dl, rl, sl, b, x, z, lderiv, latmo, ksaha,
148 fpl, ftl, teffl, cmixl)
149 hd[jmr] = dl
150
151 # Ratio of the gradients with the zone's and the local
152 # composition (Fortran lines 195–197).
153 fdel = delr1 / delr
154 delr0 = delr
155
156 # RMAX: the step times the propagation speed (eq. 5') (Fortran
157 # lines 198–202).
158 # Question (see the page): the factor 10.
159 rmax = (rmax * (hl[jmc] * c.clsun
160 / (10.0 * c.c4pi * math.exp(c.cln * hp[jmc])))
161 * (delts / math.exp(c.cln * (hr[jmc] + hr[jmc]))))
162
163 # The walk's start (Fortran lines 203–217).
164 rsum = 0.0
165 lmax = False
166 if k == 1:
167 rval1 = math.exp(c.cln * hr[jmr + 1])
168 jbeg = jmr - 1
169 jend = 1
170 jstep = -1
171 elif k == 2:
172 rval1 = math.exp(c.cln * hr[jmr - 1])
173 jbeg = jmr + 1
174 jend = m
175 jstep = 1
176
177 # The walk, shell by shell (Fortran lines 218–259).
178 stable = False
179 for ii in range(jbeg, jend + jstep, jstep): # loop 32
180 # The limit in radius (Fortran lines 219–225).
181 if k == 1:
182 rval2 = math.exp(c.cln * hr[ii + 1])
183 if k == 2:
184 rval2 = math.exp(c.cln * hr[ii - 1])
185 rdiff = rval2 - rval1
186 rsum = rsum + (1.0 - xintmu / (amu + emu)) * rdiff
187 rval1 = rval2
188 if rsum > rmax:
189 break # go to 33
190
191 # The rescaled radiative gradient (Fortran lines 226–254).
192 # Suspected bug (see the page): RL is not updated here.
193 b = hl[ii]
194 sl = hs[ii]
195 pl = hp[ii]
196 tl = ht[ii]
197 dl = hd[ii]
198 x = hcomp[1, ii]
199 z = hcomp[3, ii]
200 iu = ii # noqa: F841 (unused in the Fortran too)
201 _load_debhu(hcomp, ii)
202 dl, amu, emu, dela, delr = _gradients(
203 tl, pl, dl, rl, sl, b, x, z, lderiv, latmo, ksaha,
204 fpl, ftl, teffl, cmixl)
205 hd[ii] = dl
206 if fdel * delr < dela:
207 stable = True
208 break # go to 34
209 else:
210 # The loop ran out: the edge of the star.
211 if k == 1:
212 ii = 0
213 if k == 2:
214 ii = m + 1
215 if not stable:
216 lmax = True # label 33
217
218 # label 34: the new edge (Fortran lines 260–270).
219 if k == 1:
220 mxzone[i, k] = ii + 1
221 jmc2 = ii + 1
222 elif k == 2:
223 mxzone[i, k] = ii - 1
224 jmc2 = ii - 1
225 iounits_mod.write(
226 iounits_mod.ishort,
227 f" CZ OLD EDGE {jmc:3d} EXTENDED TO-{jmc2:3d} LIMIT="
228 f"{'T' if lmax else 'F'} RAD.GRADS-IN/OUT"
229 f"{delr1:8.4f}{delr0:8.4f}") # format 601
230
231 # Mergers of zones that overlap after semiconvection (Fortran lines
232 # 273–301).
233 if nzone <= 1:
234 return nzone
235 j = 1
236 while True: # label 85
237 # Question (see the page): overlap only, not adjacency.
238 if mxzone[j, 2] > mxzone[j + 1, 1]:
239 iounits_mod.write(
240 iounits_mod.ishort,
241 " MIXED ZONES MERGED DUE TO SEMICONVECTION\n"
242 f" OLD[{mxzone[j, 1]:3d}-{mxzone[j, 2]:3d}]"
243 f"[{mxzone[j + 1, 1]:3d}-{mxzone[j + 1, 2]:3d}]"
244 f" NEW[{mxzone[j, 1]:3d}-{mxzone[j + 1, 2]:3d}]") # 93
245 # Suspected bug (see the page): the merged zone keeps zone j+1's
246 # top.
247 mxzone[j + 1, 1] = mxzone[j, 1]
248 for kk in range(j, nzone):
249 for j2 in (1, 2):
250 mxzone[kk, j2] = mxzone[kk + 1, j2]
251 nzone = nzone - 1
252 if j <= nzone - 1:
253 continue
254 return nzone
255 j = j + 1
256 if j > nzone - 1:
257 return nzone