Skip to content

Commit 776548d

Browse files
danieljvickersdanieljvickers
committed
Tests also pass with second loop. Now moving on to more tests
1 parent d053365 commit 776548d

File tree

1 file changed

+29
-92
lines changed

1 file changed

+29
-92
lines changed

‎src/simulation/m_time_steppers.fpp‎

Lines changed: 29 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -357,11 +357,11 @@ contains
357357

358358
end subroutine s_initialize_time_steppers_module
359359

360-
subroutine s_evolve_q(index, scaler1, scaler2, scaler3) !! TODO :: Get a better name for this
360+
subroutine s_evolve_q_pb_mv(index, scaler1, scaler2, scaler3) !! TODO :: Get a better name for this
361361

362362
integer, intent(in) :: index !! TODO :: I have no idea what index is meant to represent. Rename this.
363363
real(wp), intent(in) :: scaler1, scaler2, scaler3
364-
integer :: i, j, k, l
364+
integer :: i, j, k, l, q
365365

366366
!$acc parallel loop collapse(4) gang vector default(present)
367367
do i = 1, sys_size
@@ -377,7 +377,31 @@ contains
377377
end do
378378
end do
379379

380-
end subroutine s_evolve_q
380+
!Evolve pb and mv for non-polytropic qbmm
381+
if (qbmm .and. (.not. polytropic)) then
382+
!$acc parallel loop collapse(5) gang vector default(present)
383+
do i = 1, nb
384+
do l = 0, p
385+
do k = 0, n
386+
do j = 0, m
387+
do q = 1, nnode
388+
pb_ts(index)%sf(j, k, l, q, i) = &
389+
(scaler1 * pb_ts(1)%sf(j, k, l, q, i) &
390+
+ scaler2 * pb_ts(2)%sf(j, k, l, q, i) &
391+
+ scaler3 * dt * rhs_pb(j, k, l, q, i)) / (scaler1 + scaler2)
392+
393+
mv_ts(index)%sf(j, k, l, q, i) = &
394+
(scaler1 * mv_ts(1)%sf(j, k, l, q, i) &
395+
+ scaler2 * mv_ts(2)%sf(j, k, l, q, i) &
396+
+ scaler3 * dt * rhs_mv(j, k, l, q, i)) / (scaler1 + scaler2)
397+
end do
398+
end do
399+
end do
400+
end do
401+
end do
402+
end if
403+
404+
end subroutine s_evolve_q_pb_mv
381405

382406
!> 1st order TVD RK time-stepping algorithm
383407
!! @param t_step Current time step
@@ -714,42 +738,7 @@ contains
714738
call s_update_lagrange_tdv_rk(stage=1)
715739
end if
716740

717-
call s_evolve_q(2, 1.0_wp, 0.0_wp, 1.0_wp)
718-
719-
!Evolve pb and mv for non-polytropic qbmm
720-
if (qbmm .and. (.not. polytropic)) then
721-
!$acc parallel loop collapse(5) gang vector default(present)
722-
do i = 1, nb
723-
do l = 0, p
724-
do k = 0, n
725-
do j = 0, m
726-
do q = 1, nnode
727-
pb_ts(2)%sf(j, k, l, q, i) = &
728-
pb_ts(1)%sf(j, k, l, q, i) &
729-
+ dt*rhs_pb(j, k, l, q, i)
730-
end do
731-
end do
732-
end do
733-
end do
734-
end do
735-
end if
736-
737-
if (qbmm .and. (.not. polytropic)) then
738-
!$acc parallel loop collapse(5) gang vector default(present)
739-
do i = 1, nb
740-
do l = 0, p
741-
do k = 0, n
742-
do j = 0, m
743-
do q = 1, nnode
744-
mv_ts(2)%sf(j, k, l, q, i) = &
745-
mv_ts(1)%sf(j, k, l, q, i) &
746-
+ dt*rhs_mv(j, k, l, q, i)
747-
end do
748-
end do
749-
end do
750-
end do
751-
end do
752-
end if
741+
call s_evolve_q_pb_mv(2, 1.0_wp, 0.0_wp, 1.0_wp)
753742

754743
if (bodyForces) call s_apply_bodyforces(q_cons_ts(2)%vf, q_prim_vf, rhs_vf, dt)
755744

@@ -778,59 +767,7 @@ contains
778767
call s_update_lagrange_tdv_rk(stage=2)
779768
end if
780769

781-
!$acc parallel loop collapse(4) gang vector default(present)
782-
do i = 1, sys_size
783-
do l = 0, p
784-
do k = 0, n
785-
do j = 0, m
786-
q_cons_ts(2)%vf(i)%sf(j, k, l) = &
787-
(3._wp*q_cons_ts(1)%vf(i)%sf(j, k, l) &
788-
+ q_cons_ts(2)%vf(i)%sf(j, k, l) &
789-
+ dt*rhs_vf(i)%sf(j, k, l))/4._wp
790-
end do
791-
end do
792-
end do
793-
end do
794-
795-
if (qbmm .and. (.not. polytropic)) then
796-
!$acc parallel loop collapse(5) gang vector default(present)
797-
do i = 1, nb
798-
do l = 0, p
799-
do k = 0, n
800-
do j = 0, m
801-
do q = 1, nnode
802-
pb_ts(2)%sf(j, k, l, q, i) = &
803-
(3._wp*pb_ts(1)%sf(j, k, l, q, i) &
804-
+ pb_ts(2)%sf(j, k, l, q, i) &
805-
+ dt*rhs_pb(j, k, l, q, i))/4._wp
806-
mv_ts(2)%sf(j, k, l, q, i) = &
807-
(3._wp*mv_ts(1)%sf(j, k, l, q, i) &
808-
+ mv_ts(2)%sf(j, k, l, q, i) &
809-
+ dt*rhs_mv(j, k, l, q, i))/4._wp
810-
end do
811-
end do
812-
end do
813-
end do
814-
end do
815-
end if
816-
817-
!! if (qbmm .and. (.not. polytropic)) then
818-
!! !$acc parallel loop collapse(5) gang vector default(present)
819-
!! do i = 1, nb
820-
!! do l = 0, p
821-
!! do k = 0, n
822-
!! do j = 0, m
823-
!! do q = 1, nnode
824-
!! mv_ts(2)%sf(j, k, l, q, i) = &
825-
!! (3._wp*mv_ts(1)%sf(j, k, l, q, i) &
826-
!! + mv_ts(2)%sf(j, k, l, q, i) &
827-
!! + dt*rhs_mv(j, k, l, q, i))/4._wp
828-
!! end do
829-
!! end do
830-
!! end do
831-
!! end do
832-
!! end do
833-
!! end if
770+
call s_evolve_q_pb_mv(2, 3.0_wp, 1.0_wp, 1.0_wp)
834771

835772
if (bodyForces) call s_apply_bodyforces(q_cons_ts(2)%vf, q_prim_vf, rhs_vf, dt/4._wp)
836773

0 commit comments

Comments
 (0)