EVOLUTION: Add status flag to update_variables().

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-09 12:32:49 -03:00
parent 9f1c072704
commit 86cf55e836

View File

@ -1098,7 +1098,8 @@ module evolution
! update primitive variables
!
call update_variables(time + dt, 0.0d+00)
call update_variables(time + dt, 0.0d+00, status)
if (status /= 0) go to 100
! set all meta blocks to be updated
!
@ -1163,7 +1164,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: mlev
integer :: mlev, status
real(kind=8) :: dx_min, fnorm, h0, h1
real(kind=8), dimension(3) :: d
@ -1264,7 +1265,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(time + h0, h0)
call update_variables(time + h0, h0, status)
pdata => list_data
do while (associated(pdata))
@ -1438,6 +1439,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: status
real(kind=8) :: tm, dtm
!
!-------------------------------------------------------------------------------
@ -1482,7 +1484,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -1519,6 +1521,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: status
real(kind=8) :: tm, dtm
!
!-------------------------------------------------------------------------------
@ -1553,7 +1556,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 2nd step: U(n+1) = 1/2 U(n) + 1/2 U(1) + 1/2 dt * F[U(1)]
!
@ -1595,7 +1598,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -1640,7 +1643,7 @@ module evolution
type(block_data), pointer :: pdata
logical :: test
integer :: n, l, nrej
integer :: n, l, nrej, status
real(kind=8) :: tm, dtm, ds, umax, emax
real(kind=8) :: fc, fcmn, fcmx
@ -1737,7 +1740,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! n = 1, stages - 1
@ -1775,7 +1778,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
! find umax
!
@ -1866,7 +1869,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -1904,6 +1907,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: status
real(kind=8) :: ds
real(kind=8) :: tm, dtm
@ -1943,7 +1947,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 2nd step: U(2) = 3/4 U(n) + 1/4 U(1) + 1/4 dt F[U(1)]
!
@ -1971,7 +1975,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 3rd step: U(n+1) = 1/3 U(n) + 2/3 U(2) + 2/3 dt F[U(2)]
!
@ -2013,7 +2017,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -2052,6 +2056,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: status
real(kind=8) :: ds
real(kind=8) :: tm, dtm
!
@ -2088,7 +2093,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 2nd step: U(2) = U(2) + 1/2 dt F[U(1)]
!
@ -2113,7 +2118,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 3rd step: U(3) = 2/3 U(n) + 1/3 (U(2) + 1/2 dt F[U(2)])
!
@ -2140,7 +2145,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= the final step: U(n+1) = U(3) + 1/2 dt F[U(3)]
!
@ -2179,7 +2184,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -2228,7 +2233,7 @@ module evolution
type(block_data), pointer :: pdata
logical :: test
integer :: nrej, i
integer :: nrej, i, status
real(kind=8) :: tm, dtm, dh, fc
real(kind=8), parameter :: onethird = 1.0d+00 / 3.0d+00, &
@ -2295,7 +2300,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! i = 1, 3
@ -2312,7 +2317,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 5th step: U(1) = U(1) + ½ dt F[U(1)] <- 3ʳ-order candidate
!
@ -2338,7 +2343,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 6th step: U(2) = ½ (U(1) + U(2)) <- 2-order approximation
!
@ -2403,7 +2408,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end if
@ -2460,6 +2465,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: status
real(kind=8) :: ds
real(kind=8) :: tm, dtm
@ -2507,7 +2513,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 2nd step: U(2) = U(1) + b1 dt F[U(1)]
!
@ -2533,7 +2539,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 3rd step: U(3) = a31 U(n) + a33 U(2) + b3 dt F[U(2)]
!
@ -2561,7 +2567,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 4th step: U(4) = a41 U(n) + a44 U(3) + b4 dt F[U(3)]
!
@ -2591,7 +2597,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= the final step: U(n+1) = a53 U(2) + a55 U(4) + b5 dt F[U(4)]
!
@ -2631,7 +2637,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -2679,7 +2685,7 @@ module evolution
real(kind=8), save :: f1, f2, f3, f4
logical :: test
integer :: nrej, i
integer :: nrej, i, status
real(kind=8) :: tm, dtm, dh, fc
!
!-------------------------------------------------------------------------------
@ -2766,7 +2772,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! i = 1, i1
@ -2806,7 +2812,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! i = i2, i3
@ -2827,7 +2833,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
!= 6th step: U(1) = U(1) + dt/r F[U(1)], for i = n*(n+1)/2+1...stages
!
@ -2855,7 +2861,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! i = i4, stages
@ -2921,7 +2927,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end if
@ -2977,7 +2983,7 @@ module evolution
type(block_data), pointer :: pdata
integer :: n
integer :: n, status
real(kind=8) :: tm, dtm
real(kind=8), dimension(9) :: ds
@ -3030,7 +3036,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! n = 1, 5
@ -3075,7 +3081,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! n = 6, 9
@ -3117,7 +3123,7 @@ module evolution
end do
end if
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
#ifdef PROFILE
call stop_timer(imu)
@ -3160,7 +3166,7 @@ module evolution
type(block_data), pointer :: pdata
logical :: test
integer :: i, l, nrej
integer :: i, l, nrej, status
real(kind=8) :: tm, dtm, fc
!
!-------------------------------------------------------------------------------
@ -3224,7 +3230,7 @@ module evolution
end do
dtm = c(2) * dt
call update_variables(time, dtm)
call update_variables(time, dtm, status)
!= remaining stages
!
@ -3260,7 +3266,7 @@ module evolution
end do
dtm = c(i+1) * dt
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
end do ! i = 2, stages
@ -3345,7 +3351,7 @@ module evolution
pdata => pdata%next
end do
call update_variables(tm, dtm)
call update_variables(tm, dtm, status)
if (fsal) fsal_update = .false.
end if
@ -3367,7 +3373,7 @@ module evolution
end do
tm = time + dt
call update_variables(tm, dt)
call update_variables(tm, dt, status)
#ifdef PROFILE
call stop_timer(imu)
@ -3585,49 +3591,38 @@ module evolution
!
! Arguments:
!
! tm - time at the moment of update;
! dtm - time step since the last update;
! tm - time at the moment of update;
! dtm - time step since the last update;
! status - status flag indicating if the update was successful;
!
!===============================================================================
!
subroutine update_variables(tm, dtm)
subroutine update_variables(tm, dtm, status)
! include external procedures
!
use blocks , only : set_neighbors_update
use boundaries , only : boundary_variables
use equations , only : update_primitive_variables
use equations , only : fix_unphysical_cells, correct_unphysical_states
use shapes , only : update_shapes
use blocks , only : block_meta, list_meta
use blocks , only : block_data, list_data
use blocks , only : set_neighbors_update
use boundaries, only : boundary_variables
use equations , only : update_primitive_variables
use equations , only : fix_unphysical_cells, correct_unphysical_states
use shapes , only : update_shapes
! include external variables
!
use blocks , only : block_meta, list_meta
use blocks , only : block_data, list_data
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
real(kind=8), intent(in) :: tm, dtm
real(kind=8), intent(in) :: tm, dtm
integer , intent(out) :: status
! local pointers
!
type(block_meta), pointer :: pmeta
type(block_data), pointer :: pdata
!
!-------------------------------------------------------------------------------
!
#ifdef PROFILE
! start accounting time for variable update
!
call start_timer(imv)
#endif /* PROFILE */
! update primitive variables in the changed blocks
!
status = 0
pdata => list_data
do while (associated(pdata))
pmeta => pdata%meta
@ -3637,12 +3632,8 @@ module evolution
pdata => pdata%next
end do
! update boundaries
!
call boundary_variables(tm, dtm)
! apply shapes in blocks which need it
!
pdata => list_data
do while (associated(pdata))
pmeta => pdata%meta
@ -3652,8 +3643,6 @@ module evolution
pdata => pdata%next
end do
! correct unphysical states if detected
!
if (fix_unphysical_cells) then
! if an unphysical cell appeared in a block while updating its primitive
@ -3683,8 +3672,6 @@ module evolution
end if
#ifdef PROFILE
! stop accounting time for variable update
!
call stop_timer(imv)
#endif /* PROFILE */