Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -9,26 +9,26 @@ module lfricinp_add_um_field_to_file_mod
use, intrinsic :: iso_fortran_env, only: real64, int64

! lfricinp modules
use lfricinp_stashmaster_mod, only: get_stashmaster_item, grid, &
p_points, u_points, v_points, &
ozone_points, &
ppfc, &
sm_lbvc => lbvc, &
cfff, &
levelt, &
rho_levels, theta_levels, &
single_level, &
cfll, &
datat
use lfricinp_um_parameters_mod, only: um_imdi, um_rmdi, &
rh_polelat, rh_polelong, &
ldc_zsea_theta, ldc_zsea_rho, &
ldc_c_theta, ldc_c_rho, &
rh_deltaEW, rh_deltaNS, &
ih_model_levels
use lfricinp_check_shumlib_status_mod, only: shumlib
use lfricinp_grid_type_mod, only: lfricinp_grid_type
use lfricinp_stashmaster_mod, only: get_stashmaster_item, grid, &
p_points, u_points, v_points, &
ozone_points, land_compressed, &
ppfc, p_points_values_over_sea, &
sm_lbvc => lbvc, &
cfff, &
levelt, &
rho_levels, theta_levels, &
single_level, &
cfll, &
datat
use lfricinp_um_level_codes_mod, only: lfricinp_get_first_level_num
use lfricinp_check_shumlib_status_mod, only: shumlib
use lfricinp_um_parameters_mod, only: um_imdi, um_rmdi, &
rh_polelat, rh_polelong, &
ldc_zsea_theta, ldc_zsea_rho, &
ldc_c_theta, ldc_c_rho, &
rh_deltaEW, rh_deltaNS, &
ih_model_levels


! lfric modules
Expand All @@ -40,7 +40,7 @@ module lfricinp_add_um_field_to_file_mod
use f_shum_file_mod, only: shum_file_type
use f_shum_field_mod, only: shum_field_type
use f_shum_lookup_indices_mod, only: &
lbyr, lbmon, lbdat, lbhr, lbmin, lbday, lbsec, lbyrd, lbmond, lbdatd, &
lbyr, lbmon, lbdat, lbhr, lbmin, lbday, lbsec, lbyrd, lbmond, lbdatd, &
lbhrd, lbmind, lbdayd, lbsecd, lbtim, lbft, lbcode, lbhem, &
lbrow, lbnpt, lbpack, lbrel, lbfc, lbcfc, lbproc, lbvc, lbrvc, &
lbtyp, lblev, lbrsvd1, lbrsvd2, &
Expand All @@ -50,7 +50,7 @@ module lfricinp_add_um_field_to_file_mod
bmks

