subroutine read_parameters_materials_wrf(wrf, json, key_base)
! 引数:
! wrf: wrfまたはhcf型のインスタンス (多態性のためclassで宣言)
! json: JSONパーサーのインスタンス
! key_base: パラメータへの基底パス
class(type_materials_wrf), intent(inout) :: wrf
type(json_file), intent(inout) :: json
character(*), intent(in) :: key_base
! ローカル変数
logical :: found
character(:), allocatable :: key
! ----------------------------------------------------------------
! 1. 共通パラメータの読み込み (wrfとhcfの両方に存在する)
! ----------------------------------------------------------------
! model_numberの読み込みとチェック
key = join([key_base, 'model_number'])
call json%get(key, wrf%model_number, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (.not. value_in_range(wrf%model_number, 1, 6)) then
call json%destroy()
call error_message(905, c_opt=key)
end if
! theta_sの読み込みとチェック
key = join([key_base, 'theta_s'])
call json%get(key, wrf%theta_s, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
end if
! theta_rの読み込みとチェック
key = join([key_base, 'theta_r'])
call json%get(key, wrf%theta_r, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%theta_s <= wrf%theta_r .or. &
wrf%theta_s <= 0.0d0 .or. &
wrf%theta_r < 0.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
! alpha1の読み込みとチェック
key = join([key_base, 'alpha1'])
call json%get(key, wrf%alpha1, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
end if
! n1の読み込みとチェック
key = join([key_base, 'n1'])
call json%get(key, wrf%n1, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%n1 <= 1.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
wrf%m1 = 1.0d0 - 1.0d0 / wrf%n1
! model_numberに応じた共通パラメータの読み込み
select case (wrf%model_number)
case (4)
key = join([key_base, 'h_crit'])
call json%get(key, wrf%h_crit, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%h_crit > 0.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
case (5)
key = join([key_base, 'alpha2'])
call json%get(key, wrf%alpha2, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%alpha2 <= 0.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
key = join([key_base, 'n2'])
call json%get(key, wrf%n2, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%n2 <= 1.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
wrf%m2 = 1.0d0 - 1.0d0 / wrf%n2
key = join([key_base, 'w1'])
call json%get(key, wrf%w1, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%w1 < 0.0d0 .or. wrf%w1 > 1.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
wrf%w2 = 1.0d0 - wrf%w1
case (6)
key = join([key_base, 'n2'])
call json%get(key, wrf%n2, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%n2 <= 1.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
wrf%m2 = 1.0d0 - 1.0d0 / wrf%n2
key = join([key_base, 'w1'])
call json%get(key, wrf%w1, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%w1 < 0.0d0 .or. wrf%w1 > 1.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
wrf%w2 = 1.0d0 - wrf%w1
end select
! ----------------------------------------------------------------
! 2. 型に固有のパラメータを読み込む
! ----------------------------------------------------------------
select type (wrf)
type is (type_materials_hcf)
key = join([key_base, 'l'])
call json%get(key, wrf%l, found)
call json%print_error_message(output_unit)
if (.not. found) then
call json%destroy()
call error_message(904, c_opt=key)
else if (wrf%l <= 0.0d0) then
call json%destroy()
call error_message(905, c_opt=key)
end if
class default
! do nothing
end select
end subroutine read_parameters_materials_wrf