@@ -3092,19 +3092,15 @@ contains
30923092 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
30933093 if (mhd) then
30943094 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
3095- B%L(1) = Bx0
3096- B%R(1) = Bx0
3097- B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg)
3098- B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg)
3099- B%L(3) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1)
3100- B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1)
3095+ B%L = [Bx0, qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg), qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1)]
3096+ B%R = [Bx0, qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg), qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + 1)]
31013097 else ! 2D/3D: Bx, By, Bz as variables
3102- B%L(1) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(1) - 1)
3103- B%R(1) = qR_prim_rs ${XYZ}$_vf(j + 1 , k, l, B_idx%beg + dir_idx(1 ) - 1)
3104- B%L(2) = qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(2 ) - 1)
3105- B%R(2) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(2 ) - 1)
3106- B%L(3) = qL_prim_rs ${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(3 ) - 1)
3107- B%R(3) = qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(3) - 1)
3098+ B%L = [ qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(1) - 1), &
3099+ qL_prim_rs ${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(2 ) - 1), &
3100+ qL_prim_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(3 ) - 1)]
3101+ B%R = [ qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(1 ) - 1), &
3102+ qR_prim_rs ${XYZ}$_vf(j + 1 , k, l, B_idx%beg + dir_idx(2 ) - 1), &
3103+ qR_prim_rs${XYZ}$_vf(j + 1, k, l, B_idx%beg + dir_idx(3) - 1)]
31083104 end if
31093105 end if
31103106
@@ -3155,74 +3151,38 @@ contains
31553151 E_starL = ((s_L - vel%L(1))*E%L - pTot_L*vel%L(1) + p_star*s_M)/(s_L - s_M)
31563152 E_starR = ((s_R - vel%R(1))*E%R - pTot_R*vel%R(1) + p_star*s_M)/(s_R - s_M)
31573153
3158- ! (5) Compute the left/right conserved state vectors
3159- U_L(1) = rho%L
3160- U_L(2) = rho%L*vel%L(1)
3161- U_L(3) = rho%L*vel%L(2)
3162- U_L(4) = rho%L*vel%L(3)
3163- U_L(5) = B%L(2)
3164- U_L(6) = B%L(3)
3165- U_L(7) = E%L
3166-
3167- U_R(1) = rho%R
3168- U_R(2) = rho%R*vel%R(1)
3169- U_R(3) = rho%R*vel%R(2)
3170- U_R(4) = rho%R*vel%R(3)
3171- U_R(5) = B%R(2)
3172- U_R(6) = B%R(3)
3173- U_R(7) = E%R
3174-
3175- ! (6) Compute the left/right star state vectors
3176- U_starL(1) = rhoL_star
3177- U_starL(2) = rhoL_star*s_M
3178- U_starL(3) = rhoL_star*vel%L(2)
3179- U_starL(4) = rhoL_star*vel%L(3)
3180- U_starL(5) = B%L(2)
3181- U_starL(6) = B%L(3)
3182- U_starL(7) = E_starL
3183-
3184- U_starR(1) = rhoR_star
3185- U_starR(2) = rhoR_star*s_M
3186- U_starR(3) = rhoR_star*vel%R(2)
3187- U_starR(4) = rhoR_star*vel%R(3)
3188- U_starR(5) = B%R(2)
3189- U_starR(6) = B%R(3)
3190- U_starR(7) = E_starR
3191-
3192- ! (7) Compute the left/right fluxes
3193- F_L(1) = rho%L*vel%L(1)
3194- F_L(2) = rho%L*vel%L(1)*vel%L(1) - B%L(1)*B%L(1) + pTot_L
3195- F_L(3) = rho%L*vel%L(1)*vel%L(2) - B%L(1)*B%L(2)
3196- F_L(4) = rho%L*vel%L(1)*vel%L(3) - B%L(1)*B%L(3)
3197- F_L(5) = vel%L(1)*B%L(2) - vel%L(2)*B%L(1)
3198- F_L(6) = vel%L(1)*B%L(3) - vel%L(3)*B%L(1)
3154+ ! (5) Compute left/right state vectors and fluxes
3155+ U_L = [rho%L, rho%L*vel%L(1:3), B%L(2:3), E%L]
3156+ U_starL = [rhoL_star, rhoL_star*s_M, rhoL_star*vel%L(2:3), B%L(2:3), E_starL]
3157+ U_R = [rho%R, rho%R*vel%R(1:3), B%R(2:3), E%R]
3158+ U_starR = [rhoR_star, rhoR_star*s_M, rhoR_star*vel%R(2:3), B%R(2:3), E_starR]
3159+
3160+ ! Compute the left/right fluxes
3161+ F_L(1) = U_L(2)
3162+ F_L(2) = U_L(2)*vel%L(1) - B%L(1)*B%L(1) + pTot_L
3163+ F_L(3:4) = U_L(2)*vel%L(2:3) - B%L(1)*B%L(2:3)
3164+ F_L(5:6) = vel%L(1)*B%L(2:3) - vel%L(2:3)*B%L(1)
31993165 F_L(7) = (E%L + pTot_L)*vel%L(1) - B%L(1)*(vel%L(1)*B%L(1) + vel%L(2)*B%L(2) + vel%L(3)*B%L(3))
3200-
3201- F_R(1) = rho%R*vel%R(1)
3202- F_R(2) = rho%R*vel%R(1)*vel%R(1) - B%R(1)*B%R(1) + pTot_R
3203- F_R(3) = rho%R*vel%R(1)*vel%R(2) - B%R(1)*B%R(2)
3204- F_R(4) = rho%R*vel%R(1)*vel%R(3) - B%R(1)*B%R(3)
3205- F_R(5) = vel%R(1)*B%R(2) - vel%R(2)*B%R(1)
3206- F_R(6) = vel%R(1)*B%R(3) - vel%R(3)*B%R(1)
3166+
3167+ F_R(1) = U_R(2)
3168+ F_R(2) = U_R(2)*vel%R(1) - B%R(1)*B%R(1) + pTot_R
3169+ F_R(3:4) = U_R(2)*vel%R(2:3) - B%R(1)*B%R(2:3)
3170+ F_R(5:6) = vel%R(1)*B%R(2:3) - vel%R(2:3)*B%R(1)
32073171 F_R(7) = (E%R + pTot_R)*vel%R(1) - B%R(1)*(vel%R(1)*B%R(1) + vel%R(2)*B%R(2) + vel%R(3)*B%R(3))
3208-
3209- ! (8) Compute the left/right star fluxes (note array operations)
3210- F_starL = F_L + s_L*(U_starL - U_L)
3211- F_starR = F_R + s_R*(U_starR - U_R)
3212-
3213- ! (9) Compute the rotational (Alfvén) speeds
3172+ ! Compute the star flux using HLL relation
3173+ F_starL = F_L + s_M*(U_starL - U_L)
3174+ F_starR = F_R + s_M*(U_starR - U_R)
3175+ ! Compute the rotational (Alfvén) speeds
32143176 s_starL = s_M - abs(B%L(1))/sqrt(rhoL_star)
32153177 s_starR = s_M + abs(B%L(1))/sqrt(rhoR_star)
3178+ ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
3179+ sqrt_rhoL_star = sqrt(rhoL_star); sqrt_rhoR_star = sqrt(rhoR_star)
3180+ vL_star = vel%L(2); wL_star = vel%L(3)
3181+ vR_star = vel%R(2); wR_star = vel%R(3)
32163182
3217- ! (10) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
3218- sqrt_rhoL_star = sqrt(rhoL_star)
3219- sqrt_rhoR_star = sqrt(rhoR_star)
3183+ ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
32203184 denom_ds = sqrt_rhoL_star + sqrt_rhoR_star
32213185 sign_Bx = sign(1._wp, B%L(1))
3222- vL_star = vel%L(2)
3223- wL_star = vel%L(3)
3224- vR_star = vel%R(2)
3225- wR_star = vel%R(3)
32263186 v_double = (sqrt_rhoL_star*vL_star + sqrt_rhoR_star*vR_star + (B%R(2) - B%L(2))*sign_Bx)/denom_ds
32273187 w_double = (sqrt_rhoL_star*wL_star + sqrt_rhoR_star*wR_star + (B%R(3) - B%L(3))*sign_Bx)/denom_ds
32283188 By_double = (sqrt_rhoL_star*B%R(2) + sqrt_rhoR_star*B%L(2) + sqrt_rhoL_star*sqrt_rhoR_star*(vR_star - vL_star)*sign_Bx)/denom_ds
@@ -3232,21 +3192,8 @@ contains
32323192 E_doubleR = E_starR + sqrt_rhoR_star*((vR_star*B%R(2) + wR_star*B%R(3)) - (v_double*By_double + w_double*Bz_double))*sign_Bx
32333193 E_double = 0.5_wp*(E_doubleL + E_doubleR)
32343194
3235- U_doubleL(1) = rhoL_star
3236- U_doubleL(2) = rhoL_star*s_M
3237- U_doubleL(3) = rhoL_star*v_double
3238- U_doubleL(4) = rhoL_star*w_double
3239- U_doubleL(5) = By_double
3240- U_doubleL(6) = Bz_double
3241- U_doubleL(7) = E_double
3242-
3243- U_doubleR(1) = rhoR_star
3244- U_doubleR(2) = rhoR_star*s_M
3245- U_doubleR(3) = rhoR_star*v_double
3246- U_doubleR(4) = rhoR_star*w_double
3247- U_doubleR(5) = By_double
3248- U_doubleR(6) = Bz_double
3249- U_doubleR(7) = E_double
3195+ U_doubleL = [rhoL_star, rhoL_star*s_M, rhoL_star*v_double, rhoL_star*w_double, By_double, Bz_double, E_double]
3196+ U_doubleR = [rhoR_star, rhoR_star*s_M, rhoR_star*w_double, rhoR_star*w_double, By_double, Bz_double, E_double]
32503197
32513198 ! (11) Choose HLLD flux based on wave-speed regions
32523199 if (0.0_wp <= s_L) then
@@ -3267,16 +3214,12 @@ contains
32673214 ! Mass
32683215 flux_rs${XYZ}$_vf(j, k, l, 1) = F_hlld(1) ! TODO multi-component
32693216 ! Momentum
3270- flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(1)) = F_hlld(2)
3271- flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(2)) = F_hlld(3)
3272- flux_rs${XYZ}$_vf(j, k, l, contxe + dir_idx(3)) = F_hlld(4)
3217+ flux_rs${XYZ}$_vf(j, k, l, [contxe + dir_idx(1), contxe + dir_idx(2), contxe + dir_idx(3)]) = F_hlld([2, 3, 4])
32733218 ! Magnetic field
32743219 if (n == 0) then
3275- flux_rs${XYZ}$_vf(j, k, l, B_idx%beg) = F_hlld(5)
3276- flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + 1) = F_hlld(6)
3220+ flux_rs${XYZ}$_vf(j, k, l, [B_idx%beg, B_idx%beg + 1]) = F_hlld([5, 6])
32773221 else
3278- flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(2) - 1) = F_hlld(5)
3279- flux_rs${XYZ}$_vf(j, k, l, B_idx%beg + dir_idx(3) - 1) = F_hlld(6)
3222+ flux_rs${XYZ}$_vf(j, k, l, [B_idx%beg + dir_idx(2) - 1, B_idx%beg + dir_idx(3) - 1]) = F_hlld([5, 6])
32803223 end if
32813224 ! Energy
32823225 flux_rs${XYZ}$_vf(j, k, l, E_idx) = F_hlld(7)
0 commit comments