test_fortran_api.F90

Go to the documentation of this file.

! Copyright (c) 2024 The YAC Authors
!
! SPDX-License-Identifier: BSD-3-Clause
 
#include "test_macros.inc"
 
 
#define NOP(x) associate( x => x ); end associate
 
PROGRAM main
 
  use, INTRINSIC :: iso_c_binding
  USE utest
  USE yac_core
  USE mpi
 
  IMPLICIT NONE
 
  INTERFACE
 
    SUBROUTINE utest_c_free ( ptr ) bind ( c, name='free' )
 
      use, INTRINSIC :: iso_c_binding, only : c_ptr
 
      TYPE ( c_ptr ), INTENT(IN), VALUE :: ptr
 
    END SUBROUTINE utest_c_free
 
  END INTERFACE
 
  INTEGER :: ierror
 
  REAL(kind=c_double), PARAMETER :: &
    yac_rad = 0.017453292519943295769_c_double ! M_PI / 180
 
  TYPE(c_ptr) :: basic_grid_empty
  TYPE(c_ptr) :: basic_grid_reg_2d
  TYPE(c_ptr) :: basic_grid_reg_2d_deg
  TYPE(c_ptr) :: basic_grid_curve_2d
  TYPE(c_ptr) :: basic_grid_curve_2d_deg
  TYPE(c_ptr) :: basic_grid_unstruct
  TYPE(c_ptr) :: basic_grid_unstruct_deg
  TYPE(c_ptr) :: basic_grid_unstruct_ll
  TYPE(c_ptr) :: basic_grid_unstruct_ll_deg
  TYPE(c_ptr) :: basic_grid_unstruct_edge
  TYPE(c_ptr) :: basic_grid_unstruct_edge_deg
  TYPE(c_ptr) :: basic_grid_unstruct_edge_ll
  TYPE(c_ptr) :: basic_grid_unstruct_edge_ll_deg
  TYPE(c_ptr) :: basic_grid_cloud
  TYPE(c_ptr) :: basic_grid_cloud_deg
  TYPE(c_ptr) :: basic_grid_reg_2d_rot
  TYPE(c_ptr) :: basic_grid_reg_2d_rot_deg
  INTEGER(kind=c_size_t) :: num_cells
  INTEGER(kind=c_size_t) :: num_corners
  INTEGER(kind=c_size_t) :: num_edges
  REAL(kind=c_double), ALLOCATABLE :: cell_areas(:)
 
  REAL(kind=c_double) :: &
    cell_coords(3) = (/1.0_c_double, 0.0_c_double, 0.0_c_double/)
  INTEGER(kind=c_int) :: cell_mask(1) = (/1_c_int/)
  INTEGER(kind=c_size_t) :: cell_coord_idx, cell_coord_ll_idx
  INTEGER(kind=c_size_t) :: cell_mask_idx, cell_mask_ll_idx
 
  TYPE(c_ptr) :: grid_pair
  TYPE(c_ptr) :: interp_grid
  TYPE(c_ptr) :: interp_stack_config
  TYPE(c_ptr) :: interp_stack_config_cpy
 
  ! data types required to generate extended spmap configuration
  TYPE(c_ptr) :: scale_config
  TYPE(c_ptr) :: spmap_config
  TYPE(c_ptr) :: src_point_selection
  TYPE(c_ptr) :: source_cell_area_config, target_cell_area_config
  TYPE(c_ptr) :: overwrite_spmap_config
  TYPE(c_ptr) :: overwrite_config
  TYPE(c_ptr), TARGET :: overwrite_configs(2)
 
  INTEGER(kind=c_int) :: compare_value, test_value
  LOGICAL :: ltest_value
 
  INTEGER, TARGET :: do_search_call_count
  INTEGER, TARGET :: constructor_call_count
  TYPE(c_ptr) :: interp_method
  TYPE(c_ptr) :: interp_weights
  TYPE(c_ptr) :: collection_selection
  TYPE(c_ptr) :: interpolation_gen_config
  TYPE(c_ptr) :: interpolation_gen_config_copy
  TYPE(c_ptr) :: interpolation
  TYPE(c_ptr) :: interpolation_frac
  TYPE(c_ptr) :: interpolation_ext
 
  REAL(kind=c_double), TARGET :: src_cell_data(1)
  TYPE(c_ptr), TARGET :: src_field_(1)
  TYPE(c_ptr), TARGET :: src_field_collection(1)
  REAL(kind=c_double), TARGET :: src_frac_mask(1)
  TYPE(c_ptr), TARGET :: src_frac_mask_(1)
  TYPE(c_ptr), TARGET :: src_frac_mask_collection(1)
  REAL(kind=c_double), TARGET :: tgt_cell_data(1)
  TYPE(c_ptr), TARGET :: tgt_field_collection(1)
 
  INTEGER(kind=c_int) :: has_mismatched_coordinates
 
  INTERFACE
    SUBROUTINE utest_c_unlink ( path ) bind ( c, name='unlink' )
      use, INTRINSIC :: iso_c_binding, only : c_char
      CHARACTER(KIND=c_char), DIMENSION(*) :: path
    END SUBROUTINE utest_c_unlink
  END INTERFACE
 
  ! counters/results filled in by the instrumentation callbacks below,
  ! passed to yac_instrument_set_callbacks_c as user_data
  TYPE, BIND(C) :: instr_test_ctx_t
    INTEGER(kind=c_int) :: create_calls
    INTEGER(kind=c_int) :: start_calls
    INTEGER(kind=c_int) :: stop_calls
    INTEGER(kind=c_int) :: destroy_calls
    INTEGER(kind=c_int) :: last_start_depth
    INTEGER(kind=c_int) :: last_stop_depth
    INTEGER(kind=c_int) :: bad_handle_count
  END TYPE instr_test_ctx_t
 
  TYPE(instr_test_ctx_t), TARGET :: instr_ctx
  CHARACTER(len=:), ALLOCATABLE  :: instr_name
  INTEGER(kind=c_int)            :: instr_start_calls_global
 
  ! ===================================================================
 
  CALL utest_start_test('fortran_api')
 
  CALL yac_mpi_init_c()
  CALL yac_yaxt_init_c(mpi_comm_world)
 
  CALL test(yac_mpi_is_initialised_c() /= 0_c_int)
 
  ! --- region instrumentation: name lookup + callback registration ---
 
  instr_name = &
    yac_instrument_region_name_c(int(yac_instr_compute_tgt_field, c_int))
  CALL test(instr_name == "target field computation (SpMV)")
 
  instr_ctx%create_calls     = 0_c_int
  instr_ctx%start_calls      = 0_c_int
  instr_ctx%stop_calls       = 0_c_int
  instr_ctx%destroy_calls    = 0_c_int
  instr_ctx%last_start_depth = -1_c_int
  instr_ctx%last_stop_depth  = -1_c_int
  instr_ctx%bad_handle_count = 0_c_int
 
  ! registered before any grid/interpolation setup below, so every
  ! subsequent interpolation execution is instrumented
  CALL yac_instrument_set_callbacks_c( &
    c_funloc(utest_instrument_create_cb), &
    c_funloc(utest_instrument_start_cb), &
    c_funloc(utest_instrument_stop_cb), &
    c_funloc(utest_instrument_destroy_cb), &
    c_loc(instr_ctx))
 
  ! empty grids
  basic_grid_empty = &
    yac_basic_grid_empty_new_c("empty_grid" // c_null_char)
  num_cells = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_empty, int(yac_loc_cell, c_int))
  CALL test(num_cells == 0_c_int)
 
  ! regular 2d grid (rad coords)
  basic_grid_reg_2d = &
    yac_basic_grid_reg_2d_new_c( &
      "reg_2d_grid" // c_null_char, &
      (/2_c_size_t, 2_c_size_t/), (/0_c_int, 0_c_int/), &
      (/-0.1_c_double, 0.1_c_double/), (/-0.1_c_double, 0.1_c_double/))
  num_corners = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_reg_2d, int(yac_loc_corner, c_int))
  CALL test(num_corners == 4_c_int)
 
  ALLOCATE( &
    cell_areas( &
      int( &
        yac_basic_grid_get_data_size_c( &
          basic_grid_reg_2d, int(yac_loc_cell, c_int)))))
  cell_areas(:) = -1.0_c_double
  CALL yac_basic_grid_compute_cell_areas_c(basic_grid_reg_2d, cell_areas)
  CALL test(all(cell_areas(:) /= -1.0_c_double))
  DEALLOCATE(cell_areas)
 
  ! regular 2d grid (deg coords)
  basic_grid_reg_2d_deg = &
    yac_basic_grid_reg_2d_deg_new_c( &
      "reg_2d_grid_deg" // c_null_char, &
      (/2_c_size_t, 2_c_size_t/), (/0_c_int, 0_c_int/), &
      (/-0.1_c_double, 0.1_c_double/), (/-0.1_c_double, 0.1_c_double/))
  num_corners = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_reg_2d_deg, int(yac_loc_corner, c_int))
  CALL test(num_corners == 4_c_int)
 
  ! curvilinear 2d grid (rad coords)
  basic_grid_curve_2d = &
    yac_basic_grid_curve_2d_new_c( &
      "curve_2d_grid" // c_null_char, &
      (/2_c_size_t, 2_c_size_t/), (/0_c_int, 0_c_int/), &
      (/-0.1_c_double, 0.1_c_double, -0.1_c_double, 0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_curve_2d, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! curvilinear 2d grid (deg coords)
  basic_grid_curve_2d_deg = &
    yac_basic_grid_curve_2d_deg_new_c( &
      "curve_2d_grid_deg" // c_null_char, &
      (/2_c_size_t, 2_c_size_t/), (/0_c_int, 0_c_int/), &
      (/-0.1_c_double, 0.1_c_double, -0.1_c_double, 0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_curve_2d_deg, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (rad coords)
  basic_grid_unstruct = &
    yac_basic_grid_unstruct_new_c( &
      "unstruct_grid" // c_null_char, &
      4_c_size_t, 1_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (deg coords)
  basic_grid_unstruct_deg = &
    yac_basic_grid_unstruct_deg_new_c( &
      "unstruct_grid_deg" // c_null_char, &
      4_c_size_t, 1_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_deg, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (rad coords)
  basic_grid_unstruct_ll = &
    yac_basic_grid_unstruct_ll_new_c( &
      "unstruct_grid_ll" // c_null_char, &
      4_c_size_t, 1_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_ll, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (deg coords)
  basic_grid_unstruct_ll_deg = &
    yac_basic_grid_unstruct_ll_deg_new_c( &
      "unstruct_grid_ll_deg" // c_null_char, &
      4_c_size_t, 1_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_ll_deg, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (rad coords)
  basic_grid_unstruct_edge = &
    yac_basic_grid_unstruct_edge_new_c( &
      "unstruct_edge_grid" // c_null_char, &
      4_c_size_t, 1_c_size_t, 4_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/), &
      (/0_c_int, 1_c_int, 1_c_int, 2_c_int, &
        2_c_int, 3_c_int, 3_c_int, 0_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_edge, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (deg coords)
  basic_grid_unstruct_edge_deg = &
    yac_basic_grid_unstruct_edge_deg_new_c( &
      "unstruct_grid_edge_deg" // c_null_char, &
      4_c_size_t, 1_c_size_t, 4_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/), &
      (/0_c_int, 1_c_int, 1_c_int, 2_c_int, &
        2_c_int, 3_c_int, 3_c_int, 0_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_edge_deg, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (rad coords)
  basic_grid_unstruct_edge_ll = &
    yac_basic_grid_unstruct_edge_ll_new_c( &
      "unstruct_grid_edge_ll" // c_null_char, &
      4_c_size_t, 1_c_size_t, 4_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/), &
      (/0_c_int, 1_c_int, 1_c_int, 2_c_int, &
        2_c_int, 3_c_int, 3_c_int, 0_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_edge_ll, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! unstructured grid (deg coords)
  basic_grid_unstruct_edge_ll_deg = &
    yac_basic_grid_unstruct_edge_ll_deg_new_c( &
      "unstruct_grid_edge_ll_deg" // c_null_char, &
      4_c_size_t, 1_c_size_t, 4_c_size_t, (/4_c_int/), &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/), &
      (/0_c_int, 1_c_int, 2_c_int, 3_c_int/), &
      (/0_c_int, 1_c_int, 1_c_int, 2_c_int, &
        2_c_int, 3_c_int, 3_c_int, 0_c_int/))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_unstruct_edge_ll_deg, int(yac_loc_edge, c_int))
  CALL test(num_edges == 4_c_int)
 
  ! cloud grid (rad coords)
  basic_grid_cloud = &
    yac_basic_grid_cloud_new_c( &
      "cloud_grid" // c_null_char, 4_c_size_t, &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/))
  num_cells = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_cloud, int(yac_loc_cell, c_int))
  num_corners = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_cloud, int(yac_loc_corner, c_int))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_cloud, int(yac_loc_edge, c_int))
  CALL test(num_cells == 0_c_int)
  CALL test(num_corners == 4_c_int)
  CALL test(num_edges == 0_c_int)
 
  ! cloud grid (deg coords)
  basic_grid_cloud_deg = &
    yac_basic_grid_cloud_deg_new_c( &
      "cloud_grid" // c_null_char, 4_c_size_t, &
      (/-0.1_c_double, 0.1_c_double, 0.1_c_double, -0.1_c_double/), &
      (/-0.1_c_double, -0.1_c_double, 0.1_c_double, 0.1_c_double/))
  num_cells = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_cloud_deg, int(yac_loc_cell, c_int))
  num_corners = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_cloud_deg, int(yac_loc_corner, c_int))
  num_edges = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_cloud_deg, int(yac_loc_edge, c_int))
  CALL test(num_cells == 0_c_int)
  CALL test(num_corners == 4_c_int)
  CALL test(num_edges == 0_c_int)
 
  ! rotated regular 2d grid (rad coords)
  basic_grid_reg_2d_rot = &
    yac_basic_grid_reg_2d_rot_new_c( &
      "reg_2d_grid_deg" // c_null_char, &
      (/2_c_size_t, 2_c_size_t/), (/0_c_int, 0_c_int/), &
      (/-0.5_c_double, 0.5_c_double/) * yac_rad, &
      (/-0.5_c_double, 0.5_c_double/) * yac_rad, &
      180.0_c_double * yac_rad, 45.0_c_double * yac_rad)
  num_corners = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_reg_2d_rot, int(yac_loc_corner, c_int))
  CALL test(num_corners == 4_c_int)
 
  ! rotated regular 2d grid (deg coords)
  basic_grid_reg_2d_rot_deg = &
    yac_basic_grid_reg_2d_rot_deg_new_c( &
      "reg_2d_grid_deg" // c_null_char, &
      (/2_c_size_t, 2_c_size_t/), (/0_c_int, 0_c_int/), &
      (/-0.5_c_double, 0.5_c_double/), &
      (/-0.5_c_double, 0.5_c_double/), &
      180.0_c_double, 45.0_c_double)
  num_corners = &
    yac_basic_grid_get_data_size_c( &
      basic_grid_reg_2d_rot_deg, int(yac_loc_corner, c_int))
  CALL test(num_corners == 4_c_int)
 
  ! adding field coordinates and masks
  cell_coord_idx = &
    yac_basic_grid_add_coordinates_c( &
      basic_grid_unstruct, yac_loc_cell, cell_coords, 1_c_size_t)
  cell_coord_ll_idx = &
    yac_basic_grid_add_coordinates_c( &
      basic_grid_unstruct_ll, yac_loc_cell, cell_coords, 1_c_size_t)
  cell_mask_idx = &
    yac_basic_grid_add_mask_c( &
      basic_grid_unstruct, yac_loc_cell, cell_mask, 1_c_size_t, &
      "cell_mask" // c_null_char)
  cell_mask_ll_idx = &
    yac_basic_grid_add_mask_c( &
      basic_grid_unstruct_ll, yac_loc_cell, cell_mask, 1_c_size_t, &
      "cell_mask_ll" // c_null_char)
 
  has_mismatched_coordinates = &
    yac_basic_grid_check_coordinates_c( &
      basic_grid_unstruct, is_fatal=0_c_int)
  CALL test(has_mismatched_coordinates == 0_c_int)
 
  ! distributed grid
  grid_pair = &
    yac_dist_grid_pair_new_c( &
      basic_grid_unstruct, basic_grid_unstruct_ll, mpi_comm_world)
 
  ! interpolation grid
  interp_grid = &
    yac_interp_grid_new_c( &
      grid_pair, "unstruct_grid" // c_null_char, &
      "unstruct_grid_ll" // c_null_char, &
      1_c_size_t, (/yac_loc_cell/), (/cell_coord_idx/), (/cell_mask_idx/), &
      yac_loc_cell, cell_coord_ll_idx, cell_mask_ll_idx)
 
  ! interpolation check
  CALL yac_interp_method_check_add_constructor_callback_c( &
    c_funloc(utest_constructor_callback), c_loc(constructor_call_count), &
    "constructor_callback" // c_null_char)
  CALL yac_interp_method_check_add_do_search_callback_c( &
    c_funloc(utest_do_search_callback), c_loc(do_search_call_count), &
    "do_search_callback" // c_null_char)
 
  ! setup structures for extended spmap configuration
  source_cell_area_config = &
    yac_spmap_cell_area_config_yac_new_c( &
      yac_interp_spmap_sphere_radius_default_f)
  target_cell_area_config = &
    yac_spmap_cell_area_config_file_new_c( &
      "area.nc", "cell_areas", yac_interp_spmap_min_global_id_default_f)
  scale_config = &
    yac_spmap_scale_config_new_c( &
      yac_interp_spmap_scale_type_default_f, &
      source_cell_area_config, target_cell_area_config)
  src_point_selection = &
    yac_point_selection_bnd_circle_new_c( &
      0.0_c_double, 0.0_c_double, 0.1_c_double)
  spmap_config = &
    yac_interp_spmap_config_new_c( &
      yac_interp_spmap_spread_distance_default_f, &
      yac_interp_spmap_max_search_distance_default_f, &
      yac_interp_spmap_weighted_default_f, &
      scale_config)
  overwrite_spmap_config = &
    yac_interp_spmap_config_new_c( &
      0.1_c_double, &
      yac_interp_spmap_max_search_distance_default_f, &
      yac_interp_spmap_weighted_default_f, &
      scale_config)
  overwrite_config = &
    yac_spmap_overwrite_config_new_c( &
      src_point_selection, overwrite_spmap_config)
  overwrite_configs = (/overwrite_config, c_null_ptr/)
 
  ! interpolation stack configuration
  constructor_call_count = 0
  do_search_call_count = 0
  interp_stack_config = yac_interp_stack_config_new_c()
  CALL yac_interp_stack_config_add_check_c( &
    interp_stack_config, "constructor_callback" // c_null_char, &
    "do_search_callback" // c_null_char)
  CALL yac_interp_stack_config_add_nnn_c( &
    interp_stack_config, yac_interp_nnn_weighted_default_f, &
    yac_interp_nnn_n_default_f, yac_interp_nnn_max_search_distance_default_f, &
    yac_interp_nnn_gauss_scale_default_f)
  interp_stack_config_cpy = &
    yac_interp_stack_config_copy_c(interp_stack_config)
  CALL yac_interp_stack_config_add_average_c( &
    interp_stack_config, yac_interp_avg_weight_type_default_f, &
    yac_interp_avg_partial_coverage_default_f)
  CALL yac_interp_stack_config_add_ncc_c( &
    interp_stack_config, yac_interp_ncc_weight_type_default_f, &
    yac_interp_ncc_partial_coverage_default_f)
  CALL yac_interp_stack_config_add_dnn_c( &
    interp_stack_config, yac_interp_dnn_weight_type_default_f, &
    yac_interp_dnn_search_distance_type_default_f, &
    yac_interp_dnn_search_distance_default_f, yac_interp_dnn_scale_default_f)
  CALL yac_interp_stack_config_add_nnn_c( &
    interp_stack_config, yac_interp_nnn_weighted_default_f, &
    yac_interp_nnn_n_default_f, yac_interp_nnn_max_search_distance_default_f, &
    yac_interp_nnn_gauss_scale_default_f)
  CALL yac_interp_stack_config_add_rbf_c( &
    interp_stack_config, yac_interp_rbf_n_default_f, &
    yac_interp_rbf_max_search_distance_default_f, &
    yac_interp_rbf_scale_default_f)
  CALL yac_interp_stack_config_add_conservative_c( &
    interp_stack_config, yac_interp_conserv_order_default_f, &
    yac_interp_conserv_enforced_conserv_default_f, &
    yac_interp_conserv_partial_coverage_default_f, &
    yac_interp_conserv_normalisation_default_f)
  CALL yac_interp_stack_config_add_spmap_c( &
    interp_stack_config, yac_interp_spmap_spread_distance_default_f, &
    yac_interp_spmap_max_search_distance_default_f, &
    yac_interp_spmap_weighted_default_f, yac_interp_spmap_scale_type_default_f, &
    yac_interp_spmap_sphere_radius_default_f, &
    yac_interp_spmap_filename_default_f, yac_interp_spmap_varname_default_f, &
    yac_interp_spmap_min_global_id_default_f, &
    yac_interp_spmap_sphere_radius_default_f, &
    yac_interp_spmap_filename_default_f, yac_interp_spmap_varname_default_f, &
    yac_interp_spmap_min_global_id_default_f)
  CALL yac_interp_stack_config_add_spmap_ext_c( &
    interp_stack_config, yac_interp_spmap_config_default_f, &
    yac_interp_spmap_overwrite_default_f )
  CALL yac_interp_stack_config_add_spmap_ext_c( &
    interp_stack_config, spmap_config, c_loc(overwrite_configs(1)))
  CALL yac_interp_stack_config_add_hcsbb_c(interp_stack_config)
  CALL yac_interp_stack_config_add_user_file_c( &
    interp_stack_config, "test_fortran_api_weights.nc" // c_null_char, &
    yac_interp_file_on_missing_file_default_f, &
    yac_interp_file_on_success_default_f)
  CALL yac_interp_stack_config_add_fixed_c( &
    interp_stack_config, -1.0_c_double)
  CALL yac_interp_stack_config_add_creep_c( &
    interp_stack_config, yac_interp_creep_distance_default_f)
  CALL yac_interp_stack_config_add_check_c( &
    interp_stack_config, yac_interp_check_constructor_key_default_f, &
    yac_interp_check_do_search_key_default_f)
 
  ! clean up data structures for extended spmap configuration
  CALL yac_spmap_overwrite_config_delete_c(overwrite_config)
  CALL yac_interp_spmap_config_delete_c(overwrite_spmap_config)
  CALL yac_point_selection_delete_c(src_point_selection)
  CALL yac_interp_spmap_config_delete_c(spmap_config)
  CALL yac_spmap_scale_config_delete_c(scale_config);
  CALL yac_spmap_cell_area_config_delete_c(target_cell_area_config)
  CALL yac_spmap_cell_area_config_delete_c(source_cell_area_config)
 
  compare_value = &
    yac_interp_stack_config_compare_c( &
      interp_stack_config, interp_stack_config_cpy)
  CALL test(compare_value /= 0_c_int)
 
  ! interpolation method stack
  CALL test(constructor_call_count == 0)
  interp_method = &
    yac_interp_stack_config_generate_c(interp_stack_config_cpy)
  CALL test(constructor_call_count == 1)
 
  ! interpolation method
  CALL test(do_search_call_count == 0)
  interp_weights = &
    yac_interp_method_do_search_c(interp_method, interp_grid)
  CALL yac_interp_weights_write_to_file_c( &
    interp_weights, "test_fortran_api_weights.nc" // c_null_char, &
    "unstruct_grid" // c_null_char, "unstruct_grid_ll" // c_null_char, &
    0_c_size_t, 0_c_size_t, int(yac_weight_file_overwrite, c_int))
  CALL test(do_search_call_count == 1)
 
  ! interpolation
  interpolation = &
    yac_interp_weights_get_interpolation_c( &
      interp_weights, yac_mapping_on_src, 1_c_size_t, &
      yac_interpolation_get_const_frac_mask_no_value_c(), &
      1.0_c_double, 0.0_c_double, c_null_char, 1_c_int, 1_c_int)
  interpolation_frac = &
    yac_interp_weights_get_interpolation_c( &
      interp_weights, yac_mapping_on_src, 1_c_size_t, &
      0.0_c_double, 1.0_c_double, 0.0_c_double, c_null_char, 1_c_int, 1_c_int)
  ltest_value = &
    yac_interpolation_get_const_frac_mask_no_value_c() /= &
    yac_interpolation_get_const_frac_mask_undef_c()
  CALL test(ltest_value)
 
  ! collection selection (without explicit indices)
  collection_selection = &
    yac_collection_selection_new_c(1_c_size_t)
  CALL yac_collection_selection_delete_c(collection_selection)
 
  ! collection selection (with explicit indices)
  collection_selection = &
    yac_collection_selection_new_c(1_c_size_t, (/0_c_size_t/))
 
  ! interpolation generation configuration
  interpolation_gen_config = yac_interpolation_gen_config_new_c()
  CALL yac_interpolation_gen_config_set_reorder_c( &
    interpolation_gen_config, yac_mapping_on_tgt)
  CALL yac_interpolation_gen_config_set_collection_size_c( &
    interpolation_gen_config, 1_c_size_t)
  CALL yac_interpolation_gen_config_set_collection_selection_c( &
    interpolation_gen_config, collection_selection)
  CALL yac_interpolation_gen_config_set_frac_mask_fallback_value_c( &
    interpolation_gen_config, 1.0_c_double)
  CALL yac_interpolation_gen_config_set_scaling_factor_c( &
    interpolation_gen_config, 2.0_c_double)
  CALL yac_interpolation_gen_config_set_scaling_summand_c( &
    interpolation_gen_config, 2.0_c_double)
  CALL yac_interpolation_gen_config_set_yaxt_exchanger_name_c( &
    interpolation_gen_config, "" // c_null_char)
  interpolation_gen_config_copy = &
    yac_interpolation_gen_config_copy_c(interpolation_gen_config)
 
  ! interpolation with extended configuration
  interpolation_ext = &
    yac_interp_weights_get_interpolation_ext_c( &
      interp_weights, interpolation_gen_config, 1_c_int, 1_c_int)
 
  src_field_(1) = c_loc(src_cell_data(1))
  src_field_collection(1) = c_loc(src_field_(1))
  src_frac_mask_(1) = c_loc(src_frac_mask)
  src_frac_mask_collection(1) = c_loc(src_frac_mask_(1))
  tgt_field_collection(1) = c_loc(tgt_cell_data(1))
  src_cell_data(1) = 1.0_c_double
  src_frac_mask(1) = 0.0_c_double
 
  tgt_cell_data(1) = -1.0_c_double
  CALL yac_interpolation_execute_c( &
    interpolation, c_loc(src_field_collection), c_loc(tgt_field_collection))
  CALL test(tgt_cell_data(1) == src_cell_data(1))
 
  tgt_cell_data(1) = -1.0_c_double
  CALL yac_interpolation_execute_frac_c( &
    interpolation_frac, c_loc(src_field_collection), &
    c_loc(src_frac_mask_collection), c_loc(tgt_field_collection))
  CALL test(tgt_cell_data(1) == 0.0_c_double)
 
  tgt_cell_data(1) = -1.0_c_double
  test_value = yac_interpolation_execute_put_test_c(interpolation)
  CALL test(test_value == 1_c_int)
  CALL yac_interpolation_execute_put_c( &
    interpolation, c_loc(src_field_collection))
  CALL yac_interpolation_execute_get_c( &
    interpolation, c_loc(tgt_field_collection))
  CALL test(tgt_cell_data(1) == src_cell_data(1))
 
  tgt_cell_data(1) = -1.0_c_double
  CALL yac_interpolation_execute_get_async_c( &
    interpolation_frac, c_loc(tgt_field_collection))
  test_value = yac_interpolation_execute_get_test_c(interpolation_frac)
  CALL test(test_value == 0_c_int)
  CALL mpi_barrier(mpi_comm_world, ierror)
  CALL yac_interpolation_execute_put_frac_c( &
    interpolation_frac, c_loc(src_field_collection), &
    c_loc(src_frac_mask_collection))
  CALL yac_interpolation_execute_wait_c(interpolation_frac)
  CALL test(tgt_cell_data(1) == 0.0_c_double)
  tgt_cell_data(1) = -1.0_c_double
 
  ! cleanup
  CALL yac_interpolation_delete_c(interpolation_ext)
  CALL yac_interpolation_delete_c(interpolation_frac)
  CALL yac_interpolation_delete_c(interpolation)
  CALL yac_interpolation_gen_config_delete_c(interpolation_gen_config)
  CALL yac_interpolation_gen_config_delete_c(interpolation_gen_config_copy)
  CALL yac_collection_selection_delete_c(collection_selection)
  CALL utest_c_unlink("test_fortran_api_weights.nc" // c_null_char)
  CALL yac_interp_weights_delete_c(interp_weights)
  CALL yac_interp_method_delete_c(interp_method)
  CALL utest_c_free(interp_method)
  CALL yac_interp_stack_config_delete_c(interp_stack_config_cpy)
  CALL yac_interp_stack_config_delete_c(interp_stack_config)
  CALL yac_interp_method_cleanup_c()
  CALL yac_interp_grid_delete_c(interp_grid)
  CALL yac_dist_grid_pair_delete_c(grid_pair)
  CALL yac_basic_grid_delete_c(basic_grid_reg_2d_rot_deg)
  CALL yac_basic_grid_delete_c(basic_grid_reg_2d_rot)
  CALL yac_basic_grid_delete_c(basic_grid_cloud_deg)
  CALL yac_basic_grid_delete_c(basic_grid_cloud)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_edge_ll_deg)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_edge_ll)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_edge_deg)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_edge)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_ll_deg)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_ll)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct_deg)
  CALL yac_basic_grid_delete_c(basic_grid_unstruct)
  CALL yac_basic_grid_delete_c(basic_grid_curve_2d_deg)
  CALL yac_basic_grid_delete_c(basic_grid_curve_2d)
  CALL yac_basic_grid_delete_c(basic_grid_reg_2d_deg)
  CALL yac_basic_grid_delete_c(basic_grid_reg_2d)
  CALL yac_basic_grid_delete_c(basic_grid_empty)
 
  ! --- Test user-oriented interpolation method config parameter API ---
 
  ! Test convenience set/get int (nnn.n)
  block
    TYPE(c_ptr) :: method_config
    INTEGER(kind=c_int) :: n_val
 
    method_config = &
      yac_interp_method_config_default_from_name_new_c( &
        "nnn" // c_null_char)
    CALL yac_interp_method_config_set_param_int_c( &
      method_config, "n" // c_null_char, 7_c_int)
    n_val = yac_interp_method_config_get_param_int_c( &
      method_config, "n" // c_null_char)
    CALL test(n_val == 7_c_int)
    CALL yac_interp_method_config_delete_c(method_config)
  END block
 
  ! Test convenience set/get dble (nnn.max_search_distance)
  block
    TYPE(c_ptr) :: method_config
    REAL(kind=c_double) :: d_val
 
    method_config = &
      yac_interp_method_config_default_from_name_new_c( &
        "nnn" // c_null_char)
    CALL yac_interp_method_config_set_param_dble_c( &
      method_config, "max_search_distance" // c_null_char, 0.5_c_double)
    d_val = yac_interp_method_config_get_param_dble_c( &
      method_config, "max_search_distance" // c_null_char)
    CALL test(d_val == 0.5_c_double)
    CALL yac_interp_method_config_delete_c(method_config)
  END block
 
  ! Test convenience set/get str (nnn.weighted)
  block
    TYPE(c_ptr) :: method_config
    CHARACTER(kind=c_char, len=64) :: str_buf
 
    method_config = &
      yac_interp_method_config_default_from_name_new_c( &
        "nnn" // c_null_char)
    CALL yac_interp_method_config_set_param_str_c( &
      method_config, "weighted" // c_null_char, &
      "gauss_weighted" // c_null_char)
    CALL yac_interp_method_config_get_param_str_c( &
      method_config, "weighted" // c_null_char, &
      str_buf, int(len(str_buf), c_int))
    CALL test(str_buf(1:14) == "gauss_weighted")
    CALL yac_interp_method_config_delete_c(method_config)
  END block
 
  ! Test convenience with dot-separated path (dnn.search_distance.fixed)
  block
    TYPE(c_ptr) :: method_config
    REAL(kind=c_double) :: d_val
 
    method_config = &
      yac_interp_method_config_default_from_name_new_c( &
        "dnn" // c_null_char)
    CALL yac_interp_method_config_set_param_dble_c( &
      method_config, "search_distance.fixed" // c_null_char, &
      1.0_c_double * yac_rad)
    d_val = yac_interp_method_config_get_param_dble_c( &
      method_config, "search_distance.fixed" // c_null_char)
    CALL test(d_val == 1.0_c_double * yac_rad)
    CALL yac_interp_method_config_delete_c(method_config)
  END block
 
  ! Test add to interp stack via generic yac_interp_stack_config_add_c
  block
    TYPE(c_ptr) :: method_config, stack
 
    method_config = &
      yac_interp_method_config_default_from_name_new_c( &
        "nnn" // c_null_char)
    CALL yac_interp_method_config_set_param_int_c( &
      method_config, "n" // c_null_char, 3_c_int)
    stack = yac_interp_stack_config_new_c()
    CALL yac_interp_stack_config_add_c(stack, method_config)
    CALL yac_interp_stack_config_delete_c(stack)
  END block
 
  ! Test list parameter: spmap overwrite list (get_list_size, append, index path)
  block
    TYPE(c_ptr)            :: method_config
    INTEGER(kind=c_size_t) :: list_sz, idx0, idx1
    REAL(kind=c_double)    :: sd0, sd1
 
    method_config = &
      yac_interp_method_config_default_from_name_new_c( &
        "spmap" // c_null_char)
 
    ! Initially empty
    list_sz = yac_interp_method_config_get_list_size_c( &
      method_config, "overwrite" // c_null_char)
    CALL test(list_sz == 0_c_size_t)
 
    ! Append first element
    idx0 = yac_interp_method_config_append_list_element_c( &
      method_config, "overwrite" // c_null_char)
    CALL test(idx0 == 0_c_size_t)
 
    ! Set spread_distance of element 0 via index path "overwrite.0.spread_distance"
    CALL yac_interp_method_config_set_param_dble_c( &
      method_config, "overwrite.0.spread_distance" // c_null_char, 0.05_c_double)
    sd0 = yac_interp_method_config_get_param_dble_c( &
      method_config, "overwrite.0.spread_distance" // c_null_char)
    CALL test(sd0 == 0.05_c_double)
 
    ! Append second element
    idx1 = yac_interp_method_config_append_list_element_c( &
      method_config, "overwrite" // c_null_char)
    CALL test(idx1 == 1_c_size_t)
 
    CALL yac_interp_method_config_set_param_dble_c( &
      method_config, "overwrite.1.spread_distance" // c_null_char, 0.10_c_double)
    sd1 = yac_interp_method_config_get_param_dble_c( &
      method_config, "overwrite.1.spread_distance" // c_null_char)
    CALL test(sd1 == 0.10_c_double)
 
    ! First element must remain unchanged
    sd0 = yac_interp_method_config_get_param_dble_c( &
      method_config, "overwrite.0.spread_distance" // c_null_char)
    CALL test(sd0 == 0.05_c_double)
 
    CALL yac_interp_method_config_delete_c(method_config)
  END block
 
  ! --- region instrumentation: verify the callbacks registered above
  ! actually fired during the interpolation executions further up, and
  ! that clearing callbacks destroys every resolved region's handle ---
  !
  ! Per-rank call counts depend on the domain decomposition (a rank may end
  ! up with no local interpolation work at all), so only invariants that
  ! must hold regardless of whether this particular rank did any work are
  ! checked per-rank; whether instrumentation fired *somewhere* is checked
  ! via a global reduction across all ranks.
 
  CALL test(instr_ctx%start_calls == instr_ctx%stop_calls)
  CALL test(instr_ctx%bad_handle_count == 0_c_int)
  CALL test(instr_ctx%destroy_calls == 0_c_int)
  IF (instr_ctx%start_calls > 0_c_int) &
    CALL test(instr_ctx%last_start_depth >= 0_c_int)
  IF (instr_ctx%stop_calls > 0_c_int) &
    CALL test(instr_ctx%last_stop_depth >= 0_c_int)
 
  CALL mpi_allreduce( &
    instr_ctx%start_calls, instr_start_calls_global, 1, mpi_integer, &
    mpi_sum, mpi_comm_world, ierror)
  CALL test(instr_start_calls_global > 0)
 
  CALL yac_instrument_clear_callbacks_c()
 
  CALL test(instr_ctx%destroy_calls == instr_ctx%create_calls)
 
  CALL yac_mpi_cleanup_c()
  CALL yac_mpi_finalize_c()
 
  CALL utest_stop_test
  CALL utest_exit_tests
 
CONTAINS
 
  SUBROUTINE utest_constructor_callback(user_data) BIND(C)
 
    TYPE(c_ptr), value :: user_data
 
    INTEGER, POINTER :: constructor_call_count
 
    CALL c_f_pointer(user_data, constructor_call_count)
 
    constructor_call_count = constructor_call_count + 1
 
  END SUBROUTINE utest_constructor_callback
 
  SUBROUTINE utest_do_search_callback( &
    global_ids, coordinates_xyz, count, user_data) BIND(C)
 
    TYPE(c_ptr), value :: global_ids
    TYPE(c_ptr), value :: coordinates_xyz
    INTEGER(kind=c_size_t), value :: count
    TYPE(c_ptr), value :: user_data
 
    INTEGER, POINTER :: do_search_call_count
 
    nop(global_ids)
    nop(coordinates_xyz)
    nop(count)
 
    CALL c_f_pointer(user_data, do_search_call_count)
 
    do_search_call_count = do_search_call_count + 1
 
  END SUBROUTINE
 
  FUNCTION utest_instrument_create_cb(id, user_data) BIND(C) RESULT(handle)
 
    INTEGER(kind=c_int), VALUE :: id
    TYPE(c_ptr), VALUE         :: user_data
    TYPE(c_ptr)                :: handle
 
    TYPE(instr_test_ctx_t), POINTER :: ctx
 
    nop(id)
 
    CALL c_f_pointer(user_data, ctx)
    ctx%create_calls = ctx%create_calls + 1
 
    ! use user_data itself as the dummy region handle: it is a fixed,
    ! known address, so the start/stop/destroy callbacks can verify they
    ! receive the same handle back without host-associating a separate
    ! variable (which would force gfortran to emit a stack trampoline
    ! for this callback)
    handle = user_data
 
  END FUNCTION utest_instrument_create_cb
 
  SUBROUTINE utest_instrument_start_cb( &
    id, region_handle, depth, user_data) BIND(C)
 
    INTEGER(kind=c_int), VALUE :: id
    TYPE(c_ptr), VALUE         :: region_handle
    INTEGER(kind=c_int), VALUE :: depth
    TYPE(c_ptr), VALUE         :: user_data
 
    TYPE(instr_test_ctx_t), POINTER :: ctx
 
    nop(id)
 
    CALL c_f_pointer(user_data, ctx)
    ctx%start_calls = ctx%start_calls + 1
    ctx%last_start_depth = depth
    IF (.NOT. c_associated(region_handle, user_data)) &
      ctx%bad_handle_count = ctx%bad_handle_count + 1
 
  END SUBROUTINE utest_instrument_start_cb
 
  SUBROUTINE utest_instrument_stop_cb( &
    id, region_handle, depth, user_data) BIND(C)
 
    INTEGER(kind=c_int), VALUE :: id
    TYPE(c_ptr), VALUE         :: region_handle
    INTEGER(kind=c_int), VALUE :: depth
    TYPE(c_ptr), VALUE         :: user_data
 
    TYPE(instr_test_ctx_t), POINTER :: ctx
 
    nop(id)
 
    CALL c_f_pointer(user_data, ctx)
    ctx%stop_calls = ctx%stop_calls + 1
    ctx%last_stop_depth = depth
    IF (.NOT. c_associated(region_handle, user_data)) &
      ctx%bad_handle_count = ctx%bad_handle_count + 1
 
  END SUBROUTINE utest_instrument_stop_cb
 
  SUBROUTINE utest_instrument_destroy_cb(id, region_handle, user_data) BIND(C)
 
    INTEGER(kind=c_int), VALUE :: id
    TYPE(c_ptr), VALUE         :: region_handle
    TYPE(c_ptr), VALUE         :: user_data
 
    TYPE(instr_test_ctx_t), POINTER :: ctx
 
    nop(id)
 
    CALL c_f_pointer(user_data, ctx)
    ctx%destroy_calls = ctx%destroy_calls + 1
    IF (.NOT. c_associated(region_handle, user_data)) &
      ctx%bad_handle_count = ctx%bad_handle_count + 1
 
  END SUBROUTINE utest_instrument_destroy_cb
 
END PROGRAM main