@@ -1056,42 +1056,6 @@ contains
1056
1056
call s_update_tmp_rkck(RKstep, q_cons_ts, rhs_ts_adapt, q_prim_vf)
1057
1057
if (lag_largestep) goto 502
1058
1058
1059
- ! maxDV_rhs = - 100.0d0
1060
- ! maxQcons(1 :sys_size) = - 100.0d0
1061
- ! minDV_rhs = 100.0d0
1062
- ! minQcons(1 :sys_size) = 100.0d0
1063
- ! !$acc parallel loop collapse(4 ) gang vector default(present) copyin(RKstep)
1064
- ! do l = 1 , sys_size
1065
- ! do k = 0 , p
1066
- ! do j = 0 , n
1067
- ! do i = 0 , m
1068
- ! q_cons_ts(2 )%vf(l)%sf(i, j, k) = q_cons_ts(1 )%vf(l)%sf(i, j, k)
1069
- ! !$acc loop seq
1070
- ! do q = 1 , RKstep
1071
- ! q_cons_ts(2 )%vf(l)%sf(i, j, k) = &
1072
- ! q_cons_ts(2 )%vf(l)%sf(i, j, k) + &
1073
- ! dt* lag_RKcoef(RKstep, q)* rhs_ts_adapt(q)%vf(l)%sf(i, j, k)
1074
- ! if (maxDV_rhs < rhs_ts_adapt(q)%vf(l)%sf(i, j, k)) then
1075
- ! cellDV_max(1 ) = i
1076
- ! cellDV_max(1 ) = j
1077
- ! cellDV_max(1 ) = k
1078
- ! end if
1079
- ! maxDV_rhs = max (maxDV_rhs, rhs_ts_adapt(q)%vf(l)%sf(i, j, k))
1080
- ! minDV_rhs = min (minDV_rhs, rhs_ts_adapt(q)%vf(l)%sf(i, j, k))
1081
- ! maxQcons(l) = max (maxQcons(l), q_cons_ts(2 )%vf(l)%sf(i, j, k))
1082
- ! minQcons(l) = min (minQcons(l), q_cons_ts(2 )%vf(l)%sf(i, j, k))
1083
-
1084
- ! end do
1085
- ! end do
1086
- ! end do
1087
- ! end do
1088
- ! end do
1089
- ! print * ,' rhs_1: min max' , minDV_rhs, maxDV_rhs, cellDV_max, m, n, p
1090
-
1091
- ! do l = 1 , sys_size
1092
- ! print * ,' qcons_1: min max' , maxQcons(l), minQcons(l), l
1093
- ! end do
1094
-
1095
1059
! Second time- stage
1096
1060
time_tmp = time_prev + 0.2d0 * dt
1097
1061
RKstep = 2
@@ -1186,7 +1150,7 @@ contains
1186
1150
lag_errmax = lag_errmax/ lag_rkck_tolerance ! Scale relative to user required tolerance.
1187
1151
1188
1152
if ((lag_errmax > 1.0d0 )) then ! Truncation error too large, reduce dt and restart time step
1189
- htemp = SAFETY* RKh* (lag_errmax** PSHRNK)
1153
+ htemp = SAFETY* RKh* ((floor( lag_errmax* 1.0d05 ) / 1.0d05 ) ** PSHRNK)
1190
1154
RKh = sign (max (abs (htemp), 0.1d0 * abs (RKh)), RKh) ! No more than a factor of 10 .
1191
1155
if (proc_rank == 0 ) print * , ' >>>>> WARNING: Truncation error found. Reducing dt and restaring time step, now dt: ' , RKh
1192
1156
lag_largestep = .false.
@@ -1195,7 +1159,7 @@ contains
1195
1159
goto 501
1196
1160
else ! Step succeeded. Compute size of next step.
1197
1161
if (lag_errmax > ERRCON) then
1198
- dt = SAFETY* RKh* (lag_errmax** PGROW) ! No more than a factor of 5 increase.
1162
+ dt = SAFETY* RKh* ((floor( lag_errmax* 1.0d05 ) / 1.0d05 ) ** PGROW) ! No more than a factor of 5 increase.
1199
1163
else
1200
1164
dt = 2.0d0 * RKh ! Truncation error too small (< 1.89e-4 ), increase time step
1201
1165
end if
0 commit comments