1C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
2C MIX
3C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
4C THE ENERGY GENERATION ROUTINE (ENGEB) IS USED FOR CALCULATIONS OF
5C EPSILON AND ITS DERIVATIVES IN THE HENYEY PORTION OF THE CODE (COEFFT)
6C PRIOR TO CALLING MIX THE FIRST TIME, STORE ORIGINAL VARIABLES IN VECTOR
7C HCOMPP. REZONE HCOMPP ALONG WITH HCOMP IN HPOINT.
8C THE MIX IS CALLED PRIOR TO REZONING AND ON THE THIRD LEVEL OF
9C ITERATION IN THE HENYEY PORTION.
10C
11C OUTLINE OF MIX :
12C
13C 1) CALL CONVEC TO DETERMINE LOCATION OF CZ EDGES AND EDGES OF MIXED
14C REGIONS WITH OVERSHOOT.
15C 2) DETERMINE RUN OF RATES FOR GIVEN RUN OF COMP, RHO, T.
16C IF DESIRED, THE SR SPITS OUT SOLAR NEUTRINO FLUXES TO I/O UNIT ISNU.
17C 3) USE KEMCOM TO IMPLICITLY SOLVE FOR ABUNDANCES IN RADIATIVE REGIONS.
18C 4) SOLVE FOR BURNING IN EACH CONVECTION ZONE.
19C 5) COMPUTE SEMI-CONVECTION IF DESIRED.
20C 6) COMPUTE MICROSCOPIC DIFFUSION IF DESIRED.
21C
22C THE RATE SUBROUTINE CALLED BY MIX IS A STRIPPED-DOWN VERSION OF ENGEB
23C (CALLED NRATE) WHICH HAS NO DERIVATIVES OR ENERGY YIELDS. IT DOES
24C CONTAIN NEUTRINO FLUXES FOR SOLAR NEUTRINO CALCULATIONS.
25
26 SUBROUTINE MIX(DELTS,HCOMP,HD,HL,HP,HR,HS,HS1,HS2,HSTOT,
27C * HT,ITLVL,LC,M,QDT,QDP,DDAGE,JCORE,JENV, ! KC 2025-05-31
28 * * HT,ITLVL,LC,M,DDAGE,JCORE,JENV,MXZONE,MXZON0,TEFFL,CMIXL)
29C 10/15/26 MHP via Claude
30C code changed to take JSON from DIMENSIONS_MOD instead of declaring
31C PARAMETER(JSON=5000) here.
32 USE DIMENSIONS_MOD
33C 10/14/26 MHP via Claude
34C code changed to convert COMMON/DEUTER/ into DEUTER_MOD.
35 USE DEUTER_MOD
36C 10/14/26 MHP via Claude
37C code changed to convert COMMON/NMLPAR/ into NMLPAR_MOD.
38 USE NMLPAR_MOD
39C 10/14/26 MHP via Claude
40C code changed to convert COMMON/CONSTANTS/ into CONSTANTS_MOD.
41 USE CONSTANTS_MOD
42C 10/14/26 MHP via Claude
43C code changed to convert COMMON/IOUNITS/ into IOUNITS_MOD.
44 USE IOUNITS_MOD
45C 10/20/26 MHP via Claude
46C code changed to replace implicit typing with IMPLICIT NONE and
47C explicit declarations.
48 IMPLICIT NONE
49 REAL*8 CMIXL,DCDT,DDAGE,DELTS,DL,DODT,DT,DTMAX,DXDT,DYDT,FM,HCOMP,
50 * * HD,HF1,HF2,HL,HP,HQPR,HR,HR1,HR10,HR11,HR12,HR13,HR2,HR3,
51 * * HR4,HR5,HR6,HR7,HR8,HR9,HS,HS1,HS2,HSMAX,HSTOT,HT,STOT,
52 * * TEFFL,TL,TSCALE,WTSUM,X,XBE9,XC12,XC13,XH2,XH2TEST,XHE3,
53 * * XLI6,XLI7,XN14,XN15,XO16,XO17,XO18,XSUM,Y,Z
54 INTEGER I,I1,I2,IBEGIN,IEND,II,ITLVL,J,JCORE,JENV,JJ,K,M,MRZONE,
55 * * MXZON0,MXZONE,NRZONE,NS,NSPEC,NSTEP,NZONE,NZONE0
56 LOGICAL*4 LC,LCC
57
58
59C 9/25/26 MHP via Claude
60C code changed to consolidate all I/O logical unit numbers, previously
61C scattered across COMMON/LUOUT/, COMMON/LUNUM/, COMMON/ALEX06/,
62C COMMON/ACDPTH/, COMMON/NEWOPAC/, COMMON/LOPAL95/, COMMON/ATMOS2/,
63C COMMON/ALATM03/, COMMON/OPALEOS/, and COMMON/SCV2/, into a single
64C COMMON/IOUNITS/
65C 10/13/26 MHP via Claude: removed the unused COMMON/COMP/ declaration
66C (no member referenced here; residue of the obsolete-option removals).
67C 9/25/26 MHP via Claude
68C code changed to merge COMMON/CONST/, COMMON/CONST1/, COMMON/CONST2/,
69C and COMMON/CONST3/ into a single COMMON/CONSTANTS/
70C***MHP COMMON BLOCK ADDED FOR G.S.
71C 9/24/26 MHP via Claude
72C code changed to pass CMIXL as an explicit argument instead of via
73C common block, to reduce implicit global state ahead of the F90
74C module conversion
75C 10/12/26 MHP via Claude
76C code changed to extend COMMON/NMLPAR/ to 234 members, adding the
77C namelist variables that the physics routines read from 27 COMMON
78C blocks which also held derived or working members. Those blocks keep
79C only their non-namelist members; five of them -- NEWMX, VMULT,
80C PMMWIND, CCOUT1 and ENVGEN -- had nothing left and are gone.
81C Derivation-only namelist variables from the same blocks went to
82C COMMON/NMLBYPASS/ instead, not here.
83C
84C Declared identically in all 121 files that hold any of these members.
85C Generated from one member list, so every copy is byte-identical; the
86C linker's 'size of symbol changed' warning is the check that they are.
87C 10/13/26 MHP via Claude
88C code changed to drop COMMON/CTLIM/, declared here but never used.
89C MHP 05/02 DEUTERIUM BURNING RATE ADDED
90C 10/13/26 MHP via Claude: removed the unused COMMON/DPMIX/ declaration
91C (no member referenced here; residue of the obsolete-option removals).
92C*** MHP 5/90 ADD COMMON BLOCK FOR GRAVITATIONAL SETTLING.
93C*** MHP 6/90 ADDITIONAL COMMON BLOCK FOR SETTLING.
94c GES 6/15 INCLUDED COMMON BLOCK FOR NEW DIFFUSION ROUTINES.
95
96C 10/13/26 MHP via Claude: removed the unused COMMON/OLDMOD/ declaration
97C (no member referenced here; residue of the obsolete-option removals).
98C*** MHP 6/91 COMMON BLOCK FOR NEW MIXING AND SEMI-CONVECTION.
99C THESE ARE PARMIN PARAMETERS IN MARK6.
100C 10/13/26 MHP via Claude
101C code changed to drop COMMON/THEAGE/, which this routine declared but
102C never used. DAGE, the stellar age, is passed explicitly elsewhere.
103C ADDED FOR MASS ACCRETION
104 DIMENSION HD(JSON),HP(JSON),HS(JSON),HS1(JSON),HL(JSON),
105 * * HS2(JSON),HT(JSON),LC(JSON),HCOMP(15,JSON),HQPR(JSON), HR(JSON)
106 DIMENSION HR1(JSON),HR2(JSON),HR3(JSON),HR4(JSON),
107 * * HR5(JSON),HR6(JSON),HR7(JSON),HR8(JSON),HR9(JSON),HR10(JSON),
108 * * HR11(JSON),HR12(JSON),HR13(JSON),HF1(JSON),HF2(JSON),XSUM(15)
109 DIMENSION MRZONE(13,2),MXZONE(12,2),MXZON0(12,2)
110C DATA BURMIN/1.0D-30/
111C MHP 1/95
112 DIMENSION LCC(JSON)
113 SAVE
114
115C NSPEC IS THE NUMBER OF SPECIES BEING TRACKED.
116 IF(LEXCOM)THEN
117 NSPEC = 15
118 ELSE
119 NSPEC = 11
120 ENDIF
121C DDAGE IS THE TIMESTEP IN YEARS.
122 DDAGE=DELTS/CSECYR
123C
124C DETERMINE THE LOCATION OF CONVECTION ZONES WITH AND WITHOUT OVERSHOOT.
125C
126C ******* INTRODUCE DPENV PARAMETER FOR DEEP MIXING *******************
127C DPENV MIXES THE STAR FROM THE SURFACE TO MASS FRACTION DPENV
128C E.G. DPENV = 0.7 MEANS THE OUTER .3 OF THE STAR IS MIXED
129 IF(DPENV.LT.1.0D0 .AND. ITLVL.GT.1) THEN
130C MIX FROM CENTER TO A FIXED MASS FRACTION
131 HSMAX = DPENV*EXP(CLN*HSTOT)
132 DO I = 1,M
133 IF(HS1(I).GT.HSMAX)THEN
134 DO J = I,M
135 LCC(J) = LC(J)
136 END DO
137 GO TO 5
138 ELSE
139 LCC(I) = .TRUE.
140 ENDIF
141 END DO
142C MHP 1/95 CHANGE - DPENV MIXES TO A FIXED FRACTION OF THE MAXIMUM
143C LUMINOSITY.
144C HLMAX = HL(1)
145C IMAX = 1
146C DO I = 2,M
147C IF(HL(I).GT.HLMAX)THEN
148C HLMAX = HL(I)
149C IMAX = I
150C ENDIF
151C END DO
152C HLTEST = HLMAX*DPENV
153C DO I = 1,M
154C IF(HL(I).LE.HLTEST)THEN
155C LCC(I) = LC(I)
156C ELSE
157C DO J = I,M
158C LCC(J) = .TRUE.
159C END DO
160C GOTO 5
161C ENDIF
162C END DO
163 5 5 CONTINUE
164 ELSE
165 DO J = 1,M
166 LCC(J) = LC(J)
167 END DO
168 ENDIF
169
170 CALL CONVEC(HCOMP,HD,HP,HR,HS,HT,LCC,M,MRZONE,MXZONE,MXZON0,
171 * * JCORE,JENV,NRZONE,NZONE,NZONE0)
172
173C FIND BURNING RATES (HR1- HR13,HF1,HF2).
174 IF(LMDOT .AND. DMDT0.GT.0.0D0)THEN
175 XH2TEST = MAX(HCOMP(12,M),COMPACC(12))
176 ELSE
177 XH2TEST = HCOMP(12,M)
178 ENDIF
179 DO 10 I = 1,M
180C EXIT LOOP ONCE T DROPS BELOW NUCLEAR REACTION T CUTOFF
181 IF(HT(I).LE.TCUT(1)) GOTO 20
182C SCALAR VARIABLES ARE USED IN THE CALLS TO THE ENERGY GENERATION ROUTINES.
183C SET SCALARS EQUAL TO THE GLOBAL ARRAYS FOR THE VARIABLES OF INTEREST.
184C DL-LOG(DENSITY),TL-LOG TEMPERATURE,X***-MASS FRACTION OF SPECIES ***,
185C WITH HYDROGEN,HELIUM,AND METALS DENOTED AS USUAL BY X,Y,Z.
186 DL = HD(I)
187 TL = HT(I)
188 X = HCOMP(1,I)
189 Y = HCOMP(2,I)
190 Z = HCOMP(3,I)
191 XHE3 = HCOMP(4,I)
192 XC12 = HCOMP(5,I)
193 XC13 = HCOMP(6,I)
194 XN14 = HCOMP(7,I)
195 XN15 = HCOMP(8,I)
196 XO16 = HCOMP(9,I)
197 XO17 = HCOMP(10,I)
198 XO18 = HCOMP(11,I)
199 XH2 = HCOMP(12,I)
200 XLI6 = HCOMP(13,I)
201 XLI7 = HCOMP(14,I)
202 XBE9 = HCOMP(15,I)
203C SETUP NUCLEAR ENERGY TERMS
204C CALL RATES(DL,TL,X,Y,Z,XHE3,XC12,XC13,XN14,XN15,
205C * XO16,XO17,XO18,XH2,XLI6,XLI7,XBE9,I,HR1,HR2,HR3,HR4, ! KC 2025-05-31
206 CALL RATES(DL,TL,X,Y,XHE3,XC12,XC13,XN14,
207 * * XO16,XO18,I,HR1,HR2,HR3,HR4,
208 * * HR5,HR6,HR7,HR8,HR9,HR10,HR11,HR12,HR13,HF1,HF2)
209C MHP 5/02 COMPUTE RATE FOR DEUTERIUM BURNING
210 IF(XH2TEST.GT.1.0D-11)THEN
211C CALL DEUTRATE(DL,TL,X,XH2,I,ITLVL) ! KC 2025-05-31
212 CALL DEUTRATE(DL,TL,X,I,ITLVL)
213 ELSE
214 DRATE(I) = 0.0D0
215 ENDIF
216 10 10 CONTINUE
217 I = M + 1
218 20 20 CONTINUE
219 DO 21 II = I,M
220 HR1(II) = 0.0D0
221 HR2(II) = 0.0D0
222 HR3(II) = 0.0D0
223 HR4(II) = 0.0D0
224 HR5(II) = 0.0D0
225 HR6(II) = 0.0D0
226 HR7(II) = 0.0D0
227 HR8(II) = 0.0D0
228 HR9(II) = 0.0D0
229 HR10(II) = 0.0D0
230 HR11(II) = 0.0D0
231 HR12(II) = 0.0D0
232 HR13(II) = 0.0D0
233 HF1(II) = 0.0D0
234 HF2(II) = 0.0D0
235C MHP 5/02 ZERO OUT DEUTERIUM BURNING RATE
236 DRATE(II) = 0.0D0
237 21 21 CONTINUE
238C 22 FORMAT(5X,1P5E12.4/5X,E12.4)
239C WRITE(*,912)ITLVL,(DRATE(III),III=1,5),
240C * (HT(JJJ),JJJ=1,5)
241C 912 FORMAT(I2,1P5E14.6/2X,5E14.6)
242C
243C NOW IMPLICITLY SOLVE FOR THE NEW ABUNDANCES AT THE END OF THE
244C TIMESTEP. THIS IS DONE SHELL BY SHELL FOR RADIATIVE REGIONS,
245C AND FOR EACH CONVECTION ZONE AS A UNIT.
246C
247C RADIATIVE ZONES.
248C
249 DO 40 K = 1,NRZONE
250 DO 30 J = MRZONE(K,1),MRZONE(K,2)
251C EXIT LOOP ONCE T DROPS BELOW NUCLEAR REACTION T CUTOFF
252 IF(HT(J).LE.TCUT(1)) GOTO 45
253 IBEGIN = J
254 IEND = J
255 CALL KEMCOM(HT,IBEGIN,IEND,HR1,HR2,HR3,HR4,HR5,HR6,
256C * HR7,HR8,HR9,HR10,HR11,HR12,HR13,HF1,HS2,HCOMP,
257C * DDAGE,ITLVL) ! KC 2025-05-31
258 * * HR7,HR8,HR10,HR11,HR12,HF1,HS2,HCOMP,DDAGE)
259 30 30 CONTINUE
260 40 40 CONTINUE
261 45 45 CONTINUE
262C
263C CONVECTION ZONES.
264C NOTE KEMCOM ALSO AUTOMATICALLY HOMOGENIZE CONVECTION ZONES.
265C
266 DO 50 K = 1,NZONE
267 IBEGIN = MXZONE(K,1)
268 IEND = MXZONE(K,2)
269 CALL KEMCOM(HT,IBEGIN,IEND,HR1,HR2,HR3,HR4,HR5,HR6,
270C * HR7,HR8,HR9,HR10,HR11,HR12,HR13,HF1,HS2,HCOMP,
271C * DDAGE,ITLVL) ! KC 2025-05-31
272 * * HR7,HR8,HR10,HR11,HR12,HF1,HS2,HCOMP,DDAGE)
273 50 50 CONTINUE
274C 51 CONTINUE
275C 10/30/26 MHP via Claude
276C code changed to stop copying the rates into HCOMPM (BURN_MOD), which
277C nothing has read since ROTMIX computes its own; the module is gone.
278C
279C IF ITLVL=1 THEN THE RATES OF HYDROGEN AND HELIUM BURNING ARE
280C COMPUTED EXPLICITLY ASSUMING EQUILIBRIUM HE3 AND CN.
281C IF THIS IS THE CASE, CALL OLD ENERGY GENERATION ROUTINE AND
282C OVERWRITE THE HYDROGEN ABUNDANCES (H BURNING) AND Z,C12,O16
283C ABUNDANCES (HE BURNING).
284 IF(ITLVL.EQ.1)THEN
285C
286C EXPLICITLY SOLVE FOR THE NEW HYDROGEN AND HELIUM BURNING RATES
287C AT THE BEGINNING OF THE TIMESTEP, ASSUMING EQUILIBRIUM HE3 AND CN
288C CYCLE ABUNDANCES. THIS IS DONE SHELL BY SHELL FOR RADIATIVE REGIONS,
289C AND FOR EACH CONVECTION ZONE AS A UNIT.
290C
291C RADIATIVE ZONES.
292C
293 DT = DDAGE*1.0D-9
294 DO K = 1,NRZONE
295 DO J = MRZONE(K,1),MRZONE(K,2)
296C EXIT LOOP ONCE T DROPS BELOW NUCLEAR REACTION T CUTOFF
297 IF(HT(J).LE.TCUT(1)) GOTO 60
298 IBEGIN = J
299 IEND = J
300C CALL EQBURN(HF1,HR1,HR2,HR3,HR4,HR5,HR6,HR7,
301C * HR8,HR9,HR10,HR11,HR12,HS2,HT,IBEGIN,IEND, ! KC 2025-05-31
302 CALL EQBURN(HR1,HR2,HR3,HR4,HR5,HR6,HR7,
303 * * HR10,HR12,HS2,HT,IBEGIN,IEND,
304 * * DCDT,DODT,DXDT,DYDT,XC12,XO16,X,Z)
305C USE THE EXPLICIT HYDROGEN BURNING RATE.
306 IF(DXDT.NE.0.0D0)THEN
307 HCOMP(1,J) = X + DXDT*DT
308 ENDIF
309C USE THE HELIUM BURNING RATE FROM EQBURN AND THE CARBON,ALPHA
310C BURNING RATE
311 IF(DYDT.NE.0.0D0)THEN
312 HCOMP(3,J) = Z - DYDT*DT
313 HCOMP(5,J) = XC12 + DCDT*DT
314 HCOMP(9,J) = XO16 + DODT*DT
315 ENDIF
316 END DO
317 END DO
318 60 60 CONTINUE
319C
320C CONVECTION ZONES.
321C NOTE KEMCOM ALSO AUTOMATICALLY HOMOGENIZE CONVECTION ZONES.
322C
323 DO K = 1,NZONE
324 IBEGIN = MXZONE(K,1)
325 IEND = MXZONE(K,2)
326C CALL EQBURN(HF1,HR1,HR2,HR3,HR4,HR5,HR6,HR7,HR8,
327C * HR9,HR10,HR11,HR12,HS2,HT,IBEGIN,IEND, ! KC 2025-05-31
328 CALL EQBURN(HR1,HR2,HR3,HR4,HR5,HR6,HR7,
329 * * HR10,HR12,HS2,HT,IBEGIN,IEND,
330 * * DCDT,DODT,DXDT,DYDT,XC12,XO16,X,Z)
331C USE THE EXPLICIT HYDROGEN BURNING RATE.
332 IF(DXDT.NE.0.0D0)THEN
333 X = X + DXDT*DT
334 DO I = IBEGIN,IEND
335 HCOMP(1,I) = X
336 END DO
337 ENDIF
338C USE THE HELIUM BURNING RATE FROM EQBURN AND THE CARBON,ALPHA
339C BURNING RATE
340 IF(DYDT.NE.0.0D0)THEN
341 Z = Z - DYDT*DT
342 XC12 = XC12 + DCDT*DT
343 XO16 = XO16 + DODT*DT
344 DO I = IBEGIN,IEND
345 HCOMP(3,I) = Z
346 HCOMP(5,I) = XC12
347 HCOMP(9,I) = XO16
348 END DO
349 ENDIF
350 END DO
351 ENDIF
352C
353C DETERMINE EXTENT OF SEMI-CONVECTION IF APPLICABLE.
354C
355 IF(LSEMIC)THEN
356 IF(ITLVL.GT.1)
357 * * CALL SCONVEC(DELTS,HCOMP,HD,HL,HP,HR,HS,HT,M,MXZONE,NZONE,
358 * * TEFFL,CMIXL)
359 ENDIF
360 IF (LSEMIC .OR. (ITLVL .EQ. 1)) THEN
361C
362C MIX CONVECTIVE REGIONS IN ORDER.
363C THIS NEEDS TO BE DONE IF SEMI-CONVECTION IS BEING CHECKED, OR
364C IF EXPLICIT H AND HE BURNING IS BEING DONE.
365C
366C NZONE IS THE NUMBER OF DISTINCT CONVECTION ZONES.
367C MXZONE(J,1) AND MXZONE(J,2) ARE THE FIRST AND LAST SHELLS CONTAINED
368C IN THE JTH CONVECTION ZONE.
369 DO 100 J = 1,NZONE
370C I1 AND I2 ARE THE FIRST AND LAST CONVECTIVE SHELLS IN THE GIVEN REGION.
371 I1 = MXZONE(J,1)
372 I2 = MXZONE(J,2)
373 IF(I1.NE.1 .AND. I1.GE.I2) GOTO 100
374C INITIALIZE SUMS.
375 WTSUM = 0.0D0
376 DO 55 I = 1,NSPEC
377 XSUM(I) = 0.0D0
378 55 55 CONTINUE
379C ADD UP THE TOTAL MASS OF EACH SPECIES IN THE CONVECTIVE REGION.
380C (HS2 IS THE MASS CONTAINED WITHIN A SHELL IN GRAMS).
381 DO 65 JJ = I1,I2
382 WTSUM = WTSUM + HS2(JJ)
383 DO 61 I = 1,NSPEC
384 XSUM(I) = XSUM(I) + HCOMP(I,JJ)*HS2(JJ)
385 61 61 CONTINUE
386 65 65 CONTINUE
387C DIVIDE BY THE TOTAL MASS TO FIND THE MEAN MASS FRACTION IN THE REGION.
388 DO 70 I = 1,NSPEC
389 XSUM(I) = XSUM(I)/WTSUM
390 70 70 CONTINUE
391C APPLY THE MEAN MASS FRACTION OF ALL SPECIES THROUGHOUT THE CZ.
392 DO 90 JJ = I1,I2
393 DO 80 I = 1,NSPEC
394 HCOMP(I,JJ) = XSUM(I)
395 80 80 CONTINUE
396 90 90 CONTINUE
397 100 100 CONTINUE
398 ENDIF
399C WRITE OUT THE LOCATIONS OF MIXED REGIONS.
400 IF(NZONE.GE.1) THEN
401 WRITE(ISHORT,110) ((MXZONE(I,J),J=1,2),I=1,NZONE)
402 110 110 FORMAT(' ZONES MIXED IN ORDER--',12('(',I5,',',I5,') ') )
403 ENDIF
404C
405C MICROSCOPIC DIFFUSION OF HELIUM.
406C
407C***MHP 12/89 MIX MODIFIED TO INCLUDE CALL TO GRAVITATIONAL SETTLING
408C ROUTINE USING THE BAHCALL AND LOEB METHOD.
409C FIRST DEFINE VARIABLES NEEDED FOR SETTLING -
410C HQPR=VECTOR OF D LN P/DR.
411C STOT=TOTAL STELLAR MASS(UNLOGGED).
412 IF(LDIFY)THEN
413 IF(HCOMP(1,1).LT.XMIN)THEN
414 LDIFY=.FALSE.
415 GOTO 170
416 ENDIF
417 STOT=EXP(CLN*HSTOT)
418 DO 130 I = 1,M
419 HQPR(I)=-EXP(CLN*(HD(I)+CGL+HS(I)-2.0D0*HR(I)-HP(I)))
420 130 130 CONTINUE
421C MHP 6/90 CHANGE ADDED : THE TIMESTEP FOR SETTLING IS RESTRICTED TO
422C A FRACTION OF THE TIMESCALE FOR SETTLING AT THE OUTER BOUNDARY.
423C THE OUTER BOUNDARY IS EITHER THE SURFACE CONVECTION ZONE OR THE
424C FIRST POINT WHERE THE HELIUM ABUNDANCE RISES ABOVE A USER-SPECIFIED
425C MINIMUM VALUE (YMIN).
426C
427C LOCATE OUTER BOUNDARY.
428 IF(.NOT.LC(M))THEN
429 WRITE(ISHORT,911)
430C DBG 2/92 CHANGED STOP TO JUST A WARNING MESSAGE, EXECUTION CONTINUES
431 911 911 FORMAT(1X,'NO SURFACE CZ - DIFFUSION NOT MEANINGFUL')
432 GOTO 170
433 ENDIF
434 DO 140 J = JENV,1,-1
435 IF(HCOMP(2,J).GT.YMIN)GOTO 150
436 140 140 CONTINUE
437C Y<YMIN FOR THE WHOLE STAR IF THE CODE GETS HERE.
438 GOTO 170
439 150 150 CONTINUE
440C FM IS THE MASS FRACTION ABOVE THE OUTER POINT.
441 FM = (STOT-HS1(J))/STOT
442C TSCALE IS THE TIMESCALE FOR SETTLING OF HELIUM AT THE OUTER
443C BOUNDARY (MICHAUD ET AL 1984, APJ V.282,P.206)
444 TSCALE = 4.348D21*CSECYR*FM/EXP(CLN*1.5D0*HT(J))
445C RESTRICT TIMESTEP TO THE MINIMUM OF THE MODEL TIMESTEP AND
446C A USER SPECIFIED FRACTION (DT_GS) OF THE SETTLING TIMESCALE.
447 DTMAX = DT_GS*TSCALE
448C 10/30/26 MHP via Claude
449C code changed to MOD(DELTS,DTMAX): the arguments were reversed, which
450C took one sub-step too many when DELTS was an exact multiple of DTMAX,
451C and none (a division by zero) when DTMAX was an exact multiple of DELTS.
452 NSTEP = INT(DELTS/DTMAX)
453 IF(MOD(DELTS,DTMAX).NE.0.0D0.OR.NSTEP.EQ.0)NSTEP=NSTEP+1
454 DT = DELTS/DFLOAT(NSTEP)
455 DO 160 NS = 1,NSTEP
456C PERFORM GRAVITATIONAL SETTLING. IF LNEWDIF = TRUE, USE THE NEW ROUTINES
457C IN MICRODIFF. ELSE, USE THE OLD ROUTINES IN GRSETT.
458 IF(LNEWDIF)THEN
459 CALL MICRODIFF(DT,HCOMP,HQPR,HR,HD,HS1,HT,LCC,M,STOT)
460 ELSE
461 CALL GRSETT(DT,HCOMP,HQPR,HR,HD,HS1,HT,LCC,M,STOT)
462 ENDIF
463 160 160 CONTINUE
464 170 170 CONTINUE
465 ENDIF
466C RENORMALIZE COMPOSITION TO GUARD AGAINST ANOMALIES (I.E. SMALL NEGATIVE
467C ABUNDANCES...).
468 DO 180 I = 1,M
469 DO 175 J = 1,NSPEC
470 HCOMP(J,I) = MAX(HCOMP(J,I),0.0D0)
471 HCOMP(J,I) = MIN(HCOMP(J,I),1.0D0)
472 175 175 CONTINUE
473 HCOMP(3,I) = MIN(HCOMP(3,I),1.0D0-HCOMP(1,I)-HCOMP(4,I))
474 HCOMP(2,I) = 1.0D0 - HCOMP(1,I) - HCOMP(3,I) - HCOMP(4,I)
475 180 180 CONTINUE
476C MHP 1/95 ADDED CALL TO RESET JENV,JCORE FOR DEEP MIXING.
477 IF(DPENV.LT.1.0D0 .AND. ITLVL.GT.1)THEN
478 CALL CONVEC(HCOMP,HD,HP,HR,HS,HT,LC,M,MRZONE,MXZONE,MXZON0,
479 * * JCORE,JENV,NRZONE,NZONE,NZONE0)
480 ENDIF
481C MHP 5/02 ADDED DEUTERIUM BURNING
482 IF(LEXCOM)THEN
483C RADIATIVE ZONES.
484C
485 DT = DDAGE*1.0D-9
486 DO K = 1,NRZONE
487 DO J = MRZONE(K,1),MRZONE(K,2)
488C EXIT LOOP ONCE T DROPS BELOW NUCLEAR REACTION T CUTOFF
489 IF(HT(J).LE.TCUT(1)) GOTO 190
490 IBEGIN = J
491 IEND = J
492 CALL DBURN(IBEGIN,IEND,M,HS2,HCOMP,DT)
493 END DO
494 END DO
495 190 190 CONTINUE
496C
497C CONVECTION ZONES.
498C NOTE KEMCOM ALSO AUTOMATICALLY HOMOGENIZE CONVECTION ZONES.
499C
500 DO K = 1,NZONE
501 IBEGIN = MXZONE(K,1)
502 IEND = MXZONE(K,2)
503 CALL DBURN(IBEGIN,IEND,M,HS2,HCOMP,DT)
504 END DO
505 ENDIF
506 RETURN
507 END1"""Python version of mix.f (YREC 7be4133): the composition over one time
2step (burning, mixing, semiconvection, settling, deuterium)."""
3
4import math
5
6import numpy as np
7
8from pyrec import constants_mod
9from pyrec import deuter_mod
10from pyrec import dimensions_mod
11from pyrec import iounits_mod
12from pyrec import nmlpar_mod
13from pyrec.convec import convec
14from pyrec.dburn import dburn
15from pyrec.deutrate import deutrate
16from pyrec.eqburn import eqburn
17from pyrec.grsett import grsett
18from pyrec.kemcom import kemcom
19from pyrec.microdiff import microdiff
20from pyrec.rates import rates
21from pyrec.sconvec import sconvec
22
23JSON = dimensions_mod.json
24
25# The Fortran's local arrays (SAVE): the burning rates, d ln P/dr, the zone
26# lists and the convection flags used for mixing (LCC).
27hr1 = np.zeros(JSON + 1)
28hr2 = np.zeros(JSON + 1)
29hr3 = np.zeros(JSON + 1)
30hr4 = np.zeros(JSON + 1)
31hr5 = np.zeros(JSON + 1)
32hr6 = np.zeros(JSON + 1)
33hr7 = np.zeros(JSON + 1)
34hr8 = np.zeros(JSON + 1)
35hr9 = np.zeros(JSON + 1)
36hr10 = np.zeros(JSON + 1)
37hr11 = np.zeros(JSON + 1)
38hr12 = np.zeros(JSON + 1)
39hr13 = np.zeros(JSON + 1)
40hf1 = np.zeros(JSON + 1)
41hf2 = np.zeros(JSON + 1)
42hqpr = np.zeros(JSON + 1)
43xsum = np.zeros(16)
44mrzone = np.zeros((14, 3), dtype=int)
45lcc = np.zeros(JSON + 1, dtype=bool)
46
47
48def mix(delts: float, hcomp: np.ndarray, hd: np.ndarray, hl: np.ndarray, hp: np.ndarray, hr: np.ndarray, hs: np.ndarray,
49 hs1: np.ndarray, hs2: np.ndarray, hstot: float, ht: np.ndarray, itlvl: int, lc: np.ndarray, m: int,
50 ddage: float, jcore: int, jenv: int, mxzone: np.ndarray, mxzon0: np.ndarray, teffl: float,
51 cmixl: float) -> tuple[float, int, int]:
52 """Update the composition hcomp over the step delts (s): find the
53 convection zones, compute the burning rates, burn implicitly (KEMCOM)
54 or, at itlvl = 1, explicitly (EQBURN), treat semiconvection, mix the
55 convection zones, settle (MICRODIFF or GRSETT), clean up the abundances
56 and burn deuterium.
57
58 Translates: mix.f#MIX (7be4133)
59
60 Arguments: the model (hd, hl, hp, hr, hs = log m, hs1 = m, hs2 = shell
61 masses, log total mass hstot, ht, convection flags lc, m shells), the
62 composition hcomp[k, j], the iteration level itlvl, teffl and the
63 mixing length cmixl. Arrays have index 0 unused. Sets in place: hcomp,
64 the zone lists mxzone and mxzon0, and
65 deuter_mod.drate; may set nmlpar_mod.ldify to False.
66
67 Returns (ddage, jcore, jenv): the step in years and the edges of the
68 central and surface convection zones.
69
70 """
71
72 c = constants_mod
73 nml = nmlpar_mod
74 drate = deuter_mod.drate
75
76 # NSPEC: the number of species tracked (Fortran lines 115–120).
77 if nml.lexcom:
78 nspec = 15
79 else:
80 nspec = 11
81
82 # DDAGE: the step in years (Fortran lines 121–122).
83 ddage = delts / c.csecyr
84
85 # Deep mixing: DPENV mixes the star to the mass fraction DPENV (Fortran
86 # lines 124–168).
87 # Question (see the page): from the centre, though the comment says from
88 # the surface.
89 if nml.dpenv < 1.0 and itlvl > 1:
90 hsmax = nml.dpenv * math.exp(c.cln * hstot)
91 for i in range(1, m + 1):
92 if hs1[i] > hsmax:
93 for j in range(i, m + 1):
94 lcc[j] = lc[j]
95 break # GO TO 5
96 else:
97 lcc[i] = True
98 # A variant using a fraction of the peak luminosity is commented out in
99 # the Fortran (MHP 1/95).
100 else:
101 for j in range(1, m + 1):
102 lcc[j] = lc[j]
103
104 # Convection zones with and without overshoot (Fortran lines 170–171).
105 jcore, jenv, nrzone, nzone, nzone0 = convec(
106 hcomp, hd, hp, hr, hs, ht, lcc, m, mrzone, mxzone, mxzon0,
107 jcore, jenv, 0, 0, 0)
108
109 # Burning rates (HR1 - HR13, HF1, HF2), down to the cutoff TCUT(1)
110 # (Fortran lines 173–237).
111 if nml.lmdot and nml.dmdt0 > 0.0:
112 xh2test = max(hcomp[12, m], nml.compacc[12])
113 else:
114 xh2test = hcomp[12, m]
115 i_cut = m + 1 # label 20: the first shell below the cutoff
116 for i in range(1, m + 1): # DO 10
117 if ht[i] <= nml.tcut[1]:
118 i_cut = i
119 break
120 dl = hd[i]
121 tl = ht[i]
122 x = hcomp[1, i]
123 y = hcomp[2, i]
124 xhe3 = hcomp[4, i]
125 xc12 = hcomp[5, i]
126 xc13 = hcomp[6, i]
127 xn14 = hcomp[7, i]
128 xo16 = hcomp[9, i]
129 xo18 = hcomp[11, i]
130 rates(dl, tl, x, y, xhe3, xc12, xc13, xn14, xo16, xo18, i,
131 hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr8, hr9, hr10, hr11,
132 hr12, hr13, hf1, hf2)
133 # The deuterium burning rate (MHP 5/02).
134 if xh2test > 1.0e-11:
135 deutrate(dl, tl, x, i, itlvl)
136 else:
137 drate[i] = 0.0
138 for ii in range(i_cut, m + 1): # DO 21: zero rates in cooler shells
139 for arr in (hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr8, hr9, hr10,
140 hr11, hr12, hr13, hf1, hf2):
141 arr[ii] = 0.0
142 drate[ii] = 0.0
143
144 # Implicit burning: shell by shell in radiative zones (until the
145 # cutoff), zone by zone in convection zones (which KEMCOM homogenizes)
146 # (Fortran lines 243–273).
147 done = False
148 for k in range(1, nrzone + 1): # DO 40
149 for j in range(mrzone[k, 1], mrzone[k, 2] + 1):
150 if ht[j] <= nml.tcut[1]:
151 done = True # GOTO 45
152 break
153 ibegin = j
154 iend = j
155 kemcom(ht, ibegin, iend, hr1, hr2, hr3, hr4, hr5, hr6,
156 hr7, hr8, hr10, hr11, hr12, hf1, hs2, hcomp, ddage)
157 if done:
158 break
159 for k in range(1, nzone + 1): # DO 50
160 ibegin = mxzone[k, 1]
161 iend = mxzone[k, 2]
162 kemcom(ht, ibegin, iend, hr1, hr2, hr3, hr4, hr5, hr6,
163 hr7, hr8, hr10, hr11, hr12, hf1, hs2, hcomp, ddage)
164
165 # ITLVL = 1: explicit H and He burning with equilibrium He3 and CN,
166 # overwriting X (H burning) and Z, C12, O16 (He burning); DT in Gyr,
167 # as the rates are per Gyr (Fortran lines 279–351).
168 # Question (see the page): the equilibrium predictor.
169 if itlvl == 1:
170 dt = ddage * 1.0e-9
171 done = False
172 for k in range(1, nrzone + 1):
173 for j in range(mrzone[k, 1], mrzone[k, 2] + 1):
174 if ht[j] <= nml.tcut[1]:
175 done = True # GOTO 60
176 break
177 ibegin = j
178 iend = j
179 (dcdt, dodt, dxdt, dydt, xc12, xo16, x, z) = eqburn(
180 hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr10, hr12, hs2, ht,
181 ibegin, iend, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
182 if dxdt != 0.0:
183 hcomp[1, j] = x + dxdt * dt
184 if dydt != 0.0:
185 hcomp[3, j] = z - dydt * dt
186 hcomp[5, j] = xc12 + dcdt * dt
187 hcomp[9, j] = xo16 + dodt * dt
188 if done:
189 break
190 # label 60. Convection zones.
191 for k in range(1, nzone + 1):
192 ibegin = mxzone[k, 1]
193 iend = mxzone[k, 2]
194 (dcdt, dodt, dxdt, dydt, xc12, xo16, x, z) = eqburn(
195 hr1, hr2, hr3, hr4, hr5, hr6, hr7, hr10, hr12, hs2, ht,
196 ibegin, iend, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)
197 if dxdt != 0.0:
198 x = x + dxdt * dt
199 for i in range(ibegin, iend + 1):
200 hcomp[1, i] = x
201 if dydt != 0.0:
202 z = z - dydt * dt
203 xc12 = xc12 + dcdt * dt
204 xo16 = xo16 + dodt * dt
205 for i in range(ibegin, iend + 1):
206 hcomp[3, i] = z
207 hcomp[5, i] = xc12
208 hcomp[9, i] = xo16
209
210 # Semiconvection, if applicable (Fortran lines 353–359).
211 if nml.lsemic:
212 if itlvl > 1:
213 nzone = sconvec(delts, hcomp, hd, hl, hp, hr, hs, ht, m, mxzone,
214 nzone, teffl, cmixl)
215
216 # Mix each convection zone (shells I1..I2) to its mass-weighted mean
217 # (Fortran lines 360–398).
218 if nml.lsemic or itlvl == 1:
219 for j in range(1, nzone + 1): # DO 100
220 i1 = mxzone[j, 1]
221 i2 = mxzone[j, 2]
222 if i1 != 1 and i1 >= i2:
223 continue
224 wtsum = 0.0
225 for i in range(1, nspec + 1):
226 xsum[i] = 0.0
227 for jj in range(i1, i2 + 1):
228 wtsum = wtsum + hs2[jj]
229 for i in range(1, nspec + 1):
230 xsum[i] = xsum[i] + hcomp[i, jj] * hs2[jj]
231 for i in range(1, nspec + 1):
232 xsum[i] = xsum[i] / wtsum
233 for jj in range(i1, i2 + 1):
234 for i in range(1, nspec + 1):
235 hcomp[i, jj] = xsum[i]
236
237 # The mixed regions (Fortran lines 399–403).
238 if nzone >= 1:
239 zones = "".join(f"({mxzone[i, 1]:5d},{mxzone[i, 2]:5d}) "
240 for i in range(1, nzone + 1))
241 iounits_mod.write(iounits_mod.ishort,
242 " ZONES MIXED IN ORDER--" + zones) # format 110
243
244 # Microscopic diffusion (Bahcall and Loeb) (MHP 12/89) (Fortran lines
245 # 405–465).
246 if nml.ldify:
247 _settle(delts, hcomp, hd, hp, hr, hs, hs1, hstot, ht, lc, m, jenv)
248
249 # Clean up small anomalies (negative abundances ...) (Fortran lines
250 # 466–475).
251 for i in range(1, m + 1): # DO 180
252 for j in range(1, nspec + 1):
253 hcomp[j, i] = max(hcomp[j, i], 0.0)
254 hcomp[j, i] = min(hcomp[j, i], 1.0)
255 hcomp[3, i] = min(hcomp[3, i], 1.0 - hcomp[1, i] - hcomp[4, i])
256 hcomp[2, i] = 1.0 - hcomp[1, i] - hcomp[3, i] - hcomp[4, i]
257
258 # Reset JENV, JCORE for deep mixing, with the true flags (MHP 1/95)
259 # (Fortran lines 476–480).
260 if nml.dpenv < 1.0 and itlvl > 1:
261 jcore, jenv, nrzone, nzone, nzone0 = convec(
262 hcomp, hd, hp, hr, hs, ht, lc, m, mrzone, mxzone, mxzon0,
263 jcore, jenv, nrzone, nzone, nzone0)
264
265 # Deuterium burning (MHP 5/02) (Fortran lines 481–505).
266 # Question (see the page): the units of DRATE.
267 if nml.lexcom:
268 dt = ddage * 1.0e-9
269 done = False
270 for k in range(1, nrzone + 1):
271 for j in range(mrzone[k, 1], mrzone[k, 2] + 1):
272 if ht[j] <= nml.tcut[1]:
273 done = True # GOTO 190
274 break
275 ibegin = j
276 iend = j
277 dburn(ibegin, iend, m, hs2, hcomp, dt)
278 if done:
279 break
280 for k in range(1, nzone + 1):
281 ibegin = mxzone[k, 1]
282 iend = mxzone[k, 2]
283 dburn(ibegin, iend, m, hs2, hcomp, dt)
284
285 return ddage, jcore, jenv
286
287
288def _settle(delts: float, hcomp: np.ndarray, hd: np.ndarray, hp: np.ndarray, hr: np.ndarray, hs: np.ndarray,
289 hs1: np.ndarray, hstot: float, ht: np.ndarray, lc: np.ndarray, m: int, jenv: int) -> None:
290 # The IF(LDIFY) block, labels 130-170: gravitational settling in
291 # NSTEP substeps limited by the helium settling time at the outer
292 # boundary. Reads the module-level LCC.
293 c = constants_mod
294 nml = nmlpar_mod
295
296 # Settling off below XMIN (Fortran lines 413–416).
297 # Question (see the page): settling stops for good below XMIN.
298 if hcomp[1, 1] < nml.xmin:
299 nml.ldify = False
300 return # GOTO 170
301
302 # Fortran lines 417–420.
303 stot = math.exp(c.cln * hstot)
304 for i in range(1, m + 1): # DO 130: d ln P/dr = -G m rho / (r^2 P)
305 hqpr[i] = -math.exp(c.cln * (hd[i] + c.cgl + hs[i] - 2.0 * hr[i]
306 - hp[i]))
307
308 # The outer boundary: the surface convection zone, or the first point
309 # (inward from JENV) where Y exceeds YMIN (Fortran lines 421–438).
310 # Question (see the page): YMIN as the documentation describes it.
311 if not lc[m]:
312 # A warning only (DBG 2/92).
313 iounits_mod.write(iounits_mod.ishort,
314 " NO SURFACE CZ - DIFFUSION NOT MEANINGFUL")
315 return
316 for j in range(jenv, 0, -1): # DO 140
317 if hcomp[2, j] > nml.ymin:
318 break # GOTO 150
319 else:
320 return # Y < YMIN for the whole star
321
322 # FM: the mass fraction above the outer point; TSCALE: the helium
323 # settling time there (Michaud et al. 1984) (Fortran lines 440–454).
324 # Question (see the page): the substep bound.
325 fm = (stot - hs1[j]) / stot
326 tscale = 4.348e21 * c.csecyr * fm / math.exp(c.cln * 1.5 * ht[j])
327 dtmax = nml.dt_gs * tscale
328 nstep = int(delts / dtmax)
329 if math.fmod(delts, dtmax) != 0.0 or nstep == 0:
330 nstep = nstep + 1
331 dt = delts / float(nstep)
332
333 # The substeps (Fortran lines 455–463).
334 # Question (see the page): LCC, not the mixed-zone flags.
335 for ns in range(1, nstep + 1): # DO 160
336 if nml.lnewdif:
337 microdiff(dt, hcomp, hqpr, hr, hd, hs1, ht, lcc, m, stot)
338 else:
339 grsett(dt, hcomp, hqpr, hr, hd, hs1, ht, lcc, m, stot)