Skip to content
Merged
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
117 changes: 6 additions & 111 deletions applications/lfric2lfric/source/driver/lfric2lfric_regrid_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -14,17 +14,10 @@ module lfric2lfric_regrid_mod
use field_collection_mod, only: field_collection_type
use field_collection_iterator_mod, only: &
field_collection_iterator_type
use fs_continuity_mod, only: W2, W3, Wtheta
use function_space_collection_mod, only: function_space_collection
use function_space_mod, only: function_space_type
use interpolation_alg_mod, only: interp_w2_to_w3wth_alg, &
interp_w3wth_to_w2_alg
use log_mod, only: log_event, &
log_level_info, &
log_scratch_space
use mesh_collection_mod, only: mesh_collection
use model_clock_mod, only: model_clock_type
use namelist_mod, only: namelist_type

!------------------------------------
! lfric2lfric modules
Expand Down Expand Up @@ -73,57 +66,12 @@ subroutine lfric2lfric_regrid( modeldb, oasis_clock, &

type(field_collection_iterator_type) :: iter

class(field_parent_type), pointer :: field => null()
type(field_type), pointer :: field_src => null()
type(field_type), pointer :: field_dst => null()

type(field_type), target :: u_in_w3_src, u_in_w3_dst
type(field_type), target :: v_in_w3_src, v_in_w3_dst
type(field_type), target :: w_in_wth_src, w_in_wth_dst
type(field_type), pointer :: field_src_ptr, field_dst_ptr

integer(kind=i_def) :: fs
type(function_space_type), pointer :: fs_w3_src, fs_w3_dst
type(function_space_type), pointer :: fs_wth_src, fs_wth_dst

type(namelist_type), pointer :: lfric2lfric_nml
type(namelist_type), pointer :: finite_element_nml

character(len=str_def) :: mesh_names(2)
integer(kind=i_def) :: element_order_h
integer(kind=i_def) :: element_order_v
class(field_parent_type), pointer :: field => null()
type(field_type), pointer :: field_src => null()
type(field_type), pointer :: field_dst => null()

character(len=str_def) :: field_name

integer(kind=i_def), parameter :: dst = 1
integer(kind=i_def), parameter :: src = 2


! Obtain namelist parameters
lfric2lfric_nml => modeldb%configuration%get_namelist('lfric2lfric')
finite_element_nml => modeldb%configuration%get_namelist('finite_element')

call lfric2lfric_nml%get_value( 'destination_mesh_name', &
mesh_names(dst) )
call lfric2lfric_nml%get_value( 'source_mesh_name', &
mesh_names(src) )
call finite_element_nml%get_value( 'element_order_h', element_order_h)
call finite_element_nml%get_value( 'element_order_v', element_order_v)

! Function spaces for creating temporary fields used in W2 interpolation
fs_w3_src => function_space_collection%get_fs( &
mesh_collection%get_mesh(mesh_names(src)), &
element_order_h, element_order_v, W3)
fs_wth_src => function_space_collection%get_fs( &
mesh_collection%get_mesh(mesh_names(src)), &
element_order_h, element_order_v, Wtheta)
fs_w3_dst => function_space_collection%get_fs( &
mesh_collection%get_mesh(mesh_names(dst)), &
element_order_h, element_order_v, W3)
fs_wth_dst => function_space_collection%get_fs( &
mesh_collection%get_mesh(mesh_names(dst)), &
element_order_h, element_order_v, Wtheta)

! Main loop over fields to be processed
call iter%initialise(source_fields)
do
Expand All @@ -139,42 +87,10 @@ subroutine lfric2lfric_regrid( modeldb, oasis_clock, &
trim(field_name)
call log_event(log_scratch_space, log_level_info)

! Convert W2 fields to a set of W3 and Wtheta fields
fs = field_src%which_function_space()
if (fs == W2) then
call u_in_w3_src%initialise(vector_space=fs_w3_src, &
name="u_in_w3_src")
call v_in_w3_src%initialise(vector_space=fs_w3_src, &
name="v_in_w3_src")
call w_in_wth_src%initialise(vector_space=fs_wth_src, &
name="w_in_wth_src")
call u_in_w3_dst%initialise(vector_space=fs_w3_dst, &
name="u_in_w3_dst")
call v_in_w3_dst%initialise(vector_space=fs_w3_dst, &
name="v_in_w3_dst")
call w_in_wth_dst%initialise(vector_space=fs_wth_dst, &
name="w_in_wth_dst")

call interp_w2_to_w3wth_alg(field_src, u_in_w3_src, &
v_in_w3_src, w_in_wth_src)
end if

! Regrid source field depending on regrid method
select case (regrid_method)
case (regrid_method_map)
if (fs == W2) then
field_src_ptr => u_in_w3_src
field_dst_ptr => u_in_w3_dst
call lfric2lfric_map_regrid(field_dst_ptr, field_src_ptr)
field_src_ptr => v_in_w3_src
field_dst_ptr => v_in_w3_dst
call lfric2lfric_map_regrid(field_dst_ptr, field_src_ptr)
field_src_ptr => w_in_wth_src
field_dst_ptr => w_in_wth_dst
call lfric2lfric_map_regrid(field_dst_ptr, field_src_ptr)
else
call lfric2lfric_map_regrid(field_dst, field_src)
end if
call lfric2lfric_map_regrid(field_dst, field_src)

case (regrid_method_lfric2lfric)
write(log_scratch_space, '(A)') &
Expand All @@ -185,31 +101,10 @@ subroutine lfric2lfric_regrid( modeldb, oasis_clock, &

case (regrid_method_oasis)
#ifdef MCT
if (fs == W2) then
field_src_ptr => u_in_w3_src
field_dst_ptr => u_in_w3_dst
call lfric2lfric_oasis_regrid(modeldb, oasis_clock, &
field_dst_ptr, field_src_ptr)
field_src_ptr => v_in_w3_src
field_dst_ptr => v_in_w3_dst
call lfric2lfric_oasis_regrid(modeldb, oasis_clock, &
field_dst_ptr, field_src_ptr)
field_src_ptr => w_in_wth_src
field_dst_ptr => w_in_wth_dst
call lfric2lfric_oasis_regrid(modeldb, oasis_clock, &
field_dst_ptr, field_src_ptr)
else
call lfric2lfric_oasis_regrid(modeldb, oasis_clock, &
field_dst, field_src)
end if
call lfric2lfric_oasis_regrid(modeldb, oasis_clock, &
field_dst, field_src)
#endif
end select

! Rebuild the W2 fields from a set of W3 and Wtheta fields
if (fs == W2) then
call interp_w3wth_to_w2_alg(field_dst, u_in_w3_dst, &
v_in_w3_dst, w_in_wth_dst)
end if
end do

end subroutine lfric2lfric_regrid
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ Inner product checksum soil_moist_sat = 441857FFC7DFDB05
Inner product checksum lw_up_toa_rtsi = 416FAC72807CC071
Inner product checksum acc_sol_bc = 0
Inner product checksum lw_up_tile_rts = 41C5B6CA9E787956
Inner product checksum u = 43A5525B8F097FCF
Inner product checksum u = 0
Inner product checksum lbc_u = 0
Inner product checksum ccw = 0
Inner product checksum tile_canopy_water = 444B62FFC0E56F2D
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ Inner product checksum soil_moist_sat = 441857FFA49C3841
Inner product checksum lw_up_toa_rtsi = 416FAC7209B088EF
Inner product checksum acc_sol_bc = 0
Inner product checksum lw_up_tile_rts = 41C5B6CA5973EFFF
Inner product checksum u = 42083253875B88C4
Inner product checksum u = 0
Inner product checksum lbc_u = 0
Inner product checksum ccw = 0
Inner product checksum tile_canopy_water = 444B62FF99395804
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ Inner product checksum soil_moist_sat = 441857FFC7DFDB04
Inner product checksum lw_up_toa_rtsi = 416FAC72807CC06E
Inner product checksum acc_sol_bc = 0
Inner product checksum lw_up_tile_rts = 41C5B6CA9E787957
Inner product checksum u = 43AD98636D29BDCE
Inner product checksum u = 0
Inner product checksum lbc_u = 0
Inner product checksum ccw = 0
Inner product checksum tile_canopy_water = 444B62FFC0E56F32
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@ Inner product checksum soil_moist_sat = 441857FFA49AA198
Inner product checksum lw_up_toa_rtsi = 416FAC7209B05CCB
Inner product checksum acc_sol_bc = 0
Inner product checksum lw_up_tile_rts = 41C5B6CA5973E644
Inner product checksum u = 42083253875A2B6D
Inner product checksum u = 0
Inner product checksum lbc_u = 0
Inner product checksum ccw = 0
Inner product checksum tile_canopy_water = 444B62FF99378E91
Expand Down
Loading