use f_shum_fixed_length_header_indices_mod, only: &
vert_coord_type, horiz_grid_type, &
vert_coord_type, horiz_grid_type, &
dataset_type, run_identifier, calendar, projection_number, model_version, &
grid_staggering, sub_model, t1_year, t1_month, t1_day, t1_hour, t1_minute, &
t1_second, t2_year, t2_month, t2_day, t2_hour, t2_minute, t2_second, &
Expand Down Expand Up @@ -140,7 +140,7 @@ subroutine lfricinp_add_um_field_to_file(um_file, stashcode, level_index, &

! Set horiz grid
select case(grid_type_code)
case(p_points, ozone_points)
case(p_points, ozone_points, land_compressed, p_points_values_over_sea)
lookup_int(lbrow) = um_grid%num_p_points_y
lookup_int(lbnpt) = um_grid%num_p_points_x
! "Zeroth" start lat/lon so subtract one grid spacing
Expand Down Expand Up @@ -227,14 +227,49 @@ subroutine lfricinp_add_um_field_to_file(um_file, stashcode, level_index, &

! Check vertical coordinate type
if (lookup_int(lbvc) >= 126 .and. lookup_int(lbvc) <= 139 &
.or. lookup_int(lbvc) == 5) then
.or. lookup_int(lbvc) == 5 .or. lookup_int(lbvc) == 0 .or. &
lookup_int(lbvc) == 275 ) then
! Special codes inc single level, set to 0.0
if ( .not. lookup_int(lbvc) == 129 ) then
write(log_scratch_space, '(A,I0,A)') &
"Vertical coord type ", lookup_int(lbvc), " treated as single layer"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
end if
lookup_real_tmp(blev)=0.0_real64
lookup_real_tmp(bhlev)=0.0_real64
lookup_real_tmp(brlev)=0.0_real64
lookup_real_tmp(bhrlev)=0.0_real64
lookup_real_tmp(bulev)=0.0_real64
lookup_real_tmp(bhulev)=0.0_real64
else if (lookup_int(lbvc) == 6) then ! Deep soil levels
! These are hardcoded to the settings in a UM dump file with 4 soil levels as
! that is currently hardcoded in elsewhere in lfric2um. If at some point that
! gets changed to not be hardcoded, this will also need to change
! bulev is the same as brsvd1
write(log_scratch_space, '(A,I0,A)') &
"Vertical coord type ", lookup_int(lbvc), " treated as soil field"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
if (level_number == 1) then
lookup_real_tmp(bulev) = 0.0_real64
lookup_real_tmp(blev)=0.05_real64
lookup_real_tmp(brlev)=0.1_real64
else if (level_number == 2) then
lookup_real_tmp(bulev) = 0.1_real64
lookup_real_tmp(blev)=0.225_real64
lookup_real_tmp(brlev)=0.35_real64
else if (level_number == 3) then
lookup_real_tmp(bulev) = 0.35_real64
lookup_real_tmp(blev)=0.675_real64
lookup_real_tmp(brlev)=1.0_real64
else if (level_number == 4) then
lookup_real_tmp(bulev) = 1.0_real64
lookup_real_tmp(blev)=2.0_real64
lookup_real_tmp(brlev)=3.0_real64
else
write(log_scratch_space, '(A,I0,A)') "Soil level number ", level_number, &
" not supported. Only soil fields with 4 levels are supported currently"
call log_event(log_scratch_space, LOG_LEVEL_ERROR)
end if
else if (lookup_int(lbvc) == 65) then ! Standard hybrid height levels
! height of model level k above mean sea level is
! z(i,j,k) = Zsea(k) + C(k)*Zorog(i,j)
Expand All @@ -243,6 +278,7 @@ subroutine lfricinp_add_um_field_to_file(um_file, stashcode, level_index, &
! brlev,bhrlev zsea,C of lower level boundary
! The level here can refer to either a theta or rho level, with
! layer boundaries defined by surrounding rho or theta levels.

if (level_code == theta_levels) then ! theta level (& w)

! When referencing theta arrays need to add 1 to the level number as level
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -106,24 +106,36 @@ subroutine lfricinp_create_lfric_fields( mesh, twod_mesh, &
select case (lfric_field_kind)

case(w2h_field) ! Stashcodes that would map to W2h, i.e. winds
write(log_scratch_space, '(A,I0,A)') &
"LFRic field kind code is ", lfric_field_kind, " or w2h_field"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
type_mesh => mesh
fs_id = W2H
ndata_64 = 1_int64
ndata_first = .false.

case(w3_field) ! Stashcodes that map to W3/rho
write(log_scratch_space, '(A,I0,A)') &
"LFRic field kind code is ", lfric_field_kind, " or w3_field"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
type_mesh => mesh
fs_id = W3
ndata_64 = 1_int64
ndata_first = .false.

case(wtheta_field) ! Stashcodes that maps to Wtheta
write(log_scratch_space, '(A,I0,A)') &
"LFRic field kind code is ", lfric_field_kind, " or wtheta_field"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
type_mesh => mesh
fs_id = Wtheta
ndata_64 = 1_int64
ndata_first = .false.

case(w3_field_2d) ! Stash that needs 2D mesh
write(log_scratch_space, '(A,I0,A)') &
"LFRic field kind code is ", lfric_field_kind, " or w3_field_2d"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
type_mesh => twod_mesh
fs_id = W3
if ( get_stashmaster_item(stashcode, pseudt) == 0 ) then
Expand All @@ -132,13 +144,22 @@ subroutine lfricinp_create_lfric_fields( mesh, twod_mesh, &
else
! Get number of pseudo levels/ndata
ndata_64 = lfricinp_get_num_pseudo_levels(um_grid, stashcode)
write(log_scratch_space, '(A,I0,A)') &
"This field has ", ndata_64, " pseudo levels"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
end if
ndata_first = .false.

case(w3_soil_field) ! Soil fields
write(log_scratch_space, '(A,I0,A)') &
"LFRic field kind code is ", lfric_field_kind, " or w3_soil_field"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
type_mesh => twod_mesh
fs_id = W3
ndata_64 = lfricinp_get_num_levels(um_file, stashcode)
write(log_scratch_space, '(A,I0,A)') &
"This field has ", ndata_64, " levels"
call log_event(log_scratch_space, LOG_LEVEL_INFO)
ndata_first = .true.

case DEFAULT
Expand All @@ -162,6 +183,8 @@ subroutine lfricinp_create_lfric_fields( mesh, twod_mesh, &
call field % set_write_behaviour(tmp_write_ptr)
call log_event("Add "//field_name//" to field collection", LOG_LEVEL_INFO)
call field_collection % add_field(field)
call log_event("Added", LOG_LEVEL_INFO)


nullify(tmp_read_ptr, tmp_write_ptr)
nullify(vector_space)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ module lfricinp_um_level_codes_mod

! lfric modules
use log_mod, only : log_event, log_scratch_space, &
LOG_LEVEL_ERROR
LOG_LEVEL_ERROR, LOG_LEVEL_INFO

implicit none

Expand Down Expand Up @@ -145,11 +145,23 @@ function lfricinp_get_num_pseudo_levels(um_grid, stashcode) &
type(lfricinp_grid_type), intent(in):: um_grid
integer(kind=int64), intent(in) :: stashcode
! Result
integer(kind=int64) :: num_pseudo_levels
integer(kind=int64) :: num_pseudo_levels, last_pseudL_num, first_pseudL_num


num_pseudo_levels = lfricinp_get_last_pseudo_level_num(um_grid, stashcode) - &
lfricinp_get_first_pseudo_level_num(stashcode) + 1

last_pseudL_num = lfricinp_get_last_pseudo_level_num(um_grid, stashcode)

first_pseudL_num = lfricinp_get_first_pseudo_level_num(stashcode)
write(log_scratch_space, '(A,I0)') &
"Last pseudo level number:", last_pseudL_num
call log_event(log_scratch_space, LOG_LEVEL_INFO)

write(log_scratch_space, '(A,I0)') &
"First pseudo level number:",first_pseudL_num
call log_event(log_scratch_space, LOG_LEVEL_INFO)

end function lfricinp_get_num_pseudo_levels

!------------------------------------------------------------------
Expand Down Expand Up @@ -207,14 +219,29 @@ function lfricinp_get_last_pseudo_level_num(um_grid, stashcode) &
'lfricinp_get_last_pseudo_level_num'

last_pseudo_level_code = get_stashmaster_item(stashcode, pseudl)
write(log_scratch_space, '(A,I0)') &
"Last pseudo level code is ", last_pseudo_level_code
call log_event(log_scratch_space, LOG_LEVEL_INFO)

select case(last_pseudo_level_code)
case (7,9) ! ntypes == ntiles (lfricinputs doesn't support aggregate tile)
last_pseudo_level_num = um_grid % num_surface_types
if (last_pseudo_level_num == -32768) then
last_pseudo_level_num = 9
end if
write(log_scratch_space, '(A,I0)') &
"Last pseudo level number is ", last_pseudo_level_num
call log_event(log_scratch_space, LOG_LEVEL_INFO)
case (10)
last_pseudo_level_num = um_grid%num_ice_cats
case (11)
last_pseudo_level_num = um_grid%num_snow_layers * um_grid%num_surface_types
if ( um_grid%num_snow_layers == -32768 .or. um_grid%num_surface_types == -32768 ) then
last_pseudo_level_num = 3 * 9
end if
write(log_scratch_space, '(A,I0)') &
"Last pseudo level number is ", last_pseudo_level_num
call log_event(log_scratch_space, LOG_LEVEL_INFO)
case DEFAULT
write(log_scratch_space, '(A,I0,A,I0)') &
"Last pseudo_level code ", last_pseudo_level_code, &
Expand All @@ -224,5 +251,4 @@ function lfricinp_get_last_pseudo_level_num(um_grid, stashcode) &

end function lfricinp_get_last_pseudo_level_num


end module lfricinp_um_level_codes_mod
Loading