EVOLUTION: Add status flag to update_variables().
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
9f1c072704
commit
86cf55e836
@ -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 */
|
||||
|
||||
|
Loading…
x
Reference in New Issue
Block a user