Skip to content

Commit fa024fe

Browse files
danieljvickersdanieljvickers
committed
Ran one last batch of unit tests and removed the final lines of code
1 parent 776548d commit fa024fe

File tree

1 file changed

+7
-196
lines changed

1 file changed

+7
-196
lines changed

‎src/simulation/m_time_steppers.fpp

Lines changed: 7 additions & 196 deletions
Original file line numberDiff line numberDiff line change
@@ -359,8 +359,8 @@ contains
359359

360360
subroutine s_evolve_q_pb_mv(index, scaler1, scaler2, scaler3) !! TODO :: Get a better name for this
361361

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

366366
!$acc parallel loop collapse(4) gang vector default(present)
@@ -371,7 +371,7 @@ contains
371371
q_cons_ts(index)%vf(i)%sf(j, k, l) = &
372372
(scaler1 * q_cons_ts(1)%vf(i)%sf(j, k, l) &
373373
+ scaler2 * q_cons_ts(2)%vf(i)%sf(j, k, l) &
374-
+ scaler3 * dt * rhs_vf(i)%sf(j, k, l)) / (scaler1 + scaler2)
374+
+ scaler3 * dt * rhs_vf(i)%sf(j, k, l)) / (scaler1 + scaler2) !! TODO :: scaler1 + scaler2 should be called a normalization constant
375375
end do
376376
end do
377377
end do
@@ -444,54 +444,7 @@ contains
444444
call s_update_lagrange_tdv_rk(stage=1)
445445
end if
446446

447-
!$acc parallel loop collapse(4) gang vector default(present)
448-
do i = 1, sys_size
449-
do l = 0, p
450-
do k = 0, n
451-
do j = 0, m
452-
q_cons_ts(1)%vf(i)%sf(j, k, l) = &
453-
q_cons_ts(1)%vf(i)%sf(j, k, l) &
454-
+ dt*rhs_vf(i)%sf(j, k, l)
455-
end do
456-
end do
457-
end do
458-
end do
459-
460-
!Evolve pb and mv for non-polytropic qbmm
461-
if (qbmm .and. (.not. polytropic)) then
462-
!$acc parallel loop collapse(5) gang vector default(present)
463-
do i = 1, nb
464-
do l = 0, p
465-
do k = 0, n
466-
do j = 0, m
467-
do q = 1, nnode
468-
pb_ts(1)%sf(j, k, l, q, i) = &
469-
pb_ts(1)%sf(j, k, l, q, i) &
470-
+ dt*rhs_pb(j, k, l, q, i)
471-
end do
472-
end do
473-
end do
474-
end do
475-
end do
476-
end if
477-
478-
if (qbmm .and. (.not. polytropic)) then
479-
!$acc parallel loop collapse(5) gang vector default(present)
480-
do i = 1, nb
481-
do l = 0, p
482-
do k = 0, n
483-
do j = 0, m
484-
do q = 1, nnode
485-
mv_ts(1)%sf(j, k, l, q, i) = &
486-
mv_ts(1)%sf(j, k, l, q, i) &
487-
+ dt*rhs_mv(j, k, l, q, i)
488-
end do
489-
end do
490-
end do
491-
end do
492-
end do
493-
end if
494-
447+
call s_evolve_q_pb_mv(1, 1.0_wp, 0.0_wp, 1.0_wp)
495448

496449
if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, dt)
497450

@@ -550,53 +503,7 @@ contains
550503
call s_update_lagrange_tdv_rk(stage=1)
551504
end if
552505

553-
!$acc parallel loop collapse(4) gang vector default(present)
554-
do i = 1, sys_size
555-
do l = 0, p
556-
do k = 0, n
557-
do j = 0, m
558-
q_cons_ts(2)%vf(i)%sf(j, k, l) = &
559-
q_cons_ts(1)%vf(i)%sf(j, k, l) &
560-
+ dt*rhs_vf(i)%sf(j, k, l)
561-
end do
562-
end do
563-
end do
564-
end do
565-
566-
!Evolve pb and mv for non-polytropic qbmm
567-
if (qbmm .and. (.not. polytropic)) then
568-
!$acc parallel loop collapse(5) gang vector default(present)
569-
do i = 1, nb
570-
do l = 0, p
571-
do k = 0, n
572-
do j = 0, m
573-
do q = 1, nnode
574-
pb_ts(2)%sf(j, k, l, q, i) = &
575-
pb_ts(1)%sf(j, k, l, q, i) &
576-
+ dt*rhs_pb(j, k, l, q, i)
577-
end do
578-
end do
579-
end do
580-
end do
581-
end do
582-
end if
583-
584-
if (qbmm .and. (.not. polytropic)) then
585-
!$acc parallel loop collapse(5) gang vector default(present)
586-
do i = 1, nb
587-
do l = 0, p
588-
do k = 0, n
589-
do j = 0, m
590-
do q = 1, nnode
591-
mv_ts(2)%sf(j, k, l, q, i) = &
592-
mv_ts(1)%sf(j, k, l, q, i) &
593-
+ dt*rhs_mv(j, k, l, q, i)
594-
end do
595-
end do
596-
end do
597-
end do
598-
end do
599-
end if
506+
call s_evolve_q_pb_mv(2, 1.0_wp, 0.0_wp, 1.0_wp)
600507

