public pure function vhbt_to_vbt(vhbt, BTC) result(vbt)
Meridional mirror of uhbt_to_ubt.
Arguments
| Type |
Intent | Optional | Attributes |
|
Name |
|
|
real(kind=wp),
|
intent(in) |
|
|
:: |
vhbt |
|
|
type(local_BT_cont_v_type),
|
intent(in) |
|
|
:: |
BTC |
|
Return Value
real(kind=wp)
Variables
| Type |
Visibility | Attributes |
|
Name |
| Initial | |
|
real(kind=wp),
|
private |
|
:: |
derr_dv |
|
|
|
|
integer,
|
private |
|
:: |
itt |
|
|
|
|
integer,
|
private, |
parameter
|
:: |
max_itt |
= |
20 |
|
|
real(kind=wp),
|
private, |
parameter
|
:: |
tol |
= |
1.0e-10_wp |
|
|
real(kind=wp),
|
private |
|
:: |
vbt_max |
|
|
|
|
real(kind=wp),
|
private |
|
:: |
vbt_min |
|
|
|
|
real(kind=wp),
|
private |
|
:: |
vhbt_err |
|
|
|
|
real(kind=wp),
|
private |
|
:: |
vherr_max |
|
|
|
|
real(kind=wp),
|
private |
|
:: |
vherr_min |
|
|
|
Source Code
pure function vhbt_to_vbt(vhbt, BTC) result(vbt)
!! Meridional mirror of `uhbt_to_ubt`.
real(wp), intent(in) :: vhbt
type(local_BT_cont_v_type), intent(in) :: BTC
real(wp) :: vbt
real(wp) :: vbt_min, vbt_max
real(wp) :: vhbt_err, derr_dv
real(wp) :: vherr_min, vherr_max
real(wp), parameter :: tol = 1.0e-10_wp
integer, parameter :: max_itt = 20
integer :: itt
if (vhbt == 0.0_wp) then
vbt = 0.0_wp
else if (vhbt < BTC%vh_NN) then
vbt = BTC%vBT_NN + (vhbt - BTC%vh_NN)/BTC%FA_v_NN
else if (vhbt < 0.0_wp) then
vbt_min = BTC%vBT_NN
vherr_min = BTC%vh_NN - vhbt
vbt_max = 0.0_wp
vherr_max = -vhbt
vbt = BTC%vBT_NN*(vhbt/BTC%vh_NN)
do itt = 1, max_itt
vhbt_err = vbt*(BTC%FA_v_N0 + BTC%vh_crvN*vbt**2) - vhbt
if (abs(vhbt_err) < tol*abs(vhbt)) exit
if (vhbt_err > 0.0_wp) then
vbt_max = vbt
vherr_max = vhbt_err
end if
if (vhbt_err < 0.0_wp) then
vbt_min = vbt
vherr_min = vhbt_err
end if
derr_dv = BTC%FA_v_N0 + 3.0_wp*BTC%vh_crvN*vbt**2
if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
(-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0_wp)) then
vbt = vbt_max + (vbt_min - vbt_max)*(vherr_max/(vherr_max - vherr_min))
else
vbt = vbt - vhbt_err/derr_dv
if (abs(vhbt_err) < (0.01_wp*tol)*abs(vbt_min*derr_dv)) exit
end if
end do
else if (vhbt <= BTC%vh_SS) then
vbt_min = 0.0_wp
vherr_min = -vhbt
vbt_max = BTC%vBT_SS
vherr_max = BTC%vh_SS - vhbt
vbt = BTC%vBT_SS*(vhbt/BTC%vh_SS)
do itt = 1, max_itt
vhbt_err = vbt*(BTC%FA_v_S0 + BTC%vh_crvS*vbt**2) - vhbt
if (abs(vhbt_err) < tol*abs(vhbt)) exit
if (vhbt_err > 0.0_wp) then
vbt_max = vbt
vherr_max = vhbt_err
end if
if (vhbt_err < 0.0_wp) then
vbt_min = vbt
vherr_min = vhbt_err
end if
derr_dv = BTC%FA_v_S0 + 3.0_wp*BTC%vh_crvS*vbt**2
if ((vhbt_err >= derr_dv*(vbt - vbt_min)) .or. &
(-vhbt_err >= derr_dv*(vbt_max - vbt)) .or. (derr_dv <= 0.0_wp)) then
vbt = vbt_min + (vbt_max - vbt_min)*(-vherr_min/(vherr_max - vherr_min))
else
vbt = vbt - vhbt_err/derr_dv
if (abs(vhbt_err) < (0.01_wp*tol)*(vbt_max*derr_dv)) exit
end if
end do
else
vbt = BTC%vBT_SS + (vhbt - BTC%vh_SS)/BTC%FA_v_SS
end if
end function vhbt_to_vbt