diff --git a/CHANGELOG.md b/CHANGELOG.md index 82b35f105ae5..c4ca38d87e77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -70,6 +70,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Allow update offsets of ±timestep in ExtData2G - Minor revision (and generalization) of grid-def for GSI purposes +- Trajectory sampler: fix a bug when group_name does not exist in netCDF file and a bug that omitted the first time point ### Changed diff --git a/base/Plain_netCDF_Time.F90 b/base/Plain_netCDF_Time.F90 index 8733f178b3ab..b9c163816647 100644 --- a/base/Plain_netCDF_Time.F90 +++ b/base/Plain_netCDF_Time.F90 @@ -218,20 +218,21 @@ subroutine get_v1d_netcdf_R8(filename, name, array, Xdim, group_name, rc) real(REAL64), dimension(Xdim), intent(out) :: array integer, optional, intent(out) :: rc integer :: status - integer :: ncid, varid, ncid2 + integer :: ncid, varid, ncid2, ncid_sv call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) + ncid_sv = ncid + if(present(group_name)) then - ncid2= ncid - call check_nc_status(nf90_inq_ncid(ncid2, group_name, ncid), _RC) + if(group_name/='') then + ncid2= ncid + call check_nc_status(nf90_inq_ncid(ncid2, group_name, ncid), _RC) + end if end if call check_nc_status(nf90_inq_varid(ncid, name, varid), _RC) call check_nc_status(nf90_get_var(ncid, varid, array), _RC) - if(present(group_name)) then - call check_nc_status(nf90_close(ncid2), _RC) - else - call check_nc_status(nf90_close(ncid), _RC) - end if + + call check_nc_status(nf90_close(ncid_sv), _RC) _RETURN(_SUCCESS) end subroutine get_v1d_netcdf_R8 @@ -256,9 +257,11 @@ subroutine get_v1d_netcdf_R8_complete(filename, varname, array, att_name, att_va call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid if(present(group_name)) then - call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) - ! mod - ncid = ncid_grp + if(group_name/='') then + call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) + ! mod + ncid = ncid_grp + end if end if call check_nc_status(nf90_inq_varid(ncid, varname, varid), _RC) call check_nc_status(nf90_get_var(ncid, varid, array), _RC) @@ -296,9 +299,11 @@ subroutine get_att_real_netcdf(filename, varname, att_name, att_value, group_nam call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid if(present(group_name)) then - call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) - ! overwrite - ncid = ncid_grp + if(group_name/='') then + call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) + ! overwrite + ncid = ncid_grp + end if end if call check_nc_status(nf90_inq_varid(ncid, varname, varid), _RC) call check_nc_status(nf90_get_att(ncid, varid, att_name, att_value), _RC) @@ -324,9 +329,11 @@ subroutine get_att_char_netcdf(filename, varname, att_name, att_value, group_nam call check_nc_status(nf90_open(trim(fileName), NF90_NOWRITE, ncid), _RC) ncid_sv = ncid if(present(group_name)) then - call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) - ! overwrite - ncid = ncid_grp + if(group_name/='') then + call check_nc_status(nf90_inq_ncid(ncid, group_name, ncid_grp), _RC) + ! overwrite + ncid = ncid_grp + end if end if call check_nc_status(nf90_inq_varid(ncid, varname, varid), _RC) call check_nc_status(nf90_get_att(ncid, varid, att_name, att_value), _RC) diff --git a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 index 5c83c722b0a7..b6adb74c697a 100644 --- a/generic3g/ComponentSpecParser/parse_geometry_spec.F90 +++ b/generic3g/ComponentSpecParser/parse_geometry_spec.F90 @@ -108,7 +108,8 @@ module function parse_geometry_spec(mapl_cfg, registry, rc) result(geometry_spec vertical_grid = FixedLevelsVerticalGrid(standard_name, levels, units) case('model') num_levels = ESMF_HConfigAsI4(vertical_grid_cfg, keyString='num_levels', _RC) - vertical_grid = ModelVerticalGrid(num_levels=num_levels) + units = ESMF_HConfigAsString(vertical_grid_cfg, keyString='units', _RC) + vertical_grid = ModelVerticalGrid(num_levels=num_levels, units=units) short_name = ESMF_HConfigAsString(vertical_grid_cfg, keyString='short_name', _RC) select type(vertical_grid) type is(ModelVerticalGrid) diff --git a/generic3g/registry/ExtensionFamily.F90 b/generic3g/registry/ExtensionFamily.F90 index 37f422d5a66b..937943109e9e 100644 --- a/generic3g/registry/ExtensionFamily.F90 +++ b/generic3g/registry/ExtensionFamily.F90 @@ -122,6 +122,7 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension) type(StateItemExtensionPtr) :: extension_ptr type(StateItemExtension), pointer :: primary class(StateItemSpec), pointer :: spec + logical :: match closest_extension => null() subgroup = family%get_extensions() @@ -135,7 +136,8 @@ function find_closest_extension(family, goal_spec, rc) result(closest_extension) extension_ptr = subgroup%of(j) spec => extension_ptr%ptr%get_spec() associate (adapter => adapters(i)%adapter) - if (adapter%match(spec)) then + match = adapter%match(spec, _RC) + if (match) then call new_subgroup%push_back(extension_ptr) end if end associate diff --git a/generic3g/registry/StateItemExtension.F90 b/generic3g/registry/StateItemExtension.F90 index 313dc00e6f18..ec1e32785248 100644 --- a/generic3g/registry/StateItemExtension.F90 +++ b/generic3g/registry/StateItemExtension.F90 @@ -117,14 +117,16 @@ recursive function make_extension(this, goal, rc) result(extension) type(ESMF_GridComp) :: coupler_gridcomp type(StateItemAdapterWrapper), allocatable :: adapters(:) type(ESMF_Clock) :: fake_clock + logical :: match call this%spec%set_active() new_spec = this%spec adapters = this%spec%make_adapters(goal, _RC) do i = 1, size(adapters) - if (adapters(i)%adapter%match(new_spec)) cycle - call adapters(i)%adapter%adapt(new_spec, action) + match = adapters(i)%adapter%match(new_spec, _RC) + if (match) cycle + call adapters(i)%adapter%adapt(new_spec, action, _RC) exit end do diff --git a/generic3g/specs/FieldSpec.F90 b/generic3g/specs/FieldSpec.F90 index a32089a1e7d6..e3abb6f67a89 100644 --- a/generic3g/specs/FieldSpec.F90 +++ b/generic3g/specs/FieldSpec.F90 @@ -360,13 +360,16 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg) write(unit, "(3x, a, a, a)", iostat=iostat, iomsg=iomsg) "long name:", this%long_name, new_line("a") end if if (allocated(this%units)) then - write(unit, "(3x, a, a, a)", iostat=iostat, iomsg=iomsg) "unit:", this%units, new_line("a") + write(unit, "(3x, a, a, a)", iostat=iostat, iomsg=iomsg) "units:", this%units, new_line("a") end if write(unit, "(3x, dt'g0', a)", iostat=iostat, iomsg=iomsg) this%vertical_dim_spec, new_line("a") if (allocated(this%vertical_grid)) then - write(unit, "(3x, dt'g0', a)", iostat=iostat, iomsg=iomsg) this%vertical_grid, new_line("a") + write(unit, "(3x, dt'g0', a)", iostat=iostat, iomsg=iomsg) this%vertical_grid end if write(unit, "(a)") ")" + + _UNUSED_DUMMY(iotype) + _UNUSED_DUMMY(v_list) end subroutine write_formatted function get_ungridded_bounds(this, rc) result(bounds) @@ -585,8 +588,8 @@ logical function can_connect_to(this, src_spec, rc) can_connect_to = all ([ & can_match(this%geom,src_spec%geom), & can_match(this%vertical_grid, src_spec%vertical_grid), & - match(this%vertical_dim_spec,src_spec%vertical_dim_spec), & - match(this%ungridded_dims,src_spec%ungridded_dims), & + match(this%vertical_dim_spec, src_spec%vertical_dim_spec), & + match(this%ungridded_dims, src_spec%ungridded_dims), & includes(this%attributes, src_spec%attributes), & can_convert_units & ]) @@ -843,13 +846,23 @@ subroutine adapt_vertical_grid(this, spec, action, rc) type(GriddedComponentDriver), pointer :: v_in_coupler type(GriddedComponentDriver), pointer :: v_out_coupler type(ESMF_Field) :: v_in_coord, v_out_coord + type(ESMF_TypeKind_Flag) :: typekind_in, typekind_out integer :: status select type (spec) type is (FieldSpec) - call spec%vertical_grid%get_coordinate_field(v_in_coord, v_in_coupler, & - 'ignore', spec%geom, spec%typekind, spec%units, spec%vertical_dim_spec, _RC) - call this%vertical_grid%get_coordinate_field(v_out_coord, v_out_coupler, & + ! TODO: DO WE NEED TO RESTRICT SPEC's VERTICAL GRID TO MODEL? + ! NOTE: we cannot import ModelVerticalGrid (circular dependency) + _ASSERT(spec%vertical_grid%get_units() == this%vertical_grid%get_units(), 'units must match') + _ASSERT(spec%vertical_dim_spec == this%vertical_dim_spec, 'temporary restriction') + ! Field (to be regridded) should have the same typekind as the underlying vertical grid + ! TODO: Should we add a typekind class variable to VerticalGrid? + _ASSERT(spec%typekind == this%typekind, 'typekind must match') + call spec%vertical_grid%get_coordinate_field( & + v_in_coord, v_in_coupler, & ! output + 'ignore', spec%geom, spec%typekind, this%vertical_grid%get_units(), spec%vertical_dim_spec, _RC) + call this%vertical_grid%get_coordinate_field( & + v_out_coord, v_out_coupler, & ! output 'ignore', this%geom, this%typekind, this%units, this%vertical_dim_spec, _RC) action = VerticalRegridAction(v_in_coord, v_out_coupler, v_out_coord, v_out_coupler, this%regrid_method) spec%vertical_grid = this%vertical_grid @@ -975,7 +988,7 @@ subroutine adapt_units(this, spec, action, rc) _RETURN(_SUCCESS) end subroutine adapt_units - logical function adapter_match_units(this, spec, rc) result(match) + logical function adapter_match_units(this, spec, rc) result(match) class(UnitsAdapter), intent(in) :: this class(StateItemSpec), intent(in) :: spec integer, optional, intent(out) :: rc diff --git a/generic3g/tests/Test_ModelVerticalGrid.pf b/generic3g/tests/Test_ModelVerticalGrid.pf index aaa9ef599e1b..57b2e3d5df61 100644 --- a/generic3g/tests/Test_ModelVerticalGrid.pf +++ b/generic3g/tests/Test_ModelVerticalGrid.pf @@ -65,19 +65,19 @@ contains rc = 0 ! Inside user "set_geom" phase. geom = make_geom(_RC) - vgrid = ModelVerticalGrid(num_levels=LM) + vgrid = ModelVerticalGrid(num_levels=LM, units="hPa") call vgrid%add_variant(short_name=var_name) ! inside OuterMeta - r = StateRegistry('dyn') + r = StateRegistry("dyn") call vgrid%set_registry(r) ! MAPL_SetVerticalGrid(...) - v_pt = VirtualConnectionPt(state_intent='export', short_name=var_name) + v_pt = VirtualConnectionPt(state_intent="export", short_name=var_name) var_spec = VariableSpec(& short_name=var_name, & state_intent=ESMF_STATEINTENT_EXPORT, & - standard_name='air_pressure', & - units='hPa', & + standard_name="air_pressure", & + units="hPa", & vertical_dim_spec=vertical_dim_spec, & default_value=3.) allocate(fld_spec, source=make_itemSpec(var_spec, r, rc=status)) @@ -96,16 +96,14 @@ contains function make_geom(rc) result(geom) integer, intent(out) :: rc type(ESMF_Geom) :: geom - type(ESMF_Grid) :: grid integer :: status type(ESMF_HConfig) :: hconfig type(GeomManager), pointer :: geom_mgr - class(GeomSpec), allocatable :: geom_spec type(MaplGeom), pointer :: mapl_geom rc = 0 geom_mgr => get_geom_manager() - hconfig = ESMF_HConfigCreate(content='{class: latlon, im_world: 6, jm_world: 7, pole: PC, dateline: DC}', _RC) + hconfig = ESMF_HConfigCreate(content="{class: latlon, im_world: 6, jm_world: 7, pole: PC, dateline: DC}", _RC) mapl_geom => geom_mgr%get_mapl_geom(hconfig, _RC) geom = mapl_geom%get_geom() end function make_geom @@ -113,24 +111,22 @@ contains @test subroutine test_num_levels() type(ModelVerticalGrid) :: vgrid - integer :: num_levels num_levels = 10 - vgrid = ModelVerticalGrid(num_levels=num_levels) + vgrid = ModelVerticalGrid(num_levels=num_levels, units="hPa") @assert_that(vgrid%get_num_levels(), is(num_levels)) end subroutine test_num_levels @test subroutine test_num_variants() type(ModelVerticalGrid) :: vgrid - integer :: num_variants - vgrid = ModelVerticalGrid(num_levels=3) + vgrid = ModelVerticalGrid(num_levels=3, units="hPa") @assert_that(vgrid%get_num_variants(), is(0)) - call vgrid%add_variant(short_name='PLE') + call vgrid%add_variant(short_name="PLE") @assert_that(vgrid%get_num_variants(), is(1)) - call vgrid%add_variant(short_name='ZLE') + call vgrid%add_variant(short_name="ZLE") @assert_that(vgrid%get_num_variants(), is(2)) end subroutine test_num_variants @@ -149,17 +145,18 @@ contains call setup("PLE", vgrid, _RC) - ple_pt = VirtualConnectionPt(state_intent='export', short_name='PLE') + ple_pt = VirtualConnectionPt(state_intent="export", short_name="PLE") extension => r%get_primary_extension(ple_pt, _RC) spec => extension%get_spec() multi_state = MultiState() call spec%add_to_state(multi_state, ActualConnectionPt(ple_pt), _RC) - call ESMF_StateGet(multi_state%exportState, itemName='PLE', field=ple, _RC) + call ESMF_StateGet(multi_state%exportState, itemName="PLE", field=ple, _RC) call ESMF_FieldGet(ple, rank=rank, _RC) allocate(localElementCount(rank)) call ESMF_FieldGet(ple, localElementCount=localElementCount, _RC) @assert_that(localElementCount, is(equal_to([IM,JM,LM+1]))) + _UNUSED_DUMMY(this) end subroutine test_created_fields_have_num_levels @test(type=ESMF_TestMethod, npes=[1]) @@ -180,16 +177,17 @@ contains call vgrid%get_coordinate_field( & vcoord, coupler, & - standard_name='air_pressure', & + standard_name="air_pressure", & geom=geom, & typekind=ESMF_TYPEKIND_R4, & - units='hPa', & + units="hPa", & vertical_dim_spec=VERTICAL_DIM_EDGE, & _RC) @assert_that(associated(coupler), is(false())) call ESMF_FieldGet(vcoord, fArrayPtr=a, _RC) @assert_that(a, every_item(is(equal_to(3.)))) + _UNUSED_DUMMY(this) end subroutine test_get_coordinate_field_simple @test(type=ESMF_TestMethod, npes=[1]) @@ -213,10 +211,10 @@ contains call vgrid%get_coordinate_field( & vcoord, coupler, & - standard_name='air_pressure', & + standard_name="air_pressure", & geom=geom, & typekind=ESMF_TYPEKIND_R4, & - units='Pa', & + units="Pa", & vertical_dim_spec=VERTICAL_DIM_EDGE, & _RC) @assert_that(associated(coupler), is(true())) @@ -234,6 +232,7 @@ contains end do @assert_that(shape(a), is(equal_to([IM, JM, LM+1]))) @assert_that(a, every_item(is(equal_to(300.)))) + _UNUSED_DUMMY(this) end subroutine test_get_coordinate_field_change_units_edge @test(type=ESMF_TestMethod, npes=[1]) @@ -257,9 +256,9 @@ contains call vgrid%get_coordinate_field( & vcoord, coupler, & - standard_name='air_pressure', & + standard_name="air_pressure", & geom=geom, & - typekind=ESMF_TYPEKIND_R4, units='Pa', & + typekind=ESMF_TYPEKIND_R4, units="Pa", & vertical_dim_spec=VERTICAL_DIM_CENTER, & _RC) @assert_that(associated(coupler), is(true())) @@ -277,6 +276,7 @@ contains end do @assert_that(shape(a), is(equal_to([IM, JM, LM]))) @assert_that(a, every_item(is(equal_to(300.)))) + _UNUSED_DUMMY(this) end subroutine test_get_coordinate_field_change_units_center end module Test_ModelVerticalGrid diff --git a/generic3g/tests/Test_Scenarios.pf b/generic3g/tests/Test_Scenarios.pf index 5c3471ea4655..9a5b02317df8 100644 --- a/generic3g/tests/Test_Scenarios.pf +++ b/generic3g/tests/Test_Scenarios.pf @@ -127,9 +127,13 @@ contains ScenarioDescription('export_dependency', 'parent.yaml', check_name, check_stateitem), & ScenarioDescription('regrid', 'cap.yaml', check_name, check_stateitem), & ScenarioDescription('propagate_geom', 'parent.yaml', check_name, check_stateitem), & - ScenarioDescription('vertical_regridding', 'parent.yaml', check_name, check_stateitem) & - ! ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem) & - ] + ScenarioDescription('vertical_regridding', 'parent.yaml', check_name, check_stateitem) & +#ifndef __GFORTRAN__ + , & + ScenarioDescription('vertical_regridding_2', 'parent.yaml', check_name, check_stateitem), & + ScenarioDescription('vertical_regridding_3', 'parent.yaml', check_name, check_stateitem) & +#endif + ] end function add_params end function get_parameters diff --git a/generic3g/tests/scenarios/vertical_regridding_3/A.yaml b/generic3g/tests/scenarios/vertical_regridding_3/A.yaml new file mode 100644 index 000000000000..ade8005e7b7a --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/A.yaml @@ -0,0 +1,28 @@ +mapl: + + geometry: + esmf_geom: + class: latlon + im_world: 12 + jm_world: 13 + pole: PC + dateline: DC + vertical_grid: + class: model + short_name: PL + units: hPa + num_levels: 4 + + states: + import: {} + export: + PL: + standard_name: air_pressure_a + units: hPa + default_value: 17. + vertical_dim_spec: center + E_A: + standard_name: temperature_a + units: K + default_value: 17. + vertical_dim_spec: center diff --git a/generic3g/tests/scenarios/vertical_regridding_3/B.yaml b/generic3g/tests/scenarios/vertical_regridding_3/B.yaml new file mode 100644 index 000000000000..9a9432c4065b --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/B.yaml @@ -0,0 +1,21 @@ +mapl: + + geometry: + esmf_geom: + class: latlon + im_world: 12 + jm_world: 13 + pole: PC + dateline: DC + vertical_grid: + class: fixed_levels + standard_name: air_pressure + units: hPa + levels: [17.] + + states: + import: + I_B: + standard_name: temperature_b + units: K + vertical_dim_spec: center diff --git a/generic3g/tests/scenarios/vertical_regridding_3/C.yaml b/generic3g/tests/scenarios/vertical_regridding_3/C.yaml new file mode 100644 index 000000000000..07874458a1e1 --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/C.yaml @@ -0,0 +1,21 @@ +mapl: + + geometry: + esmf_geom: + class: latlon + im_world: 12 + jm_world: 13 + pole: PC + dateline: DC + vertical_grid: + class: fixed_levels + standard_name: air_pressure + units: hPa + levels: [17.] + + states: + import: + I_C: + standard_name: air_pressure_c + units: hPa + vertical_dim_spec: center diff --git a/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml b/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml new file mode 100644 index 000000000000..4b59c6931b3a --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/expectations.yaml @@ -0,0 +1,17 @@ +# For each component: +# - provide a path to the outer/user componen in the hierarchy +# - list the fields expected in each import/export/internal states +# - annotate whether field is "complete" + +- component: A + export: + PL: {status: complete} + E_A: {status: complete} + +- component: B + import: + I_B: {status: complete} + +- component: C + import: + I_C: {status: complete} diff --git a/generic3g/tests/scenarios/vertical_regridding_3/parent.yaml b/generic3g/tests/scenarios/vertical_regridding_3/parent.yaml new file mode 100644 index 000000000000..f03ed06601f5 --- /dev/null +++ b/generic3g/tests/scenarios/vertical_regridding_3/parent.yaml @@ -0,0 +1,27 @@ +mapl: + + children: + A: + sharedObj: libsimple_leaf_gridcomp + setServices: setservices_ + config_file: scenarios/vertical_regridding_3/A.yaml + B: + sharedObj: libsimple_leaf_gridcomp + setServices: setservices_ + config_file: scenarios/vertical_regridding_3/B.yaml + C: + sharedObj: libsimple_leaf_gridcomp + setServices: setservices_ + config_file: scenarios/vertical_regridding_3/C.yaml + + states: {} + + connections: + - src_name: E_A + dst_name: I_B + src_comp: A + dst_comp: B + - src_name: PL + dst_name: I_C + src_comp: A + dst_comp: C diff --git a/generic3g/vertical/FixedLevelsVerticalGrid.F90 b/generic3g/vertical/FixedLevelsVerticalGrid.F90 index 054ced93d55d..c04ede0670e6 100644 --- a/generic3g/vertical/FixedLevelsVerticalGrid.F90 +++ b/generic3g/vertical/FixedLevelsVerticalGrid.F90 @@ -10,8 +10,6 @@ module mapl3g_FixedLevelsVerticalGrid use mapl3g_VerticalDimSpec use esmf - use, intrinsic :: iso_fortran_env, only: REAL32 - implicit none private @@ -21,9 +19,8 @@ module mapl3g_FixedLevelsVerticalGrid type, extends(VerticalGrid) :: FixedLevelsVerticalGrid private - real(kind=REAL32), allocatable :: levels(:) + real(kind=ESMF_KIND_R4), allocatable :: levels(:) character(:), allocatable :: standard_name ! air_pressure, height, etc. - character(:), allocatable :: units contains procedure :: get_num_levels procedure :: get_coordinate_field @@ -45,16 +42,16 @@ module mapl3g_FixedLevelsVerticalGrid contains - function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(grid) - type(FixedLevelsVerticalGrid) :: grid + function new_FixedLevelsVerticalGrid_r32(standard_name, levels, units) result(vgrid) + type(FixedLevelsVerticalGrid) :: vgrid character(*), intent(in) :: standard_name - real(REAL32), intent(in) :: levels(:) + real(kind=ESMF_KIND_R4), intent(in) :: levels(:) character(*), intent(in) :: units - call grid%set_id() - grid%standard_name = standard_name - grid%levels = levels - grid%units = units + call vgrid%set_id() + vgrid%standard_name = standard_name + vgrid%levels = levels + call vgrid%set_units(units) end function new_FixedLevelsVerticalGrid_r32 integer function get_num_levels(this) result(num_levels) @@ -73,10 +70,12 @@ subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typek type(VerticalDimSpec), intent(in) :: vertical_dim_spec integer, optional, intent(out) :: rc - real(kind=REAL32), pointer :: farray3d(:, :, :) + real(kind=ESMF_KIND_R4), pointer :: farray3d(:, :, :) integer, allocatable :: local_cell_count(:) integer :: i, j, IM, JM, status + ! _HERE + ! print *, "units: ", units field = MAPL_FieldCreate( & geom=geom, & typekind=ESMF_TYPEKIND_R4, & @@ -121,9 +120,9 @@ subroutine write_formatted(this, unit, iotype, v_list, iostat, iomsg) write(unit, "(a, a, 3x, a, a, a, 3x, a, a, a, 3x, a, *(g0, 1x))", iostat=iostat, iomsg=iomsg) & "FixedLevelsVerticalGrid(", new_line("a"), & "standard name: ", this%standard_name, new_line("a"), & - "units: ", this%units, new_line("a"), & + "units: ", this%get_units(), new_line("a"), & "levels: ", this %levels - write(unit, "(a, a)", iostat=iostat, iomsg=iomsg) new_line("a"), ")" + write(unit, "(a)", iostat=iostat, iomsg=iomsg) ")" _UNUSED_DUMMY(iotype) _UNUSED_DUMMY(v_list) @@ -134,7 +133,7 @@ impure elemental logical function equal_FixedLevelsVerticalGrid(a, b) result(equ equal = a%standard_name == b%standard_name if (.not. equal) return - equal = a%units == b%units + equal = a%get_units() == b%get_units() if (.not. equal) return equal = size(a%levels) == size(b%levels) if (.not. equal) return diff --git a/generic3g/vertical/ModelVerticalGrid.F90 b/generic3g/vertical/ModelVerticalGrid.F90 index 729cc3a92dbd..80b5f4dcdf78 100644 --- a/generic3g/vertical/ModelVerticalGrid.F90 +++ b/generic3g/vertical/ModelVerticalGrid.F90 @@ -65,14 +65,16 @@ module function can_connect_to(this, src, rc) contains - function new_ModelVerticalGrid_basic(num_levels) result(vgrid) + function new_ModelVerticalGrid_basic(num_levels, units) result(vgrid) type(ModelVerticalGrid) :: vgrid integer, intent(in) :: num_levels + character(*) , intent(in) :: units !# character(*), intent(in) :: short_name !# character(*), intent(in) :: standard_name !# type(StateRegistry), pointer, intent(in) :: registry call vgrid%set_id() + call vgrid%set_units(units) vgrid%num_levels = num_levels !# vgrid%short_name = short_name !# vgrid%standard_name = standard_name @@ -126,7 +128,6 @@ subroutine get_coordinate_field(this, field, coupler, standard_name, geom, typek type(StateItemExtension), pointer :: new_extension class(StateItemSpec), pointer :: new_spec type(FieldSpec) :: goal_spec - integer :: i short_name = this%variants%of(1) v_pt = VirtualConnectionPt(state_intent="export", short_name=short_name) diff --git a/generic3g/vertical/VerticalGrid.F90 b/generic3g/vertical/VerticalGrid.F90 index d76689df4329..49d0506c88db 100644 --- a/generic3g/vertical/VerticalGrid.F90 +++ b/generic3g/vertical/VerticalGrid.F90 @@ -10,6 +10,7 @@ module mapl3g_VerticalGrid type, abstract :: VerticalGrid private integer :: id = -1 + character(:), allocatable :: units contains procedure(I_get_num_levels), deferred :: get_num_levels procedure(I_get_coordinate_field), deferred :: get_coordinate_field @@ -20,6 +21,8 @@ module mapl3g_VerticalGrid procedure :: set_id procedure :: get_id procedure :: same_id + procedure :: set_units + procedure :: get_units procedure :: make_info end type VerticalGrid @@ -88,6 +91,18 @@ logical function same_id(this, other) same_id = (this%id == other%id) end function same_id + subroutine set_units(this, units) + class(VerticalGrid), intent(inout) :: this + character(*), intent(in) :: units + this%units = units + end subroutine set_units + + function get_units(this) result(units) + character(:), allocatable :: units + class(VerticalGrid), intent(in) :: this + units = this%units + end function get_units + function make_info(this, rc) result(info) use esmf type(ESMF_Info) :: info diff --git a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 index 3987bc3216ce..a8fc29d69b5e 100644 --- a/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 +++ b/gridcomps/History/Sampler/MAPL_TrajectoryMod_smod.F90 @@ -734,20 +734,11 @@ times_R8_full(1), times_R8_full(nend)) call lgr%debug ('%a %i20 %i20', 'jt1, jt2 [final intercepted position]', jt1, jt2) - -! if (jt1==jt2) then -! _FAIL('Epoch Time is too small, empty grid is generated, increase Epoch') -! endif - - !-- shift the zero item to index 1 - zero_obs = .false. if (jt1/=jt2) then zero_obs = .false. - if (jt1==0) jt1=1 else ! at most one obs point exist, set it .true. zero_obs = .true. - !! if (jt1==0) jt1=1 end if !