@@ -1056,42 +1056,6 @@ contains
10561056 call s_update_tmp_rkck(RKstep, q_cons_ts, rhs_ts_adapt, q_prim_vf)
10571057 if (lag_largestep) goto 502
10581058
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-
10951059 ! Second time- stage
10961060 time_tmp = time_prev + 0.2d0 * dt
10971061 RKstep = 2
@@ -1186,7 +1150,7 @@ contains
11861150 lag_errmax = lag_errmax/ lag_rkck_tolerance ! Scale relative to user required tolerance.
11871151
11881152 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)
11901154 RKh = sign (max (abs (htemp), 0.1d0 * abs (RKh)), RKh) ! No more than a factor of 10 .
11911155 if (proc_rank == 0 ) print * , ' >>>>> WARNING: Truncation error found. Reducing dt and restaring time step, now dt: ' , RKh
11921156 lag_largestep = .false.
@@ -1195,7 +1159,7 @@ contains
11951159 goto 501
11961160 else ! Step succeeded. Compute size of next step.
11971161 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.
11991163 else
12001164 dt = 2.0d0 * RKh ! Truncation error too small (< 1.89e-4 ), increase time step
12011165 end if
0 commit comments