Skip to content

Commit e3c4a06

Browse files
anandrdbzAnand
anandrdbz
and
Anand
authored
QBMM + Non-polytropic Fix (#391)
Co-authored-by: Anand <[email protected]>
1 parent e9549c1 commit e3c4a06

File tree

4 files changed

+190
-165
lines changed

4 files changed

+190
-165
lines changed

‎src/simulation/m_qbmm.fpp‎

Lines changed: 73 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -432,13 +432,13 @@ contains
432432
integer :: idir
433433
integer :: i, j, k, l, q
434434

435-
real(kind(0d0)) :: nb_q, nb_dot, R, R2, nR, nR2, nR_dot, nR2_dot, var
435+
real(kind(0d0)) :: nb_q, nb_dot, R, R2, nR, nR2, nR_dot, nR2_dot, var, AX
436436

437437
if (idir == 1) then
438438

439439
!Non-polytropic qbmm needs to account for change in bubble radius due to a change in nb
440440
if (.not. polytropic) then
441-
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var)
441+
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var, AX)
442442
do i = 1, nb
443443
do q = 1, nnode
444444
do l = 0, p
@@ -451,29 +451,35 @@ contains
451451
R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
452452
R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
453453

454-
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
455-
nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
456-
nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
457-
458-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*R*nb_q**2)* &
459-
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
460-
461454
if (R2 - R**2d0 > 0d0) then
462455
var = R2 - R**2d0
463456
else
464457
var = verysmall
465458
end if
466459

467460
if (q <= 2) then
468-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dx(j)*R*nb_q**2*dsqrt(var))* &
461+
AX = R - dsqrt(var)
462+
else
463+
AX = R + dsqrt(var)
464+
end if
465+
466+
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
467+
nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
468+
nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j - 1, k, l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
469+
470+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*AX*nb_q**2)* &
471+
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
472+
473+
if (q <= 2) then
474+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* &
469475
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
470-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dx(j)*R*nb_q**2*dsqrt(var))* &
476+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* &
471477
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
472478

473479
else
474-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*R*nb_q**2*dsqrt(var))* &
480+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* &
475481
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
476-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*R*nb_q**2*dsqrt(var))* &
482+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dx(j)*AX*nb_q**2*dsqrt(var)*2d0)* &
477483
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
478484
end if
479485

@@ -516,7 +522,7 @@ contains
516522

517523
!Non-polytropic qbmm needs to account for change in bubble radius due to a change in nb
518524
if (.not. polytropic) then
519-
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var)
525+
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var, AX)
520526
do i = 1, nb
521527
do q = 1, nnode
522528
do l = 0, p
@@ -529,29 +535,35 @@ contains
529535
R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
530536
R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
531537

532-
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
533-
nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
534-
nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
535-
536-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*R*nb_q**2)* &
537-
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
538-
539538
if (R2 - R**2d0 > 0d0) then
540539
var = R2 - R**2d0
541540
else
542541
var = verysmall
543542
end if
544543

545544
if (q <= 2) then
546-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dy(k)*R*nb_q**2*dsqrt(var))* &
545+
AX = R - dsqrt(var)
546+
else
547+
AX = R + dsqrt(var)
548+
end if
549+
550+
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
551+
nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
552+
nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k - 1, l) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
553+
554+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*AX*nb_q**2)* &
555+
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
556+
557+
if (q <= 2) then
558+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
547559
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
548-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dy(k)*R*nb_q**2*dsqrt(var))* &
560+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
549561
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
550562

551563
else
552-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*R*nb_q**2*dsqrt(var))* &
564+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
553565
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
554-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*R*nb_q**2*dsqrt(var))* &
566+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dy(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
555567
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
556568
end if
557569

@@ -567,7 +579,7 @@ contains
567579
if (.not. polytropic) then
568580
if (grid_geometry == 3) then
569581
!Non-polytropic qbmm needs to account for change in bubble radius due to a change in nb
570-
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var)
582+
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var, AX)
571583
do i = 1, nb
572584
do q = 1, nnode
573585
do l = 0, p
@@ -580,28 +592,35 @@ contains
580592
R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
581593
R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
582594

583-
nb_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l))
584-
nR_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))
585-
nR2_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l))
586-
587-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*R*nb_q**2)* &
588-
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
589595
if (R2 - R**2d0 > 0d0) then
590596
var = R2 - R**2d0
591597
else
592598
var = verysmall
593599
end if
594600

595601
if (q <= 2) then
596-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*y_cc(k)*R*nb_q**2*dsqrt(var))* &
602+
AX = R - dsqrt(var)
603+
else
604+
AX = R + dsqrt(var)
605+
end if
606+
607+
nb_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l))
608+
nR_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l))
609+
nR2_dot = q_prim_vf(contxe + idir)%sf(j, k, l)*(flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l))
610+
611+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2)* &
612+
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
613+
614+
if (q <= 2) then
615+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
597616
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
598-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*y_cc(k)*R*nb_q**2*dsqrt(var))* &
617+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
599618
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
600619

601620
else
602-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*R*nb_q**2*dsqrt(var))* &
621+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
603622
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
604-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*R*nb_q**2*dsqrt(var))* &
623+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*y_cc(k)*AX*nb_q**2*dsqrt(var)*2d0)* &
605624
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
606625
end if
607626
end do
@@ -611,7 +630,7 @@ contains
611630
end do
612631
else
613632
!Non-polytropic qbmm needs to account for change in bubble radius due to a change in nb
614-
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var)
633+
!$acc parallel loop collapse(5) gang vector default(present) private(nb_q, nR, nR2, R, R2, nb_dot, nR_dot, nR2_dot, var, AX)
615634
do i = 1, nb
616635
do q = 1, nnode
617636
do l = 0, p
@@ -624,29 +643,35 @@ contains
624643
R = q_prim_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
625644
R2 = q_prim_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
626645

627-
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
628-
nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
629-
nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
630-
631-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*R*nb_q**2)* &
632-
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
633-
634646
if (R2 - R**2d0 > 0d0) then
635647
var = R2 - R**2d0
636648
else
637649
var = verysmall
638650
end if
639651

640652
if (q <= 2) then
641-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*R*nb_q**2*dsqrt(var))* &
653+
AX = R - dsqrt(var)
654+
else
655+
AX = R + dsqrt(var)
656+
end if
657+
658+
nb_dot = flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + (i - 1)*nmom)%sf(j, k, l)
659+
nR_dot = flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)
660+
nR2_dot = flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l - 1) - flux_n_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)
661+
662+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*AX*nb_q**2)* &
663+
(nR_dot*nb_q - nR*nb_dot)*(pb(j, k, l, q, i))
664+
665+
if (q <= 2) then
666+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* &
642667
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
643-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*R*nb_q**2*dsqrt(var))* &
668+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) + 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* &
644669
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
645670

646671
else
647-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*R*nb_q**2*dsqrt(var))* &
672+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* &
648673
(nR2_dot*nb_q - nR2*nb_dot)*(pb(j, k, l, q, i))
649-
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*R*nb_q**2*dsqrt(var))* &
674+
rhs_pb(j, k, l, q, i) = rhs_pb(j, k, l, q, i) - 3d0*gam/(dz(l)*AX*nb_q**2*dsqrt(var)*2d0)* &
650675
(-2d0*(nR/nb_q)*(nR_dot*nb_q - nR*nb_dot))*(pb(j, k, l, q, i))
651676
end if
652677

0 commit comments

Comments
 (0)