601508
if (bodyForces) call s_apply_bodyforces(q_cons_ts(2)%vf, q_prim_vf, rhs_vf, dt)
602509

@@ -625,55 +532,7 @@ contains
625532
call s_update_lagrange_tdv_rk(stage=2)
626533
end if
627534

628-
!$acc parallel loop collapse(4) gang vector default(present)
629-
do i = 1, sys_size
630-
do l = 0, p
631-
do k = 0, n
632-
do j = 0, m
633-
q_cons_ts(1)%vf(i)%sf(j, k, l) = &
634-
(q_cons_ts(1)%vf(i)%sf(j, k, l) &
635-
+ q_cons_ts(2)%vf(i)%sf(j, k, l) &
636-
+ dt*rhs_vf(i)%sf(j, k, l))/2._wp
637-
end do
638-
end do
639-
end do
640-
end do
641-
642-
if (qbmm .and. (.not. polytropic)) then
643-
!$acc parallel loop collapse(5) gang vector default(present)
644-
do i = 1, nb
645-
do l = 0, p
646-
do k = 0, n
647-
do j = 0, m
648-
do q = 1, nnode
649-
pb_ts(1)%sf(j, k, l, q, i) = &
650-
(pb_ts(1)%sf(j, k, l, q, i) &
651-
+ pb_ts(2)%sf(j, k, l, q, i) &
652-
+ dt*rhs_pb(j, k, l, q, i))/2._wp
653-
end do
654-
end do
655-
end do
656-
end do
657-
end do
658-
end if
659-
660-
if (qbmm .and. (.not. polytropic)) then
661-
!$acc parallel loop collapse(5) gang vector default(present)
662-
do i = 1, nb
663-
do l = 0, p
664-
do k = 0, n
665-
do j = 0, m
666-
do q = 1, nnode
667-
mv_ts(1)%sf(j, k, l, q, i) = &
668-
(mv_ts(1)%sf(j, k, l, q, i) &
669-
+ mv_ts(2)%sf(j, k, l, q, i) &
670-
+ dt*rhs_mv(j, k, l, q, i))/2._wp
671-
end do
672-
end do
673-
end do
674-
end do
675-
end do
676-
end if
535+
call s_evolve_q_pb_mv(1, 1.0_wp, 1.0_wp, 1.0_wp)
677536

678537
if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, 2._wp*dt/3._wp)
679538

@@ -795,55 +654,7 @@ contains
795654
call s_update_lagrange_tdv_rk(stage=3)
796655
end if
797656

798-
!$acc parallel loop collapse(4) gang vector default(present)
799-
do i = 1, sys_size
800-
do l = 0, p
801-
do k = 0, n
802-
do j = 0, m
803-
q_cons_ts(1)%vf(i)%sf(j, k, l) = &
804-
(q_cons_ts(1)%vf(i)%sf(j, k, l) &
805-
+ 2._wp*q_cons_ts(2)%vf(i)%sf(j, k, l) &
806-
+ 2._wp*dt*rhs_vf(i)%sf(j, k, l))/3._wp
807-
end do
808-
end do
809-
end do
810-
end do
811-
812-
if (qbmm .and. (.not. polytropic)) then
813-
!$acc parallel loop collapse(5) gang vector default(present)
814-
do i = 1, nb
815-
do l = 0, p
816-
do k = 0, n
817-
do j = 0, m
818-
do q = 1, nnode
819-
pb_ts(1)%sf(j, k, l, q, i) = &
820-
(pb_ts(1)%sf(j, k, l, q, i) &
821-
+ 2._wp*pb_ts(2)%sf(j, k, l, q, i) &
822-
+ 2._wp*dt*rhs_pb(j, k, l, q, i))/3._wp
823-
end do
824-
end do
825-
end do
826-
end do
827-
end do
828-
end if
829-
830-
if (qbmm .and. (.not. polytropic)) then
831-
!$acc parallel loop collapse(5) gang vector default(present)
832-
do i = 1, nb
833-
do l = 0, p
834-
do k = 0, n
835-
do j = 0, m
836-
do q = 1, nnode
837-
mv_ts(1)%sf(j, k, l, q, i) = &
838-
(mv_ts(1)%sf(j, k, l, q, i) &
839-
+ 2._wp*mv_ts(2)%sf(j, k, l, q, i) &
840-
+ 2._wp*dt*rhs_mv(j, k, l, q, i))/3._wp
841-
end do
842-
end do
843-
end do
844-
end do
845-
end do
846-
end if
657+
call s_evolve_q_pb_mv(1, 1.0_wp, 2.0_wp, 2.0_wp)
847658

848659
if (bodyForces) call s_apply_bodyforces(q_cons_ts(1)%vf, q_prim_vf, rhs_vf, 2._wp*dt/3._wp)
849660

0 commit comments

Comments
 (0)